git @ Cat's Eye Technologies Falderal / 4e37291
Getting closer to running tests from generated Haskell source. catseye 10 years ago
4 changed file(s) with 40 addition(s) and 14 deletion(s). Raw diff Collapse all Expand all
3131 > parseBits ('0':rest) = (False:parseBits rest)
3232 > parseBits ('1':rest) = (True:parseBits rest)
3333 > parseBits ('\n':rest) = parseBits rest
34
35 > showParseBits = show . parseBits
3436
3537 The Falderal Driver
3638 -------------------
110112 Tests for parseBits
111113 -------------------
112114
113 -> Tests for Haskell function Test.Falderal.Demo:parseBits
115 -> Tests for Haskell function Test.Falderal.Demo:showParseBits
114116
115117 We can test functions of type
116118
3737 -- Formatting function which compiles a Falderal file to Haskell source.
3838 --
3939
40 formatBlocks (test@(Test desc text expectation):rest) =
41 " " ++ (show test) ++ ",\n" ++ (formatBlocks rest)
40 formatBlocks ((functionName, test@(Test desc text expectation)):rest) =
41 " (" ++ functionName ++ ", " ++ (show test) ++ "),\n" ++ (formatBlocks rest)
4242 formatBlocks (_:rest) =
4343 formatBlocks rest
4444 formatBlocks [] =
4545 ""
4646
4747 format _ blocks =
48 (prelude blocks) ++ (formatBlocks blocks) ++ postlude
48 (prelude blocks) ++ (formatBlocks (transformBlocks blocks "")) ++ postlude
4949
5050 gatherImports ((HaskellDirective moduleName functionName):rest) =
51 "import " ++ moduleName ++ "\n" ++ gatherImports rest
51 "import qualified " ++ moduleName ++ "\n" ++ gatherImports rest
5252 gatherImports (_:rest) =
5353 gatherImports rest
5454 gatherImports [] =
5555 ""
5656
57 --
58 -- XXX this hard-codes some stuff, just to see things running
59 -- XXX instead, scan list for HaskellDirectives, pluck out module
60 -- names and turn them into imports. Put function names in
61 -- list somehow.
62 --
57 transformBlocks ((HaskellDirective moduleName functionName):rest) _ =
58 transformBlocks rest (moduleName ++ "." ++ functionName)
59 transformBlocks (test@(Test _ _ _):rest) functionName =
60 (functionName, test):(transformBlocks rest functionName)
61 transformBlocks (_:rest) functionName =
62 transformBlocks rest functionName
63 transformBlocks [] _ =
64 []
6365
6466 prelude blocks =
6567 "module GeneratedFalderalTests where\n\
6769 \import Test.Falderal.Common\n\
6870 \import Test.Falderal.Runner\n" ++ (gatherImports blocks) ++ "\
6971 \\n\
70 \testModule = runTests [] (everySecond) [\n"
72 \testModule = runTests' [\n"
7173
7274 postlude =
73 " (Section \"DONE\")\n\
75 " (id, (Section \"DONE\"))\n\
7476 \ ]\n"
0 module Test.Falderal.Runner (run, runTests) where
0 module Test.Falderal.Runner (run, runTests, runTests') where
11
22 --
33 -- Test.Falderal.Runner -- The Falderal Test Runner
136136 putStrLn text
137137 else do
138138 putStrLn ((pad fieldName width) ++ ": " ++ text)
139
140 --
141 -- This is the new interface
142 --
143
144 runTests' [] = do
145 return []
146 runTests' ((fun, Section sectionText):rest) = do
147 runTests' rest
148 runTests' ((fun, HaskellDirective _ _):rest) = do
149 runTests' rest
150 runTests' ((testFun, Test literalText inputText expected):rest) = do
151 actual <- runFun (testFun) inputText
152 case compareTestOutcomes actual expected of
153 True ->
154 runTests' rest
155 False -> do
156 remainder <- runTests' rest
157 return ((Failure literalText inputText expected actual):remainder)
6464 rm -f formatted.txt
6565
6666 exit $E
67
68 # ghc Test/Falderal/Formatter.hs -e 'formatFile "haskell" "Test/Falderal/Demo.lhs"' > GeneratedFalderalTests.hs
69 # ghc GeneratedFalderalTests.hs -e testModule