git @ Cat's Eye Technologies Falderal / 7a8a0fd
Take the leap to the new way of running tests. --HG-- rename : Test/Falderal/Runner.hs => Test/Falderal/Driver.hs catseye 13 years ago
6 changed file(s) with 121 addition(s) and 133 deletion(s). Raw diff Collapse all Expand all
+12
-0
Test/Falderal/Common.hs less more
6363 deriving (Show, Eq, Ord)
6464
6565 --
66 -- Data type for test results.
67 --
68 -- First element is the literal text preceding the test.
69 -- Second element is the textual input to the test.
70 -- Third element is the result that we expected from the test.
71 -- Fourth element is the actual result of the test.
72 --
73
74 data Result = Failure String String Expectation Expectation
75 deriving (Show, Eq, Ord)
76
77 --
6678 -- Common functions.
6779 --
6880
+0
-15
Test/Falderal/Demo.lhs less more
00 > module Test.Falderal.Demo where
1 > import qualified Test.Falderal.Runner as Runner
21
32 Test.Falderal.Demo
43 ==================
3332 > parseBits ('\n':rest) = parseBits rest
3433
3534 > showParseBits = show . parseBits
36
37 The Falderal Driver
38 -------------------
39
40 Note: this is legacy interface.
41
42 Naming the test function "test" makes testing the file as simple as:
43
44 ghc Test/Falderal/Demo.lhs -e test
45
46 > test = Runner.run ["Test/Falderal/Demo.lhs"] [] [
47 > ("Tests for everySecond", everySecond),
48 > ("Tests for parseBits", show . parseBits)
49 > ]
5035
5136 Tests for everySecond
5237 ---------------------
+84
-0
Test/Falderal/Driver.hs less more
0 module Test.Falderal.Driver (test, format) where
1
2 --
3 -- Test.Falderal.Driver -- Driver for Falderal Testing and Formatting
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 import Test.Falderal.Common
37 import Test.Falderal.Loader
38 import Test.Falderal.Runner
39 import Test.Falderal.Formatter
40
41 --
42 -- Entry point for test runner.
43 -- XXX This is still in flux.
44 --
45
46 test testTuples = let
47 numTests = length (filter (isTest) testTuples)
48 in do
49 failures <- runTests testTuples
50 putStrLn "--------------------------------"
51 putStrLn ("Total tests: " ++ (show numTests) ++ ", failures: " ++ (show (length failures)))
52 putStrLn "--------------------------------\n"
53 reportEachTest failures
54
55 reportEachTest [] = do
56 return ()
57 reportEachTest ((Failure literalText testText expected actual):rest) = do
58 reportText 8 "FAILED" (stripLeading '\n' (stripTrailing '\n' literalText))
59 putStrLn ""
60 reportText 8 "Input" testText
61 reportText 8 "Expected" (show expected)
62 reportText 8 "Actual" (show actual)
63 putStrLn ""
64 reportEachTest rest
65
66 reportText width fieldName text =
67 if
68 contains text '\n'
69 then do
70 putStrLn (fieldName ++ ":")
71 putStrLn text
72 else do
73 putStrLn ((pad fieldName width) ++ ": " ++ text)
74
75 isTest (_, (Test _ _ _)) = True
76 isTest _ = False
77
78 --
79 -- Entry point for formatter.
80 --
81
82 format formatName fileName =
83 formatFile formatName fileName
+2
-2
Test/Falderal/Formatter/Haskell.hs less more
6767 "module GeneratedFalderalTests where\n\
6868 \\n\
6969 \import Test.Falderal.Common\n\
70 \import Test.Falderal.Runner\n" ++ (gatherImports blocks) ++ "\
70 \import Test.Falderal.Driver\n" ++ (gatherImports blocks) ++ "\
7171 \\n\
72 \testModule = runTests' [\n"
72 \testModule = test [\n"
7373
7474 postlude =
7575 " (id, (Section \"DONE\"))\n\
+9
-104
Test/Falderal/Runner.hs less more
0 module Test.Falderal.Runner (run, runTests, runTests') where
0 module Test.Falderal.Runner (runTests) where
11
22 --
33 -- Test.Falderal.Runner -- The Falderal Test Runner
3131 -- POSSIBILITY OF SUCH DAMAGE.
3232 --
3333
34 import System
3534 import qualified Control.Exception as Exc
3635
3736 import Test.Falderal.Common
38 import Test.Falderal.Loader -- XXX
3937
4038 --
41 -- Definitions.
42 --
43 -- First element is the literal text preceding the test.
44 -- Second element is the textual input to the test.
45 -- Third element is the result that we expected from the test.
46 -- Fourth element is the actual result of the test.
39 -- Test-running engine. Takes a list of (function, block) tuples;
40 -- any block that is not a Test is simply ignored.
4741 --
4842
49 data Result = Failure String String Expectation Expectation
50 deriving (Show, Eq, Ord)
51
52 --
53 -- Main entry point to test runner.
54 --
55 -- First argument is a list of filenames to harvest and run tests from.
56 -- Second argument is a "property list" of options in String format,
57 -- currently not used.
58 -- Third argument maps section headers to the function to be tested in
59 -- that section.
60 --
61
62 run :: [String] -> [(String, String)] -> [(String, String -> String)] -> IO ()
63
64 run [] options funMap =
65 return ()
66 run (filename:filenames) options funMap = do
67 loadAndRunTests filename funMap
68 run filenames options funMap
69
70 loadAndRunTests fileName funMap = do
71 (_, blocks) <- loadFile fileName
72 reportTests funMap blocks
73
74 --
75 -- The main test-running engine of Falderal:
76 --
77
78 runTests funMap testFun [] = do
43 runTests [] = do
7944 return []
80 runTests funMap testFun ((Section sectionText):rest) = do
81 -- select a new testFun from the funMap
82 testFun' <- return $ selectTestFun funMap sectionText
83 runTests funMap testFun' rest
84 runTests funMap testFun ((HaskellDirective _ _):rest) = do
85 -- XXX ignored for now
86 runTests funMap testFun rest
87 runTests funMap testFun ((Test literalText inputText expected):rest) = do
45 runTests ((testFun, Test literalText inputText expected):rest) = do
8846 actual <- runFun (testFun) inputText
8947 case compareTestOutcomes actual expected of
9048 True ->
91 runTests funMap testFun rest
49 runTests rest
9250 False -> do
93 remainder <- runTests funMap testFun rest
51 remainder <- runTests rest
9452 return ((Failure literalText inputText expected actual):remainder)
95
96 selectTestFun ((text, fun):rest) sectionText
97 | text == sectionText = fun
98 | otherwise = selectTestFun rest sectionText
53 runTests (_:rest) = do
54 runTests rest
9955
10056 runFun testFun inputText = do
10157 Exc.catch (Exc.evaluate (Output $! (testFun inputText)))
10460 -- This may be improved to do pattern-matching of some kind, someday.
10561 compareTestOutcomes actual expected =
10662 actual == expected
107
108 isTest (Test _ _ _) = True
109 isTest _ = False
110
111 reportTests funMap tests = let
112 numTests = length (filter (isTest) tests)
113 in do
114 failures <- runTests funMap (\x -> error "No test function selected") tests
115 putStrLn "--------------------------------"
116 putStrLn ("Total tests: " ++ (show numTests) ++ ", failures: " ++ (show (length failures)))
117 putStrLn "--------------------------------\n"
118 reportEachTest failures
119
120 reportEachTest [] = do
121 return ()
122 reportEachTest ((Failure literalText testText expected actual):rest) = do
123 reportText 8 "FAILED" (stripLeading '\n' (stripTrailing '\n' literalText))
124 putStrLn ""
125 reportText 8 "Input" testText
126 reportText 8 "Expected" (show expected)
127 reportText 8 "Actual" (show actual)
128 putStrLn ""
129 reportEachTest rest
130
131 reportText width fieldName text =
132 if
133 contains text '\n'
134 then do
135 putStrLn (fieldName ++ ":")
136 putStrLn text
137 else do
138 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)
+14
-12
test.sh less more
00 #!/bin/sh
11
22 # A tiny test harness for Falderal itself.
3
4 ghc Test/Falderal/Driver.hs -e 'format "identity" "Test/Falderal/Demo.lhs"' >formatted.txt
5 diff -u Test/Falderal/Demo.lhs formatted.txt
6 E1=$?
7 rm -f formatted.txt
38
49 cat >expected.txt <<EOF
510 --------------------------------
5358 Actual : Output "[False,False,False,False]"
5459
5560 EOF
56 ghc Test/Falderal/Demo.lhs -e test >actual.txt
57 diff -u expected.txt actual.txt
58 E=$?
61 ghc Test/Falderal/Driver.hs -e 'format "haskell" "Test/Falderal/Demo.lhs"' > GeneratedFalderalTests.hs
62 ghc GeneratedFalderalTests.hs -e testModule >actual.txt
63 E2=$?
5964 rm -f expected.txt actual.txt
6065
61 ghc Test/Falderal/Formatter.hs -e 'formatFile "identity" "Test/Falderal/Demo.lhs"' >formatted.txt
62 diff -u Test/Falderal/Demo.lhs formatted.txt
63 E=$?
64 rm -f formatted.txt
65
66 exit $E
67
68 # ghc Test/Falderal/Formatter.hs -e 'formatFile "haskell" "Test/Falderal/Demo.lhs"' > GeneratedFalderalTests.hs
69 # ghc GeneratedFalderalTests.hs -e testModule
66 if [ $E1 != 0 -o $E2 != 0 ]
67 then
68 exit 1
69 else
70 exit 0
71 fi