git @ Cat's Eye Technologies Falderal / d181c23
Split Runner into Loader and Runner. --HG-- rename : Test/Falderal/Runner.hs => Test/Falderal/Loader.hs catseye 11 years ago
2 changed file(s) with 188 addition(s) and 159 deletion(s). Raw diff Collapse all Expand all
0 module Test.Falderal.Loader where
1
2 --
3 -- Test.Falderal.Loader -- The Falderal Test Loader
4 -- Copyright (c)2011 Cat's Eye Technologies. All rights reserved.
5 --
6 -- Redistribution and use in source and binary forms, with or without
7 -- modification, are permitted provided that the following conditions
8 -- are met:
9 --
10 -- 1. Redistributions of source code must retain the above copyright
11 -- notices, this list of conditions and the following disclaimer.
12 -- 2. Redistributions in binary form must reproduce the above copyright
13 -- notices, this list of conditions, and the following disclaimer in
14 -- the documentation and/or other materials provided with the
15 -- distribution.
16 -- 3. Neither the names of the copyright holders nor the names of their
17 -- contributors may be used to endorse or promote products derived
18 -- from this software without specific prior written permission.
19 --
20 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 -- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 -- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 -- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 -- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 -- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 -- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 -- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 -- POSSIBILITY OF SUCH DAMAGE.
32 --
33
34 import System
35
36 --
37 -- Definitions for the structure of a test suite in Falderal format.
38 --
39
40 data Line = TestInput String
41 | ExpectedResult String
42 | ExpectedError String
43 | LiteralText String
44 | QuotedCode String
45 | SectionHeading String
46 deriving (Show, Eq, Ord)
47
48 data Expectation = Output String
49 | Exception String
50 deriving (Show, Eq, Ord)
51
52 data Block = Section String
53 | Test String String Expectation
54 deriving (Show, Eq, Ord)
55
56 --
57 -- File loading functions.
58 --
59
60 loadFile fileName = do
61 testText <- readFile fileName
62 lines <- return $ transformLines $ lines testText
63 blocks <- return $ convertLinesToBlocks $ lines
64 return blocks
65
66 loadLines fileName = do
67 testText <- readFile fileName
68 lines <- return $ transformLines $ lines testText
69 return lines
70
71 transformLines lines =
72 let
73 lines' = map classifyLine lines
74 lines'' = findSectionHeadings lines' (LiteralText "0")
75 in
76 coalesceLines lines'' (LiteralText "0")
77
78 classifyLine line
79 | prefix == "| " = TestInput suffix
80 | prefix == "= " = ExpectedResult suffix
81 | prefix == "? " = ExpectedError suffix
82 | prefix == "> " = QuotedCode suffix
83 | otherwise = LiteralText line
84 where
85 prefix = take 2 line
86 suffix = drop 2 line
87
88 findSectionHeadings [] last =
89 [last]
90 findSectionHeadings ((line@(LiteralText suspectedUnderline)):lines) last@(LiteralText suspectedHeading) =
91 if
92 ((discoverRepeatedCharacter suspectedUnderline) == Just '-') &&
93 ((length suspectedUnderline) == (length suspectedHeading))
94 then
95 findSectionHeadings lines (SectionHeading suspectedHeading)
96 else
97 (last:findSectionHeadings lines line)
98 findSectionHeadings (line:lines) last =
99 (last:findSectionHeadings lines line)
100
101 discoverRepeatedCharacter [] =
102 Nothing
103 discoverRepeatedCharacter (first:rest) =
104 confirmRepeatedCharacter first rest
105
106 confirmRepeatedCharacter char [] =
107 Just char
108 confirmRepeatedCharacter char (next:rest)
109 | char == next = confirmRepeatedCharacter char rest
110 | otherwise = Nothing
111
112 --
113 -- Coalesce neigbouring lines. For each line, if it is classified the
114 -- same way as the line previously examined, combine them.
115 --
116
117 coalesceLines [] last =
118 [last]
119 coalesceLines ((TestInput more):lines) (TestInput last) =
120 coalesceLines lines (TestInput (last ++ "\n" ++ more))
121 coalesceLines ((ExpectedResult more):lines) (ExpectedResult last) =
122 coalesceLines lines (ExpectedResult (last ++ "\n" ++ more))
123 coalesceLines ((ExpectedError more):lines) (ExpectedError last) =
124 coalesceLines lines (ExpectedError (last ++ "\n" ++ more))
125 coalesceLines ((LiteralText more):lines) (LiteralText last) =
126 coalesceLines lines (LiteralText (last ++ "\n" ++ more))
127 coalesceLines ((QuotedCode more):lines) (QuotedCode last) =
128 coalesceLines lines (QuotedCode (last ++ "\n" ++ more))
129 coalesceLines (line:lines) last =
130 (last:coalesceLines lines line)
131
132 --
133 -- Convert lines to blocks.
134 --
135
136 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedResult expected):rest) =
137 ((Test literalText testText (Output expected)):convertLinesToBlocks rest)
138 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedError expected):rest) =
139 ((Test literalText testText (Exception expected)):convertLinesToBlocks rest)
140 convertLinesToBlocks ((TestInput testText):(ExpectedResult expected):rest) =
141 ((Test "(undescribed output test)" testText (Output expected)):convertLinesToBlocks rest)
142 convertLinesToBlocks ((TestInput testText):(ExpectedError expected):rest) =
143 ((Test "(undescribed output test)" testText (Exception expected)):convertLinesToBlocks rest)
144 convertLinesToBlocks ((SectionHeading text):rest) =
145 ((Section text):convertLinesToBlocks rest)
146 convertLinesToBlocks ((LiteralText _):(SectionHeading text):rest) =
147 ((Section text):convertLinesToBlocks rest)
148
149 convertLinesToBlocks (_:rest) =
150 convertLinesToBlocks rest
151 convertLinesToBlocks [] = []
152
153 --
154 -- Give blocks that don't have a description, the description of the previous
155 -- block that did have a description. Note that when we encounter a new
156 -- section, we do not remember the previous description, as it will surely
157 -- be irrelevant now.
158 --
159
160 reDescribeBlocks blocks = reDescribeBlocks' blocks "" 2
161
162 reDescribeBlocks' [] desc n =
163 []
164 reDescribeBlocks' (block@(Test literalText inp exp):rest) desc n
165 | allWhitespace literalText = (Test numberedDesc inp exp):(reDescribeBlocks' rest desc (n+1))
166 | otherwise = (block):(reDescribeBlocks' rest literalText 2)
167 where numberedDesc = "(#" ++ (show n) ++ ") " ++ (stripLeading '\n' desc)
168 reDescribeBlocks' (block:rest) desc n =
169 block:(reDescribeBlocks' rest "" 2)
170
171 --
172 -- This could use Char.isSpace
173 --
174
175 allWhitespace [] = True
176 allWhitespace (' ':rest) = allWhitespace rest
177 allWhitespace ('\n':rest) = allWhitespace rest
178 allWhitespace ('\t':rest) = allWhitespace rest
179 allWhitespace (_:rest) = False
180
181 stripLeading y [] = []
182 stripLeading y all@(x:xs)
183 | x == y = stripLeading y xs
184 | otherwise = all
3434 import System
3535 import qualified Control.Exception as Exc
3636
37 --
38 -- collecting TODOs here because I don't have access to the issue tracker atm
39 --
40 -- TODO: in convertLinesToBlocks, Invalid sequences (such as an expected
41 -- result without any preceding test input) should be flagged as errors
42 -- instead of being silently ignored
43 --
44 -- TODO: selectTestFun ought to be more forgiving: if no fun could be found
45 -- in this section, skip the tests. This necessitates a "skip" result.
46 --
37 import Test.Falderal.Loader
4738
4839 --
4940 -- Definitions.
50 --
51
52 data Line = TestInput String
53 | ExpectedResult String
54 | ExpectedError String
55 | LiteralText String
56 | QuotedCode String
57 | SectionHeading String
58 deriving (Show, Eq, Ord)
59
60 data Expectation = Output String
61 | Exception String
62 deriving (Show, Eq, Ord)
63
64 data Block = Section String
65 | Test String String Expectation
66 deriving (Show, Eq, Ord)
67
6841 --
6942 -- First element is the literal text preceding the test.
7043 -- Second element is the textual input to the test.
9366 loadAndRunTests filename funMap
9467 run filenames options funMap
9568
96 --
97 -- File loading functions.
98 --
99
10069 loadAndRunTests fileName funMap = do
101 tests <- loadFile fileName
70 blocks <- loadFile fileName
71 tests <- return $ reDescribeBlocks blocks
10272 reportTests funMap tests
103
104 loadFile fileName = do
105 testText <- readFile fileName
106 lines <- return $ transformLines $ lines testText
107 blocks <- return $ reDescribeBlocks $ convertLinesToBlocks $ lines
108 return blocks
109
110 loadLines fileName = do
111 testText <- readFile fileName
112 lines <- return $ transformLines $ lines testText
113 return lines
114
115 transformLines lines =
116 let
117 lines' = map classifyLine lines
118 lines'' = findSectionHeadings lines' (LiteralText "0")
119 in
120 coalesceLines lines'' (LiteralText "0")
121
122 classifyLine line
123 | prefix == "| " = TestInput suffix
124 | prefix == "= " = ExpectedResult suffix
125 | prefix == "? " = ExpectedError suffix
126 | prefix == "> " = QuotedCode suffix
127 | otherwise = LiteralText line
128 where
129 prefix = take 2 line
130 suffix = drop 2 line
131
132 findSectionHeadings [] last =
133 [last]
134 findSectionHeadings ((line@(LiteralText suspectedUnderline)):lines) last@(LiteralText suspectedHeading) =
135 if
136 ((discoverRepeatedCharacter suspectedUnderline) == Just '-') &&
137 ((length suspectedUnderline) == (length suspectedHeading))
138 then
139 findSectionHeadings lines (SectionHeading suspectedHeading)
140 else
141 (last:findSectionHeadings lines line)
142 findSectionHeadings (line:lines) last =
143 (last:findSectionHeadings lines line)
144
145 discoverRepeatedCharacter [] =
146 Nothing
147 discoverRepeatedCharacter (first:rest) =
148 confirmRepeatedCharacter first rest
149
150 confirmRepeatedCharacter char [] =
151 Just char
152 confirmRepeatedCharacter char (next:rest)
153 | char == next = confirmRepeatedCharacter char rest
154 | otherwise = Nothing
155
156 --
157 -- Coalesce neigbouring lines. For each line, if it is classified the
158 -- same way as the line previously examined, combine them.
159 --
160
161 coalesceLines [] last =
162 [last]
163 coalesceLines ((TestInput more):lines) (TestInput last) =
164 coalesceLines lines (TestInput (last ++ "\n" ++ more))
165 coalesceLines ((ExpectedResult more):lines) (ExpectedResult last) =
166 coalesceLines lines (ExpectedResult (last ++ "\n" ++ more))
167 coalesceLines ((ExpectedError more):lines) (ExpectedError last) =
168 coalesceLines lines (ExpectedError (last ++ "\n" ++ more))
169 coalesceLines ((LiteralText more):lines) (LiteralText last) =
170 coalesceLines lines (LiteralText (last ++ "\n" ++ more))
171 coalesceLines ((QuotedCode more):lines) (QuotedCode last) =
172 coalesceLines lines (QuotedCode (last ++ "\n" ++ more))
173 coalesceLines (line:lines) last =
174 (last:coalesceLines lines line)
175
176 --
177 -- Convert lines to blocks.
178 --
179
180 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedResult expected):rest) =
181 ((Test literalText testText (Output expected)):convertLinesToBlocks rest)
182 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedError expected):rest) =
183 ((Test literalText testText (Exception expected)):convertLinesToBlocks rest)
184 convertLinesToBlocks ((TestInput testText):(ExpectedResult expected):rest) =
185 ((Test "(undescribed output test)" testText (Output expected)):convertLinesToBlocks rest)
186 convertLinesToBlocks ((TestInput testText):(ExpectedError expected):rest) =
187 ((Test "(undescribed output test)" testText (Exception expected)):convertLinesToBlocks rest)
188 convertLinesToBlocks ((SectionHeading text):rest) =
189 ((Section text):convertLinesToBlocks rest)
190 convertLinesToBlocks ((LiteralText _):(SectionHeading text):rest) =
191 ((Section text):convertLinesToBlocks rest)
192
193 convertLinesToBlocks (_:rest) =
194 convertLinesToBlocks rest
195 convertLinesToBlocks [] = []
196
197 --
198 -- Give blocks that don't have a description, the description of the previous
199 -- block that did have a description. Note that when we encounter a new
200 -- section, we do not remember the previous description, as it will surely
201 -- be irrelevant now.
202 --
203
204 reDescribeBlocks blocks = reDescribeBlocks' blocks "" 2
205
206 reDescribeBlocks' [] desc n =
207 []
208 reDescribeBlocks' (block@(Test literalText inp exp):rest) desc n
209 | allWhitespace literalText = (Test numberedDesc inp exp):(reDescribeBlocks' rest desc (n+1))
210 | otherwise = (block):(reDescribeBlocks' rest literalText 2)
211 where numberedDesc = "(#" ++ (show n) ++ ") " ++ (stripLeading '\n' desc)
212 reDescribeBlocks' (block:rest) desc n =
213 block:(reDescribeBlocks' rest "" 2)
214
215 --
216 -- This could use Char.isSpace
217 --
218
219 allWhitespace [] = True
220 allWhitespace (' ':rest) = allWhitespace rest
221 allWhitespace ('\n':rest) = allWhitespace rest
222 allWhitespace ('\t':rest) = allWhitespace rest
223 allWhitespace (_:rest) = False
22473
22574 --
22675 -- The main test-running engine of Falderal:
275124 putStrLn ""
276125 reportEachTest rest
277126
278 stripLeading y [] = []
279 stripLeading y all@(x:xs)
280 | x == y = stripLeading y xs
281 | otherwise = all
282
283127 reportText width fieldName text =
284128 if
285129 contains text '\n'