git @ Cat's Eye Technologies Falderal / 75e4ee9
Start transitioning to using pragmas. catseye 10 years ago
7 changed file(s) with 33 addition(s) and 3 deletion(s). Raw diff Collapse all Expand all
5858 deriving (Show, Eq, Ord)
5959
6060 data Block = Section String
61 | Directive String -- XXX should be more structured
61 | HaskellDirective String -- XXX should be more structured
6262 | Test String String Expectation
6363 deriving (Show, Eq, Ord)
6464
3535 The Falderal Driver
3636 -------------------
3737
38 Note: this is legacy interface.
39
3840 Naming the test function "test" makes testing the file as simple as:
3941
4042 ghc Test/Falderal/Demo.lhs -e test
4648
4749 Tests for everySecond
4850 ---------------------
51
52 -> Tests for Haskell function Test.Falderal.Demo:everySecond
4953
5054 Every second symbol in the string is retained.
5155
106110 Tests for parseBits
107111 -------------------
108112
113 -> Tests for Haskell function Test.Falderal.Demo:parseBits
114
109115 We can test functions of type
110116
111117 f :: (Show a) => String -> a
4949
5050 --
5151 -- XXX this hard-codes some stuff, just to see things running
52 -- XXX instead, scan list for HaskellDirectives, pluck out module
53 -- names and turn them into imports. Put function names in
54 -- list somehow.
5255 --
5356
5457 prelude = "module GeneratedFalderalTests where\n\
4848 (prefixEachLine "" text)
4949 formatLine (QuotedCode text) =
5050 (prefixEachLine "> " text)
51 formatLine (Pragma text) =
52 (prefixEachLine "->" text)
5153 formatLine (SectionHeading text) =
5254 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
5355
4949 (prefixEachLine "" text)
5050 formatLine (QuotedCode text) =
5151 (prefixEachLine " " text)
52 formatLine (Pragma text) =
53 (prefixEachLine " ->" text)
5254 formatLine (SectionHeading text) =
5355 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
5456
3131 -- POSSIBILITY OF SUCH DAMAGE.
3232 --
3333
34 import Data.List
3435 import System
3536
3637 import Test.Falderal.Common
128129 ((Test "(undescribed output test)" testText (Exception expected)):convertLinesToBlocks rest)
129130 convertLinesToBlocks ((SectionHeading text):rest) =
130131 ((Section text):convertLinesToBlocks rest)
131 convertLinesToBlocks ((Pragma text):rest) = -- XXX parse the pragma text here
132 ((Directive text):convertLinesToBlocks rest)
132 convertLinesToBlocks ((Pragma text):rest) =
133 ((parsePragma (stripLeading ' ' text)):convertLinesToBlocks rest)
133134 convertLinesToBlocks ((LiteralText _):(SectionHeading text):rest) =
134135 ((Section text):convertLinesToBlocks rest)
135136
154155 where numberedDesc = "(#" ++ (show n) ++ ") " ++ (stripLeading '\n' desc)
155156 reDescribeBlocks' (block:rest) desc n =
156157 block:(reDescribeBlocks' rest "" 2)
158
159 --
160 -- Parse a pragma.
161 --
162
163 parsePragma text =
164 case stripPrefix "Tests for " text of
165 Just rest ->
166 case stripPrefix "Haskell function " rest of
167 Just specifier -> HaskellDirective specifier
168 Nothing -> error "bad pragma"
169 Nothing ->
170 error "bad pragma"
8181 -- select a new testFun from the funMap
8282 testFun' <- return $ selectTestFun funMap sectionText
8383 runTests funMap testFun' rest
84 runTests funMap testFun ((HaskellDirective _):rest) = do
85 -- XXX ignored for now
86 runTests funMap testFun rest
8487 runTests funMap testFun ((Test literalText inputText expected):rest) = do
8588 actual <- runFun (testFun) inputText
8689 case compareTestOutcomes actual expected of