git @ Cat's Eye Technologies Falderal / 3736f18
Remove the old, bitrotting Haskell implementation. Chris Pressey 7 years ago
31 changed file(s) with 1 addition(s) and 2027 deletion(s). Raw diff Collapse all Expand all
22
33 Version 0.10-PRE "Shedd Aquarium" (current development version):
44
5 * (nothing yet)
5 * Removed the old, bitrotting Haskell implementation.
66
77 Version 0.9-2014.0525 "Municipal Pier #2, May 25th 2014" (current released
88 version):
+0
-49
impl/Test.Falderal/Falderal.cabal less more
0 -- encoding: UTF-8
1 name: Falderal
2 version: 0.7
3 cabal-version: >= 1.8
4 build-type: Simple
5 license: BSD3
6 category: Testing
7 author: Chris Pressey <cpressey@gmail.com>
8 maintainer: Chris Pressey <cpressey@gmail.com>
9 stability: alpha
10 tested-with: GHC == 7.4.1
11 synopsis: Framework for running and formatting literate test suites
12 homepage: http://catseye.tc/projects/falderal/
13 bug-reports: https://bitbucket.org/catseye/falderal/issues
14 description:
15 Falderal is a file format for literate test suites. It is particularly
16 suited for documenting programming languages (or other specifications of
17 ways to transform text) and testing their implementation(s) in a
18 language-agnostic fashion. Test.Falderal is a reference implementation,
19 written in Haskell, of tools for formatting and running Falderal tests.
20
21 library
22 build-depends: base >= 4.0, process >= 1.1
23 exposed-modules: Test.Falderal.Runner
24 Test.Falderal.Common
25 Test.Falderal.Loader
26 Test.Falderal.Partitioner
27 Test.Falderal.Formatter
28 Test.Falderal.Reporter
29 other-modules: Test.Falderal.Formatter.Identity
30 Test.Falderal.Formatter.Haskell
31 Test.Falderal.Formatter.Shell
32 Test.Falderal.Formatter.Markdown
33 Test.Falderal.Reporter.Standard
34
35 executable falderal
36 main-is: falderal.hs
37 build-depends: base >= 4.0, process >= 1.1
38 other-modules: Test.Falderal.Common
39 Test.Falderal.Loader
40 Test.Falderal.Partitioner
41 Test.Falderal.Runner
42 Test.Falderal.Runner.Shell
43 Test.Falderal.Formatter
44 Test.Falderal.Reporter.Standard
45
46 source-repository head
47 type: mercurial
48 location: https://bitbucket.org/catseye/falderal
+0
-3
impl/Test.Falderal/Setup.hs less more
0 #!/usr/bin/env runhaskell
1 import Distribution.Simple
2 main = defaultMain
+0
-165
impl/Test.Falderal/Test/Falderal/Common.hs less more
0 module Test.Falderal.Common where
1
2 --
3 -- Test.Falderal.Common -- Common data def'n and functions for Falderal
4 --
5
6 import qualified Data.Char as Char
7
8 --
9 -- Definitions for the structure of a test suite in Falderal format.
10 --
11
12 --
13 -- Before processing...
14 --
15
16 data Line = TestInput String
17 | ExpectedResult String
18 | ExpectedError String
19 | LiteralText String
20 | QuotedCode String
21 | SectionHeading String
22 | Pragma String (Maybe Directive)
23 | Placeholder
24 deriving (Show, Eq, Ord)
25
26 --
27 -- ...and in the middle of processing...
28 --
29
30 data Directive = TestsFor Functionality
31 | FunctionalityDefinition String Functionality
32 | Encoding String
33 deriving (Show, Eq, Ord)
34
35 data Functionality = HaskellTest String String -- module name, function name
36 | ShellTest String -- command
37 | NamedFunctionality String
38 deriving (Eq, Ord)
39
40 instance Show Functionality where
41 show (HaskellTest m f) = "Haskell function " ++ m ++ ":" ++ f
42 show (ShellTest c) = "Shell command \"" ++ c ++ "\""
43 show (NamedFunctionality f) = "functionality \"" ++ f ++ "\""
44
45 --
46 -- ...and after.
47 --
48
49 data Expectation = Output String
50 | Exception String
51 deriving (Show, Eq, Ord)
52
53 --
54 -- First element is the test ID.
55 -- Second element is a list of functionalities being tested.
56 -- Third element is the literal text preceding the test.
57 -- Fourth element is the textual input to the test.
58 -- Fifth element is what we expect the test to result in.
59 -- Sixth element is the actual result of the test, after it has been run.
60 --
61
62 data Block = Section String
63 | Directive Directive
64 | Test Int [Functionality] String String Expectation (Maybe Expectation)
65 deriving (Show, Eq, Ord)
66
67 data Result = Result Int Expectation
68 deriving (Ord, Eq, Show)
69
70 --
71 -- Common functions.
72 --
73
74 -- TODO: How many of these can be replaced by standard Haskell functions?
75
76 discoverRepeatedCharacter [] =
77 Nothing
78 discoverRepeatedCharacter (first:rest)
79 | all (\x -> x == first) rest = Just first
80 | otherwise = Nothing
81
82 allWhitespace = all Char.isSpace
83
84 stripLeading y = dropWhile $ \x -> x == y
85
86 stripTrailing y str = reverse (stripLeading y (reverse str))
87
88 stripLeadingWhitespace = dropWhile $ Char.isSpace
89
90 --
91 -- A version of `lines` that always considers the input "" to
92 -- represent a single, blank line.
93 --
94
95 allLines x =
96 case (lines x) of
97 [] -> [""]
98 other -> other
99
100 prefixEachLine prefix text =
101 foldl (++) "" (map (\x -> prefix ++ x ++ "\n") (allLines text))
102
103 mapEachLine fn text =
104 foldl (++) "" (map (\x -> (fn x) ++ "\n") (allLines text))
105
106 escapeHtml "" = ""
107 escapeHtml ('<':rest) = "&lt;" ++ escapeHtml rest
108 escapeHtml ('>':rest) = "&gt;" ++ escapeHtml rest
109 escapeHtml ('&':rest) = "&amp;" ++ escapeHtml rest
110 escapeHtml (c:cs) = c:(escapeHtml cs)
111
112 escapeSingleQuotes "" = ""
113 escapeSingleQuotes ('\'':rest) = "'\\''" ++ escapeSingleQuotes rest
114 escapeSingleQuotes (c:cs) = c:(escapeSingleQuotes cs)
115
116 formatLines formatter lines = foldl (++) "" (map (formatter) lines)
117
118 pad s n = padFrom s (n-(length s))
119 padFrom s n
120 | n <= 0 = s
121 | otherwise = padFrom (s ++ " ") (n-1)
122
123 join _ [] = ""
124 join _ [x] = x
125 join glue (x:xs) = x ++ glue ++ (join glue xs)
126
127 --
128 -- Parse the first natural number out of a string. It's allowable for there
129 -- to be non-numeric digits following the last digit; they are ignored.
130 --
131
132 parseNatNumStr [] acc = acc
133 parseNatNumStr (x:xs) acc
134 | Char.isDigit x =
135 parseNatNumStr xs (acc * 10 + ((Char.ord x) - (Char.ord '0')))
136 | otherwise =
137 acc
138
139 expandVariables "" alist =
140 ""
141 expandVariables ('%':'(':rest) alist =
142 let
143 (name, rest') = getName rest
144 in
145 case lookup name alist of
146 Just value ->
147 value ++ (expandVariables rest' alist)
148 Nothing ->
149 "%(" ++ name ++ ")" ++ expandVariables rest' alist
150 where
151 getName "" =
152 ("", "")
153 getName (')':rest) =
154 ("", rest)
155 getName (c:rest) =
156 let
157 (remainder, rest') = getName rest
158 in
159 ((c:remainder), rest')
160 expandVariables (c:rest) alist =
161 (c:expandVariables rest alist)
162
163 containsVariable str var =
164 expandVariables str [(var, "foo")] /= str
+0
-76
impl/Test.Falderal/Test/Falderal/Formatter/Haskell.hs less more
0 module Test.Falderal.Formatter.Haskell (format) where
1
2 --
3 -- Test.Falderal.Formatter.Haskell -- Haskell compiler for Falderal
4 --
5
6 import Test.Falderal.Common
7
8 --
9 -- Formatting function which compiles a Falderal file to Haskell source.
10 --
11 -- XXX tests should be partitioned before this is called, but this should
12 -- be able to handle multiple Haskell-implemented functionalities.
13 --
14
15 format _ blocks =
16 (prelude blocks) ++ (formatBlocks blocks) ++ postlude
17
18 formatBlocks (test@(Test id [(HaskellTest moduleName functionName)] desc text expectation _):rest) =
19 let
20 fn = moduleName ++ "." ++ functionName
21 in
22 " (" ++ (show id) ++ ", " ++ fn ++ ", " ++ (show text) ++ "),\n" ++ (formatBlocks rest)
23 formatBlocks (_:rest) =
24 formatBlocks rest
25 formatBlocks [] =
26 ""
27
28 gatherImports ((Test id [(HaskellTest moduleName functionName)] _ _ _ _):rest) mNames
29 | moduleName `elem` mNames = gatherImports rest mNames
30 | otherwise =
31 "import qualified " ++ moduleName ++ "\n" ++ gatherImports rest (moduleName:mNames)
32 gatherImports (_:rest) mNames =
33 gatherImports rest mNames
34 gatherImports [] _ =
35 ""
36
37 prelude blocks =
38 "-- This file was automatically generated by Test.Falderal.Formatter.Haskell\n\
39 \-- Edit at your own risk!\n\
40 \\n\
41 \import qualified Control.Exception as Exc\n\
42 \" ++ (gatherImports blocks []) ++ "\
43 \\n\
44 \runFun testFun inputText = do\n\
45 \ Exc.catch (Exc.evaluate (Left $! (testFun inputText)))\n\
46 \ (\\exception -> return (Right (show (exception :: Exc.SomeException))))\n\
47 \\n\
48 \getKind (Left _) = \"output\"\n\
49 \getKind (Right _) = \"exception\"\n\
50 \getText (Left x) = x\n\
51 \getText (Right x) = x\n\
52 \addTrailingNewline s = if (last s) == '\\n' then s else s ++ \"\\n\"\n\
53 \report [] = do\n\
54 \ return ()\n\
55 \report ((-1,_,_):rest) =\n\
56 \ report rest\n\
57 \report ((id,fun,input):rest) = do\n\
58 \ result <- runFun (fun) input\n\
59 \ numLines <- return $ length $ lines $ getText result\n\
60 \ putStrLn (getKind result)\n\
61 \ putStrLn (show id)\n\
62 \ putStrLn (show numLines)\n\
63 \ case numLines of\n\
64 \ 0 -> do\n\
65 \ report rest\n\
66 \ _ -> do\n\
67 \ putStr $ addTrailingNewline $ getText result\n\
68 \ report rest\n\
69 \\n\
70 \main = report [\n"
71
72 postlude =
73 " (-1,id,\"\")\n\
74 \ ]\n"
75
+0
-29
impl/Test.Falderal/Test/Falderal/Formatter/Identity.hs less more
0 module Test.Falderal.Formatter.Identity (format) where
1
2 --
3 -- Test.Falderal.Formatter.Identity -- Identity formatter for Falderal format
4 --
5
6 import Test.Falderal.Common
7
8 --
9 -- Formatting function which formats a Falderal file to an identical
10 -- Falderal file.
11 --
12
13 formatLine (TestInput text) =
14 (prefixEachLine "| " text)
15 formatLine (ExpectedResult text) =
16 (prefixEachLine "= " text)
17 formatLine (ExpectedError text) =
18 (prefixEachLine "? " text)
19 formatLine (LiteralText text) =
20 (prefixEachLine "" text)
21 formatLine (QuotedCode text) =
22 (prefixEachLine "> " text)
23 formatLine (Pragma text _) =
24 (prefixEachLine "->" text)
25 formatLine (SectionHeading text) =
26 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
27
28 format lines _ = formatLines (formatLine) lines
+0
-48
impl/Test.Falderal/Test/Falderal/Formatter/Markdown.hs less more
0 module Test.Falderal.Formatter.Markdown (format) where
1
2 --
3 -- Test.Falderal.Formatter.Markdown -- Markdown formatter for Falderal format
4 --
5
6 import Test.Falderal.Common
7
8 --
9 -- Formatting function which formats a Falderal file to vanilla Markdown
10 -- file. Falderal-specific sections (test input, expected results) are still
11 -- presented with Falderal syntax.
12 --
13 -- Bird-style embedded code is translated to HTML embedded in the Markdown,
14 -- with a specific class on the `pre` element, `quoted-code`. Two reasons:
15 --
16 -- 1. In the LHS->Markdown path, Markdown is most likely an intermediate
17 -- step, before conversion to HTML or such; it's not so important that
18 -- it be easily readable.
19 -- 2. This gives you a way to distinguish between plain indented code
20 -- blocks in Markdown, and blocks of embedded code.
21 --
22 -- Given that there are innumerable ways you might want to tweak the
23 -- output of this formatter, either falderal should let you pass formatter-
24 -- specific options to the formatter, or falderal should get out of the
25 -- formatting-to-Markdown business.
26 --
27
28 formatLine (TestInput text) =
29 (prefixEachLine " | " text)
30 formatLine (ExpectedResult text) =
31 (prefixEachLine " = " text)
32 formatLine (ExpectedError text) =
33 (prefixEachLine " ? " text)
34 formatLine (LiteralText text) =
35 (prefixEachLine "" text)
36 formatLine (QuotedCode text) =
37 "<pre class=\"quoted-code\"><code>" ++
38 (mapEachLine (escapeHtml) text) ++
39 "</code></pre>"
40 formatLine (Pragma text (Just (Encoding _))) =
41 ""
42 formatLine (Pragma text _) =
43 (prefixEachLine " ->" text)
44 formatLine (SectionHeading text) =
45 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
46
47 format lines _ = formatLines (formatLine) lines
+0
-87
impl/Test.Falderal/Test/Falderal/Formatter/Shell.hs less more
0 module Test.Falderal.Formatter.Shell (format, expandCommand) where
1
2 --
3 -- Test.Falderal.Formatter.Shell -- Bourne shell script compiler for Falderal
4 --
5
6 import Test.Falderal.Common
7
8 --
9 -- Formatting function which compiles a Falderal file to a shell script.
10 --
11 -- XXX tests should be partitioned before this is called, but this should
12 -- be able to handle multiple shell-implemented functionalities.
13 --
14
15 format _ blocks =
16 prelude ++ (formatBlocks blocks) ++ postlude
17
18 formatBlocks (test@(Test id [(ShellTest cmd)] desc body _ _):rest) =
19 let
20 inputHereDoc = hereDoc "input.txt" body
21 cmd' = expandCommand cmd body
22 formattedBlock = inputHereDoc ++ testExecution cmd' id
23 in
24 formattedBlock ++ "\n" ++ formatBlocks rest
25 formatBlocks (_:rest) =
26 formatBlocks rest
27 formatBlocks [] =
28 ""
29
30 -- XXX derive sentinel from text
31
32 hereDoc filename text =
33 "cat >" ++ filename ++ " <<EOF\n" ++ text ++ "\nEOF\n"
34
35 prelude =
36 "#!/bin/sh\n\
37 \\n\
38 \# This file was automatically generated by Test.Falderal.Formatter.Shell\n\
39 \# Edit at your own risk!\n\
40 \\n"
41
42 postlude =
43 "\n\
44 \rm -f input.txt output.txt\n"
45
46 -- TODO: capture output/errors from command, even when output variable
47 -- is present
48
49 expandCommand cmd body =
50 let
51 substitutions = [
52 ("test-file", "input.txt"),
53 ("test-text", escapeSingleQuotes body),
54 ("output-file", "output.txt")
55 ]
56 suppliedInput =
57 if
58 containsVariable cmd "test-file" ||
59 containsVariable cmd "test-text"
60 then
61 ""
62 else
63 " <input.txt"
64 providedOutput =
65 if
66 containsVariable cmd "output-file"
67 then
68 ""
69 else
70 " >output.txt"
71 cmd' = expandVariables cmd substitutions
72 in
73 cmd' ++ suppliedInput ++ providedOutput
74
75 testExecution cmd id =
76 cmd ++ " 2>&1\n\
77 \if [ $? != 0 ]; then\n\
78 \ echo \"exception\"\n\
79 \else\n\
80 \ echo \"output\"\n\
81 \fi\n\
82 \echo " ++ (show id) ++ "\n\
83 \falderal newlinify output.txt >output2.txt\n\
84 \mv output2.txt output.txt\n\
85 \echo `wc -l output.txt`\n\
86 \cat output.txt\n"
+0
-43
impl/Test.Falderal/Test/Falderal/Formatter.hs less more
0 module Test.Falderal.Formatter (format) where
1
2 --
3 -- Test.Falderal.Formatter -- The Falderal Test Suite Formatter
4 --
5
6 import System.IO
7
8 import Test.Falderal.Common
9 import qualified Test.Falderal.Formatter.Identity as Identity
10 import qualified Test.Falderal.Formatter.Markdown as Markdown
11 import qualified Test.Falderal.Formatter.Haskell as Haskell
12 import qualified Test.Falderal.Formatter.Shell as Shell
13
14 --
15 -- Driver for Falderal file formatting.
16 --
17
18 --
19 -- Map from names of formats to formatter functions.
20 --
21
22 getFormatter "identity" = Identity.format
23 getFormatter "markdown" = Markdown.format
24 getFormatter "haskell" = Haskell.format
25 getFormatter "shell" = Shell.format
26 getFormatter "dump" = dumpLines
27
28 dumpLines lines blocks = formatLines (\x -> (show x) ++ "\n") lines
29
30 --
31 -- Some formats, mainly the "human-readable" ones, format by (coalesced)
32 -- lines, because by the time the file has been parsed into blocks, some
33 -- content has been dropped.
34 --
35 -- Other formats, mainly the "run these tests" ones, format by blocks,
36 -- because they contain the most relevant information for testing.
37 --
38 -- This is why loadFile returns both.
39 --
40
41 format format lines blocks =
42 (getFormatter format) lines blocks
+0
-320
impl/Test.Falderal/Test/Falderal/Loader.hs less more
0 module Test.Falderal.Loader (
1 loadFile,
2 loadText,
3 parseFunctionality,
4 collectFunctionalityDefinitions,
5 stripFunctionalities,
6 assignFunctionalities
7 ) where
8
9 --
10 -- Test.Falderal.Loader -- The Falderal Test Loader
11 --
12
13 import Data.List
14
15 import Test.Falderal.Common
16
17 --
18 -- File loading functions.
19 --
20
21 loadFile fileName = do
22 testText <- readFile fileName
23 (ls, bs) <- return $ loadText testText
24 return (ls, bs)
25
26 --
27 -- Returns a pair of the lines and the blocks, allowing the caller to choose
28 -- which one they want to look at.
29 --
30 -- Note that the lines so returned are coalesced, and contain parsed pragmas.
31 --
32 -- Note that the blocks so returned are redescribed, but are not processed;
33 -- that is, the list still contains Directives and Sections, and tests are
34 -- not assigned functionalities. We leave this up to the caller.
35 -- The functions to do this should maybe be in some module other than this one.
36 --
37
38 loadText text =
39 let
40 ls = resolvePragmas $ transformLines $ lines text
41 bs = reDescribeBlocks $ convertLinesToBlocks ls
42 in
43 (ls, bs)
44
45 transformLines ls =
46 let
47 ls' = map classifyLine ls
48 ls'' = findSectionHeadings ls' Placeholder
49 ls''' = coalesceLines ls'' Placeholder
50 in
51 stripPlaceholders ls'''
52
53 stripPlaceholders [] = []
54 stripPlaceholders (Placeholder:rest) = stripPlaceholders rest
55 stripPlaceholders (other:rest) = other:(stripPlaceholders rest)
56
57 classifyLine line
58 | indent == " " = classifyLine unindentedLine
59 | prefix == "| " = TestInput suffix
60 | prefix == "= " = ExpectedResult suffix
61 | prefix == "? " = ExpectedError suffix
62 | prefix == "> " = QuotedCode suffix
63 | prefix == "->" = Pragma suffix Nothing
64 | otherwise = LiteralText line
65 where
66 prefix = take 2 line
67 suffix = drop 2 line
68 indent = take 4 line
69 unindentedLine = drop 4 line
70
71 findSectionHeadings [] last =
72 [last]
73 findSectionHeadings ((line@(LiteralText suspectedUnderline)):lines) last@(LiteralText suspectedHeading) =
74 if
75 ((discoverRepeatedCharacter suspectedUnderline) == Just '-') &&
76 ((length suspectedUnderline) == (length suspectedHeading))
77 then
78 findSectionHeadings lines (SectionHeading suspectedHeading)
79 else
80 (last:findSectionHeadings lines line)
81 findSectionHeadings (line:lines) last =
82 (last:findSectionHeadings lines line)
83
84 --
85 -- Coalesce neigbouring lines. For each line, if it is classified the
86 -- same way as the line previously examined, combine them.
87 --
88
89 coalesceLines [] last =
90 [last]
91 coalesceLines ((TestInput more):lines) (TestInput last) =
92 coalesceLines lines (TestInput (last ++ "\n" ++ more))
93 coalesceLines ((ExpectedResult more):lines) (ExpectedResult last) =
94 coalesceLines lines (ExpectedResult (last ++ "\n" ++ more))
95 coalesceLines ((ExpectedError more):lines) (ExpectedError last) =
96 coalesceLines lines (ExpectedError (last ++ "\n" ++ more))
97 coalesceLines ((LiteralText more):lines) (LiteralText last) =
98 coalesceLines lines (LiteralText (last ++ "\n" ++ more))
99 coalesceLines ((QuotedCode more):lines) (QuotedCode last) =
100 coalesceLines lines (QuotedCode (last ++ "\n" ++ more))
101 coalesceLines ((Pragma more Nothing):lines) (Pragma last Nothing) =
102 coalesceLines lines (Pragma (last ++ "\n" ++ more) Nothing)
103 coalesceLines (line:lines) (LiteralText last) =
104 ((LiteralText (last ++ "\n")):coalesceLines lines line)
105 coalesceLines (line:lines) last =
106 (last:coalesceLines lines line)
107
108 resolvePragmas ((Pragma text Nothing):rest) =
109 ((Pragma text $ Just $ parsePragma text):resolvePragmas rest)
110 resolvePragmas (other:rest) = (other:resolvePragmas rest)
111 resolvePragmas [] = []
112
113 --
114 -- Convert (coalesced) lines to blocks. We expect the pragmas to have
115 -- been parsed, and retain directives from them in the blocks.
116 --
117
118 convertLinesToBlocks :: [Line] -> [Block]
119
120 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedResult expected):rest) =
121 (Test 0 [] literalText testText (Output expected) Nothing):convertLinesToBlocks rest
122 convertLinesToBlocks ((LiteralText literalText):(TestInput testText):(ExpectedError expected):rest) =
123 (Test 0 [] literalText testText (Exception expected) Nothing):convertLinesToBlocks rest
124 convertLinesToBlocks ((TestInput testText):(ExpectedResult expected):rest) =
125 (Test 0 [] "(undescribed output test)" testText (Output expected) Nothing):convertLinesToBlocks rest
126 convertLinesToBlocks ((TestInput testText):(ExpectedError expected):rest) =
127 (Test 0 [] "(undescribed error test)" testText (Exception expected) Nothing):convertLinesToBlocks rest
128 convertLinesToBlocks ((SectionHeading text):rest) =
129 (Section text):convertLinesToBlocks rest
130 convertLinesToBlocks ((Pragma _ (Just dir)):rest) =
131 (Directive dir):convertLinesToBlocks rest
132 convertLinesToBlocks ((LiteralText _):(SectionHeading text):rest) =
133 ((Section text):convertLinesToBlocks rest)
134 convertLinesToBlocks (_:rest) =
135 convertLinesToBlocks rest
136 convertLinesToBlocks [] = []
137
138 --
139 -- Remove all tests for the given functionality from a list of blocks.
140 -- The functionality to be removed is typically a NamedFunctionality.
141 -- Third argument should initially be False, and indicates whether we are
142 -- stripping.
143 --
144
145 stripFunctionalities :: [Block] -> [Functionality] -> Bool -> [Block]
146
147 stripFunctionalities [] _ _ = []
148 stripFunctionalities (d@(Directive (TestsFor fn)):rest) fns _
149 | fn `elem` fns = stripFunctionalities rest fns True
150 | otherwise = d:stripFunctionalities rest fns False
151 stripFunctionalities (other:rest) names False =
152 other:stripFunctionalities rest names False
153 stripFunctionalities (other:rest) names True =
154 stripFunctionalities rest names True
155
156 --
157 -- Give each test block a functionality, expanding named functionalities to
158 -- concrete functionalities as needed. Strip all Directives and Sections
159 -- from the list of blocks.
160 --
161
162 assignFunctionalities :: [Block] -> [Functionality] -> [(String, Functionality)] -> [Block]
163
164 assignFunctionalities ((Test 0 [] literalText testText expectation Nothing):rest) [] fnMap =
165 error "Found a test before any Tests-for was specified"
166
167 assignFunctionalities ((Test 0 [] literalText testText expectation Nothing):rest) fns fnMap =
168 (Test 0 fns literalText testText expectation Nothing):assignFunctionalities rest fns fnMap
169
170 assignFunctionalities ((Directive (TestsFor (NamedFunctionality name))):rest) fns fnMap =
171 case map (snd) $ filter (\(s,fn) -> s == name) fnMap of
172 [] -> error ("Can't find functionality \"" ++ name ++ "\" in " ++ (show fnMap))
173 fns' -> assignFunctionalities rest fns' fnMap
174
175 assignFunctionalities ((Directive (TestsFor fn)):rest) fns fnMap =
176 assignFunctionalities rest [fn] fnMap
177
178 assignFunctionalities (_:rest) fns fnMap =
179 assignFunctionalities rest fns fnMap
180
181 assignFunctionalities [] _ _ = []
182
183 --
184 -- Collect Functionality-definition pragmas.
185 --
186
187 collectFunctionalityDefinitions ((Pragma _ (Just (FunctionalityDefinition name functionality))):rest) =
188 ((name, functionality):collectFunctionalityDefinitions rest)
189 collectFunctionalityDefinitions (_:rest) =
190 collectFunctionalityDefinitions rest
191 collectFunctionalityDefinitions [] =
192 []
193
194 --
195 -- Give blocks that don't have a description, the description of the previous
196 -- block that did have a description. Note that when we encounter a new
197 -- section, we do not remember the previous description, as it will surely
198 -- be irrelevant now.
199 --
200
201 reDescribeBlocks blocks = reDescribeBlocks' blocks "" 2
202
203 reDescribeBlocks' [] desc n =
204 []
205 reDescribeBlocks' (block@(Test id fn literalText inp exp result):rest) desc n
206 | allWhitespace literalText = (Test id fn numberedDesc inp exp result):(reDescribeBlocks' rest desc (n+1))
207 | otherwise = (block):(reDescribeBlocks' rest literalText 2)
208 where numberedDesc = "(#" ++ (show n) ++ ") " ++ (stripLeading '\n' desc)
209 reDescribeBlocks' (block:rest) desc n =
210 block:(reDescribeBlocks' rest "" 2)
211
212 --
213 -- Parse a pragma.
214 --
215
216 possiblePragmas = [
217 (["Tests", "for"], \rest -> TestsFor $ parseFunctionality rest),
218 (["Functionality"], \rest -> parseFuncDefn rest),
219 (["encoding:"], \rest -> Encoding rest)
220 ]
221
222 parsePragma text =
223 parsePossiblePragmas text possiblePragmas
224
225 parsePossiblePragmas :: String -> [([String], String -> Directive)] -> Directive
226 parsePossiblePragmas text [] =
227 error $ "bad pragma: " ++ text
228 parsePossiblePragmas text ((words,f):ps) =
229 case consumeWords words text of
230 Just rest -> f rest
231 Nothing -> parsePossiblePragmas text ps
232
233
234 functionalities = [
235 parseHaskellFunctionality,
236 parseShellFunctionality,
237 parseNamedFunctionality
238 ]
239
240 parseFunctionality text = tryFunctionalities functionalities text
241
242 tryFunctionalities [] text =
243 error $ "bad functionality: " ++ text
244 tryFunctionalities (func:rest) text =
245 case func text of
246 Just x -> x
247 Nothing -> tryFunctionalities rest text
248
249 parseHaskellFunctionality text =
250 case consumeWords ["Haskell", "function"] text of
251 Just specifier ->
252 let
253 (moduleName, functionName) = parseSpecifier specifier
254 in
255 Just $ HaskellTest moduleName functionName
256 Nothing ->
257 Nothing
258
259 parseShellFunctionality text =
260 case consumeWords ["shell", "command"] text of
261 Just specifier ->
262 let
263 (command, _) = parseQuotedString specifier
264 in
265 Just $ ShellTest command
266 Nothing ->
267 Nothing
268
269 parseNamedFunctionality text =
270 case consumeWords ["functionality"] text of
271 Just specifier ->
272 let
273 (name, _) = parseQuotedString specifier
274 in
275 Just $ NamedFunctionality name
276 Nothing ->
277 Nothing
278
279 parseSpecifier specifier =
280 let
281 (m, f) = break (\y -> y == ':') specifier
282 in
283 (m, stripLeading ':' f)
284
285 parseFuncDefn text =
286 let
287 (name, rest) = parseQuotedString text
288 in
289 case consumeWords ["is", "implemented", "by"] rest of
290 Just funky ->
291 let
292 functionality = parseFunctionality funky
293 in
294 FunctionalityDefinition name functionality
295 Nothing ->
296 error $ "bad functionality definition: " ++ text
297
298
299 parseQuotedString ('"':rest) =
300 parseQuotedString' rest
301 parseQuotedString str =
302 error $ "bad quoted string: " ++ str
303
304 parseQuotedString' ('"':rest) =
305 ("", rest)
306 parseQuotedString' (char:rest) =
307 let
308 (next, remainder) = parseQuotedString' rest
309 in
310 (char:next, remainder)
311
312 consumeWords [] text =
313 Just $ stripLeadingWhitespace text
314 consumeWords (word:rest) text =
315 case stripPrefix word $ stripLeadingWhitespace text of
316 Just text' ->
317 consumeWords rest text'
318 Nothing ->
319 Nothing
+0
-71
impl/Test.Falderal/Test/Falderal/Partitioner.hs less more
0 module Test.Falderal.Partitioner (partitionTests, isHaskellFunctionality, isShellFunctionality) where
1
2 import Test.Falderal.Common
3
4 --
5 -- Test partitioning functionality.
6 --
7
8 --
9 -- Given a list of tests and a list of predicates on their functionality,
10 -- create separate lists of tests, one for each functionality. Also
11 -- uniquely identify each test by assigning it a unique integer ID.
12 --
13
14 partitionTests :: [Block -> Bool] -> [Block] -> [[Block]]
15 partitionTests preds tests =
16 let
17 tests' = singulate tests
18 testLists = partition preds tests'
19 numberedTests = numberTests testLists 1
20 in
21 numberedTests
22
23 --
24 -- Given a list of tests, each of which might have multiple functionalities
25 -- implementing it, return a (possibly longer) list of tests, each of which
26 -- is implemented by a single functionality.
27 --
28
29 singulate :: [Block] -> [Block]
30 singulate [] =
31 []
32 singulate ((Test id fns desc inp exp result):tests) =
33 let
34 newTests = map (\fn -> Test id [fn] desc inp exp result) fns
35 in
36 newTests ++ (singulate tests)
37 singulate (_:tests) =
38 singulate tests
39
40 partition :: [Block -> Bool] -> [Block] -> [[Block]]
41 partition [] tests =
42 []
43 partition (pred:preds) tests =
44 (filter (pred) tests:partition preds tests)
45
46 numberTests [] id =
47 []
48 numberTests (list:lists) id =
49 let
50 (list', id') = numberTestList list id
51 in
52 (list':numberTests lists id')
53
54 numberTestList [] id =
55 ([], id)
56 numberTestList ((Test _ fns desc inp exp result):tests) id =
57 let
58 (remainder, id') = numberTestList tests (id+1)
59 in
60 ((Test id fns desc inp exp result):remainder, id')
61
62 --
63 -- Useful predicates to use, above.
64 --
65
66 isHaskellFunctionality (Test _ [(HaskellTest _ _)] _ _ _ _) = True
67 isHaskellFunctionality _ = False
68
69 isShellFunctionality (Test _ [(ShellTest _)] _ _ _ _) = True
70 isShellFunctionality _ = False
+0
-49
impl/Test.Falderal/Test/Falderal/Reporter/Standard.hs less more
0 module Test.Falderal.Reporter.Standard (report) where
1
2 --
3 -- Test.Falderal.Reporter.Standard -- Std. report for Falderal test results
4 --
5
6 import Test.Falderal.Common
7
8 report blocks failures = let
9 numTests = length (filter (isTest) blocks)
10 in do
11 reportEachFailingTest failures
12 putStrLn "--------------------------------"
13 putStrLn ("Total tests: " ++ (show numTests) ++ ", failures: " ++ (show (length failures)))
14 putStrLn "--------------------------------\n"
15
16 reportEachFailingTest [] = do
17 return ()
18 reportEachFailingTest (Test id fns literalText testText expected (Just actual):rest) = do
19 reportText 8 "FAILED" (stripLeading '\n' (stripTrailing '\n' literalText))
20 putStrLn ""
21 reportText 8 "Impl" (show fn)
22 reportText 8 "Input" testText
23 reportText 8 "Expected" (show expected)
24 reportText 8 "Actual" (show actual)
25 putStrLn ""
26 reportEachFailingTest rest
27 where [fn] = fns
28 reportEachFailingTest (Test id fns literalText testText expected Nothing:rest) = do
29 reportText 8 "NOT RUN" (stripLeading '\n' (stripTrailing '\n' literalText))
30 putStrLn ""
31 reportText 8 "Impl" (show fn)
32 reportText 8 "Input" testText
33 reportText 8 "Expected" (show expected)
34 putStrLn ""
35 reportEachFailingTest rest
36 where [fn] = fns
37
38 reportText width fieldName text =
39 if
40 elem '\n' text
41 then do
42 putStrLn (fieldName ++ ":")
43 putStrLn text
44 else do
45 putStrLn ((pad fieldName width) ++ ": " ++ text)
46
47 isTest (Test _ _ _ _ _ _) = True
48 isTest _ = False
+0
-20
impl/Test.Falderal/Test/Falderal/Reporter.hs less more
0 module Test.Falderal.Reporter (report) where
1
2 --
3 -- Dispatch module for Falderal results reporting.
4 --
5
6 import Test.Falderal.Common
7
8 import qualified Test.Falderal.Reporter.Standard as Standard
9
10 --
11 -- Map from names of reporting styles to reporting functions.
12 --
13
14 getReporter "standard" = Standard.report
15
16 report :: String -> [Block] -> [Block] -> IO ()
17
18 report format blocks failures =
19 (getReporter format) blocks failures
+0
-71
impl/Test.Falderal/Test/Falderal/Runner/Shell.hs less more
0 module Test.Falderal.Runner.Shell (run) where
1
2 --
3 -- Test.Falderal.Run.Shell -- Run shell tests directly from falderal
4 --
5
6 import System.Cmd
7 import System.Exit
8 import System.IO
9
10 import Test.Falderal.Common
11
12 import Test.Falderal.Formatter.Shell (expandCommand)
13
14
15 cleanRun True cmd = do
16 system cmd
17 return ()
18 cleanRun False cmd = do
19 return ()
20
21
22 run :: [Block] -> String -> Bool -> IO ()
23
24 run blocks resultsFilename messy = do
25 r <- openFile resultsFilename WriteMode
26 hClose r
27 runBlocks blocks resultsFilename messy
28 cleanRun (not messy) "rm -f input.txt output.txt"
29
30 runBlocks :: [Block] -> String -> Bool -> IO ()
31
32 runBlocks [] _ _ = do
33 return ()
34 runBlocks (block:blocks) resultsFilename messy = do
35 result <- runBlock block resultsFilename messy
36 runBlocks blocks resultsFilename messy
37
38 runBlock :: Block -> String -> Bool -> IO ()
39
40 runBlock test@(Test id [(ShellTest cmd)] desc body _ _) resultsFilename messy = do
41 writeOutFile "input.txt" body
42 execute (expandCommand cmd body) resultsFilename id
43
44 writeOutFile filename contents = do
45 outputFileHandle <- openFile filename WriteMode
46 hSetNewlineMode outputFileHandle noNewlineTranslation
47 newlinify outputFileHandle contents
48 hClose outputFileHandle
49
50 execute cmd resultsFilename id = do
51 exitCode <- system (cmd ++ " 2>&1")
52 r <- openFile resultsFilename AppendMode
53 writeExitCode r exitCode
54 hSetNewlineMode r noNewlineTranslation
55 hPutStrLn r (show id)
56 text <- readFile "output.txt"
57 hPutStrLn r $ show $ length $ lines text
58 newlinify r text
59 hClose r
60 return ()
61
62 writeExitCode handle ExitSuccess = do
63 hPutStrLn handle "output"
64 writeExitCode handle (ExitFailure _) = do
65 hPutStrLn handle "exception"
66
67 newlinify handle text = do
68 case last text of
69 '\n' -> hPutStr handle text
70 _ -> hPutStrLn handle text
+0
-85
impl/Test.Falderal/Test/Falderal/Runner.hs less more
0 module Test.Falderal.Runner (runTests) where
1
2 import System.Cmd
3 import System.IO
4
5 import Test.Falderal.Common
6 import Test.Falderal.Formatter (format) -- boo?
7
8 import qualified Test.Falderal.Runner.Shell as Shell
9
10 --
11 -- Test-running engine. This has just completely changed
12 -- from what it used to be!
13 --
14
15 cleanRun True cmd = do
16 system cmd
17 return ()
18 cleanRun False cmd = do
19 return ()
20
21 runTests :: [Block] -> String -> String -> String -> Bool -> IO [Block]
22
23 --
24 -- Special case for shell tests
25 --
26
27 runTests blocks filename "shell" command messy = do
28 (resultsFilename, handle) <- openTempFile "." "results.txt"
29 hClose handle
30 hSetNewlineMode handle noNewlineTranslation
31 Shell.run blocks resultsFilename messy
32 processResultsFile blocks filename resultsFilename messy
33
34 -- TODO: what to do with exitCode?
35
36 runTests [] _ _ _ _ = do
37 return []
38 runTests blocks filename formatName command messy = do
39 outputFileHandle <- openFile filename WriteMode
40 hSetNewlineMode outputFileHandle noNewlineTranslation
41 text <- return $ format formatName [] blocks
42 hPutStr outputFileHandle text
43 hClose outputFileHandle
44 (resultsFilename, h) <- openTempFile "." "results.txt"
45 hClose h
46 exitCode <- system (command ++ " >" ++ resultsFilename)
47 processResultsFile blocks filename resultsFilename messy
48
49 processResultsFile blocks filename resultsFilename messy = do
50 contents <- readFile resultsFilename
51 let results = collectResults $ lines $ contents
52 cleanRun (not messy) ("rm -f " ++ filename)
53 cleanRun (not messy) ("rm -f " ++ resultsFilename)
54 return $ decorateTestsWithResults blocks results
55
56 collectResults [] =
57 []
58 collectResults (kindStr:idStr:numLinesStr:rest) =
59 let
60 id = parseNatNumStr idStr 0
61 numLines = parseNatNumStr numLinesStr 0
62 failLines = take numLines rest
63 rest' = drop numLines rest
64 resText = (join "\n" failLines)
65 res = case kindStr of
66 "output" -> Output resText
67 "exception" -> Exception resText
68 in
69 ((Result id res):collectResults rest')
70 collectResults (idStr:rest) =
71 let
72 id = parseNatNumStr idStr 0
73 in
74 ((Result id (Output "")):collectResults rest)
75
76 decorateTestsWithResults [] results = []
77 decorateTestsWithResults (t@(Test testId fns literalText testText expected _):tests) results =
78 case filter (\(Result resultId _) -> resultId == testId) results of
79 [(Result _ result)] ->
80 (Test testId fns literalText testText expected (Just result)):decorateTestsWithResults tests results
81 _ ->
82 (t:decorateTestsWithResults tests results)
83 decorateTestsWithResults (test:tests) results =
84 (test:decorateTestsWithResults tests results)
+0
-4
impl/Test.Falderal/build.sh less more
0 #!/bin/sh
1
2 mkdir -p bin
3 ghc falderal.hs -o bin/falderal
+0
-62
impl/Test.Falderal/doc/Quick_Start.markdown less more
0 Quick Start
1 ===========
2
3 First, install `Test.Falderal`.
4
5 % hg clone https://bitbucket.org/catseye/falderal/ -r rel_0_4
6 % cd falderal
7 % cabal install --prefix=$HOME --user
8
9 Define a programming language, or some other file format -- basically,
10 anything you can model as a function which takes strings to strings. In
11 Falderal terminology, this is a "functionality". Implement your
12 functionality in any programming language for which you can produce
13 executables for your system. (If you implement it in Haskell, you get
14 some side benefits, but it's not necessary.)
15
16 Often, depending on the syntax of your implementation language, you can
17 place your literate tests in the same file as your code. We'll use
18 Bird-style literate Haskell in this example.
19
20 module Gobvert
21
22 This is some kind of really trivial little language.
23
24 > gobvert "A" = "Z"
25 > gobvert "Z" = "A"
26
27 Then give your functionality a name, and write some tests for your
28 functionality. You use a Falderal pragma to identify which functionality
29 these tests are for.
30
31 -> Functionality "Gobvert a string" is implemented by
32 -> Haskell function Gobvert:gobvert
33
34 -> Tests for functionality "Gobvert a string"
35
36 The gobversion of A is Z.
37
38 | A
39 = Z
40
41 The gobversion of Z is A.
42
43 | Z
44 = A
45
46 The gobversions of other letters are not defined.
47
48 | Q
49 ? Not matched
50
51 Then, use the `falderal` tool to run these tests:
52
53 % falderal test Gobvert.lhs
54
55 All failures will be listed in a nicely-formatted report, including the
56 literate description that appears before each failing test.
57
58 You can also use the `falderal` tool to format your literate Haskell
59 file, including embedded tests, to a document format such as Markdown:
60
61 % falderal format markdown Gobvert.lhs >Gobvert.markdown
+0
-44
impl/Test.Falderal/doc/Theory_of_Operation.markdown less more
0 Theory of Operation
1 ===================
2
3 The `falderal` tool from the `Test.Falderal` implementation of the
4 Falderal Literate Test Format allows the user to format Falderal tests
5 to different formats, and to run those tests and generate a report.
6
7 This document briefly describes how it works internally.
8
9 When `falderal` is asked to run a set of tests, first it formats them
10 to a set of programs which run the functionalities being tested with the
11 input text of the tests. These programs are called *results generators*.
12 Since each test may have one or more implementations, multiple results
13 generators may be generated, one for each implementation language
14 (currently Haskell and Bourne shell).
15
16 Each results generator runs many functions in a batch, for efficiency.
17 The results of running the functions are written to standard output
18 (which is redirected to a temporary file by `falderal`) in an intermediate
19 format. `falderal` then reads these temporary files, parses the
20 intermediate format, checks which of the test results do not match the
21 expected output, and generates a test report based on that.
22
23 The intermediate format is a simple text-based format containing groups of
24 lines. A single group may look like the following.
25
26 output
27 4
28 2
29 Test with ID 4 generated
30 two lines of output.
31
32 The first line is either `output` or `exception`. The next line contains
33 the ID of the test that generated this result. The line following that
34 contains the number of lines of text that the test generated (call it _n_).
35 The next _n_ lines contain the actual text generated. (If _n_ = 0, there
36 will be no such lines.) Immediately following this group will be either
37 another group, or the end-of-file.
38
39 The second and third lines in a group contain natural numbers; they may
40 contain arbitrary text after the final digit of the natural number, which is
41 ignored. (This is to simplify their generation from shell scripts, where
42 `wc -l` is used to produce the number of lines of output text, and where
43 `wc` also outputs the filename.)
+0
-27
impl/Test.Falderal/eg/Erroneous.falderal less more
0 -> encoding: UTF-8
1
2 -> Functionality "Count lines" is implemented by
3 -> Haskell function Erroneous:countLines
4
5 -> Tests for functionality "Count lines"
6
7 | These are eight words
8 | that span two lines.
9 = 2
10
11 | These are eight words
12 | that span
13 | three lines.
14 = 3
15
16 -> Functionality "Raise exception" is implemented by shell command
17 -> "./exception.sh"
18
19 -> Tests for functionality "Raise exception"
20
21 When a shell script returns a non-zero exit code, that should be interpreted
22 as an exception by Falderal, which can be matched with an expected exception
23 block.
24
25 | whatever
26 ? gello
+0
-7
impl/Test.Falderal/eg/Erroneous.hs less more
0 module Erroneous where
1
2 -- This Haskell module contains some errors which will cause the results
3 -- generator generated for it to not even compile. Test.Falderal should
4 -- handle this in some way where it's obvious something went wrong.
5
6 countLines str = show $ length $ likes str
+0
-159
impl/Test.Falderal/eg/LiterateHaskellDemo.lhs less more
0 > module LiterateHaskellDemo where
1
2 Falderal in Literate Haskell
3 ============================
4
5 This file demonstrates how Falderal tests can be embedded in a
6 Bird-style Literate Haskell source file.
7
8 This module was written by Chris Pressey. It is hereby placed in
9 the public domain.
10
11 The Function to be Tested
12 -------------------------
13
14 A function taking Strings to Strings.
15
16 > everySecond :: String -> String
17 > everySecond [] = []
18 > everySecond [a] = []
19 > everySecond "silly" = head []
20 > everySecond "silliness" = error "silliness"
21 > everySecond "supercilious" = error "not\non\nmy\nwatch"
22 > everySecond "suoilic\nrepus" = "not\non\nmy\nwatch"
23 > everySecond (a : b : rest) = (b : everySecond rest)
24
25 A function taking Strings to Lists of Booleans. We test this by
26 composing it with show.
27
28 > parseBits :: String -> [Bool]
29 > parseBits [] = []
30 > parseBits ('0':rest) = (False:parseBits rest)
31 > parseBits ('1':rest) = (True:parseBits rest)
32 > parseBits ('\n':rest) = parseBits rest
33
34 > showParseBits = show . parseBits
35
36 Pragmas are able to extend over multiple lines, just like anything else.
37 In addition, spaces between words (outside of quotes strings) are not
38 significant; you can have as many as you like.
39
40 -> Functionality "Retain every second character"
41 -> is implemented
42 -> by Haskell function LiterateHaskellDemo:everySecond
43
44 Tests for everySecond
45 ---------------------
46
47 -> Tests for functionality "Retain every second character"
48
49 Every second symbol in the string is retained.
50
51 | Falderal
52 = adrl
53
54 Works for odd-length strings, too.
55
56 | Bandana
57 = adn
58
59 If there aren't even two symbols in the string, the result is
60 the empty string. Note that we have to precede the expected
61 empty string with "= ", that is, an equals sign and a space.
62
63 | A
64 =
65
66 This is an intentionally failing test, to demonstrate how Falderal will
67 present it.
68
69 | Something
70 = Anything
71
72 A test that expects an exception.
73
74 | silly
75 ? Prelude.head: empty list
76
77 Another test that expects an exception.
78
79 | silliness
80 ? silliness
81
82 The expected text of an exception can extend over several lines.
83
84 | supercilious
85 ? not
86 ? on
87 ? my
88 ? watch
89
90 The input and expected text and extend over several lines, too.
91
92 | suoilic
93 | repus
94 = not
95 = on
96 = my
97 = watch
98
99 Another intentionally failing test to demonstrate how Falderal will
100 present expecting an exception and not getting one.
101
102 | ridiculous
103 ? Prelude.head: empty list
104
105 Tests for parseBits
106 -------------------
107
108 -> Tests for Haskell function LiterateHaskellDemo:showParseBits
109
110 We can test functions of type
111
112 f :: (Show a) => String -> a
113
114 by simply composing them with show, i.e.
115
116 show . f :: String -> String
117
118 | 01
119 = [False,True]
120
121 An intentionally failing test to demonstrate that it is important
122 to get the formatting of the output right, when testing with show.
123
124 | 01
125 = [False, True]
126
127 |
128 = []
129
130 Input can consist of multiple lines of text. These are joined together
131 with intervening newline characters.
132
133 | 00
134 | 11
135 = [False,False,True,True]
136
137 An intentionally failing test to demonstrate show what a failure
138 looks like on multi-line input.
139
140 | 01
141 | 10
142 = [False,False,True,True]
143
144 If we have a set of tests where the tests after the first one have no
145 descriptions of their own, we can take this to suggest they are all
146 testing the same thing. In this case, the literal text that is displayed
147 when any of them fails is the text that comes before the first of them,
148 annotated with the number of the test in the set that failed. The
149 intentionally-failing third test below demonstrates this.
150
151 | 00
152 = [False,False]
153
154 | 000
155 = [False,False,False]
156
157 | 0000
158 = [False,False,False,Flse]
+0
-15
impl/Test.Falderal/eg/NoTestsSpecified.falderal less more
0 -> encoding: UTF-8
1
2 This is a Falderal file with some tests in it, but no indication of what
3 those tests are for. The `falderal` tool should complain. Also, if some
4 other Falderal file is loaded before this one, the Tests-for from it should
5 not bleed into this file.
6
7 | These are eight words
8 | that span two lines.
9 = 2
10
11 | These are eight words
12 | that span
13 | three lines.
14 = 3
+0
-25
impl/Test.Falderal/eg/Underspecified.falderal less more
0 -> encoding: UTF-8
1
2 Tests for wc
3 ============
4
5 This Falderal document was written by Chris Pressey. It is hereby placed in
6 the public domain.
7
8 This test suite demonstrates how Falderal can specify tests for
9 named functionalities without definition how those functionalities
10 are implemented. The Falderal implementation must supply a definition
11 of how the the functionality is implemented.
12
13 How it chooses that definition is completely up to the implementation.
14 In the case of the `falderal` tool from `Test.Falderal`, it may be
15 specified on the command line like so:
16
17 --functionality 'Count lines:shell command "wc -l"'
18
19 -> Tests for functionality "Count lines"
20
21 | These are eight words
22 | that span
23 | three lines.
24 = 3
+0
-3
impl/Test.Falderal/eg/WordCount.hs less more
0 module WordCount where
1
2 countLines str = show $ length $ lines str
+0
-37
impl/Test.Falderal/eg/echo.falderal less more
0 -> encoding: UTF-8
1
2 Tests for echo
3 ==============
4
5 This Falderal document was written by Chris Pressey. It is hereby placed in
6 the public domain.
7
8 This test suite is part of the Falderal internal tests. It tests two
9 things: expansion of the `%(test-text)` variable, and correctly handling
10 the case where the program being tested does not end its output with
11 a new line.
12
13 -> Functionality "Echo" is implemented by
14 -> shell command "echo -n '%(test-text)'"
15
16 -> Functionality "Echo" is implemented by
17 -> shell command "echo '%(test-text)'"
18
19 -> Tests for functionality "Echo"
20
21 Echo a single line.
22
23 | This is a test.
24 = This is a test.
25
26 Echo multiple lines.
27
28 | This is
29 | a test.
30 = This is
31 = a test.
32
33 Echo with an embedded single quote.
34
35 | This isn't a test.
36 = This isn't a test.
+0
-8
impl/Test.Falderal/eg/exception.sh less more
0 #!/bin/sh
1
2 # This Bourne shell script should fail when run, unless you have some really
3 # weirdly-named executables on your $PATH. Test.Falderal should interpret
4 # this failure as an exception.
5
6 echo 1>&2 gello
7 exit 1
+0
-53
impl/Test.Falderal/eg/wc.falderal less more
0 -> encoding: UTF-8
1
2 Tests for wc
3 ============
4
5 This Falderal document was written by Chris Pressey. It is hereby placed in
6 the public domain.
7
8 This test suite demonstrates how Falderal can specify tests for
9 functionalities which have multiple implementations.
10
11 -> Functionality "Count lines" is implemented by
12 -> shell command "wc -l"
13
14 -> Functionality "Count lines" is implemented by
15 -> shell command "wc -l >%(output-file)"
16
17 -> Functionality "Count lines" is implemented by
18 -> Haskell function WordCount:countLines
19
20 -> Tests for functionality "Count lines"
21
22 Lines are counted correctly.
23
24 | These are eight words
25 | that span
26 | three lines.
27 = 3
28
29 -> Tests for shell command "wc -l %(test-file)"
30
31 | These are eight words
32 | that span
33 | three lines.
34 = 3 input.txt
35
36 -> Functionality "Count words" is implemented by
37 -> shell command "wc -w"
38
39 -> Tests for functionality "Count words"
40
41 | These are eight words
42 | that span
43 | three lines.
44 = 8
45
46 | Here are eight words on a single line.
47 = 8
48
49 An intentionally failing test.
50
51 | Not four words!
52 = 4
+0
-207
impl/Test.Falderal/falderal.hs less more
0 import Data.List (isInfixOf)
1
2 import System.Environment
3 import System.Exit
4 import System.Console.GetOpt
5
6 import Test.Falderal.Common
7 import Test.Falderal.Loader (
8 loadFile,
9 parseFunctionality,
10 collectFunctionalityDefinitions,
11 stripFunctionalities,
12 assignFunctionalities
13 )
14 import Test.Falderal.Partitioner (
15 partitionTests,
16 isHaskellFunctionality,
17 isShellFunctionality
18 )
19 import Test.Falderal.Formatter (format)
20 import Test.Falderal.Runner (runTests)
21 import Test.Falderal.Reporter (report)
22
23 --
24 -- Main module for the `falderal` tool -- a command-line interface to
25 -- `Test.Falderal`.
26 --
27
28 --
29 -- Command-line options
30 --
31
32 data Flag = ReportFormat String
33 | HaskellRunCommand String
34 | ShellRunCommand String
35 | Verbosity String
36 | Functionality String
37 | ClearFunctionality String
38 | SkipFunctionality String
39 | SubstringException
40 | Messy
41 deriving (Show, Ord, Eq)
42
43 determineReportFormat [] = "standard"
44 determineReportFormat (ReportFormat fmt:_) = fmt
45 determineReportFormat (_:rest) = determineReportFormat rest
46
47 determineVerbosity [] = 0
48 determineVerbosity (Verbosity v:_) = (read v) :: Int
49 determineVerbosity (_:rest) = determineVerbosity rest
50
51 determineHaskellRunCommand [] = "runhaskell"
52 determineHaskellRunCommand (HaskellRunCommand s:_) = s
53 determineHaskellRunCommand (_:rest) = determineHaskellRunCommand rest
54
55 determineShellRunCommand [] = "sh"
56 determineShellRunCommand (ShellRunCommand s:_) = s
57 determineShellRunCommand (_:rest) = determineShellRunCommand rest
58
59 determineFunctionalityDefinitions [] = []
60 determineFunctionalityDefinitions (Functionality spec:rest) =
61 (parseFunctionalitySpec spec:determineFunctionalityDefinitions rest)
62 determineFunctionalityDefinitions (_:rest) =
63 determineFunctionalityDefinitions rest
64
65 parseFunctionalitySpec str =
66 let
67 name = takeWhile (\c -> c /= ':') str
68 rest = tail (dropWhile (\c -> c /= ':') str)
69 in
70 (name, parseFunctionality rest)
71
72 determineFunctionalitiesToClear [] = []
73 determineFunctionalitiesToClear (ClearFunctionality name:rest) =
74 (name:determineFunctionalitiesToClear rest)
75 determineFunctionalitiesToClear (_:rest) =
76 determineFunctionalitiesToClear rest
77
78 determineFunctionalitiesToSkip [] = []
79 determineFunctionalitiesToSkip (SkipFunctionality name:rest) =
80 ((NamedFunctionality name):determineFunctionalitiesToSkip rest)
81 determineFunctionalitiesToSkip (_:rest) =
82 determineFunctionalitiesToSkip rest
83
84 --
85 -- Command-line entry point
86 --
87
88 main :: IO ()
89 main = do
90 args <- getArgs
91 case getOpt Permute options args of
92 (flags, newArgs, []) -> dispatch newArgs flags
93 (_, _, msgs) -> error $ concat msgs ++ usageInfo header options
94
95 header = "Usage: falderal <command> [<option>...] <filename.falderal>...\n\
96 \where <command> is one of:\n\
97 \ format <format-name>\n\
98 \ test\n\
99 \ version"
100
101 options :: [OptDescr Flag]
102 options = [
103 Option ['b'] ["substring-exception"] (NoArg SubstringException) "match expected exceptions as substrings (default: no)",
104 Option ['c'] ["clear-functionality"] (ReqArg ClearFunctionality "NAME") "clear all implementations of a named functionality",
105 Option ['f'] ["functionality"] (ReqArg Functionality "SPEC") "specify additional implementation of a named functionality",
106 Option ['h'] ["haskell-command"] (ReqArg HaskellRunCommand "CMD") "command to run Haskell tests (default: 'runhaskell')",
107 Option ['k'] ["skip-functionality"] (ReqArg SkipFunctionality "NAME") "skip all tests for this named functionality",
108 Option ['m'] ["messy"] (NoArg Messy) "messy: do not delete generated files (default: clean)",
109 Option ['r'] ["report-format"] (ReqArg ReportFormat "FORMAT") "success/failure report format (default: standard)",
110 Option ['s'] ["shell-command"] (ReqArg ShellRunCommand "CMD") "command to run shell scripts (default: 'sh')",
111 Option ['v'] ["verbosity"] (ReqArg Verbosity "LEVEL") "verbosity level, higher is more verbose (default: 0)"
112 ]
113
114 dispatch ("format":formatName:fileNames) _ = do
115 (lines, blocks) <- loadFiles fileNames
116 putStr $ format formatName lines blocks
117
118 dispatch ("test":fileNames) flags =
119 let
120 reportFormat = determineReportFormat flags
121 in do
122 results <- testFiles fileNames flags
123 let failures = determineFailures results (SubstringException `elem` flags)
124 report reportFormat results failures
125 exitWith ExitSuccess
126
127 dispatch ("newlinify":fileName:_) flags = do
128 text <- readFile fileName
129 case last text of
130 '\n' -> putStr text
131 _ -> putStrLn text
132 exitWith ExitSuccess
133
134 dispatch ("version":_) _ = do
135 putStrLn "Test.Falderal version 0.7"
136
137 dispatch _ _ = putStrLn header
138
139 --
140 -- Loading a set of files
141 -- NOTE: this runs each file into the last -- so only use it for formatting.
142 --
143
144 loadFiles [] = do
145 return ([], [])
146 loadFiles (fileName:rest) = do
147 (ls, bs) <- loadFile fileName
148 (restLs, restBs) <- loadFiles rest
149 return (ls ++ restLs, bs ++ restBs)
150
151 --
152 -- Orchestrating the tests
153 --
154
155 testFiles [] flags = return []
156 testFiles (fileName:rest) flags =
157 let
158 verbosity = determineVerbosity flags
159 funcDefs = determineFunctionalityDefinitions flags
160 funcsToClear = determineFunctionalitiesToClear flags
161 funcsToSkip = determineFunctionalitiesToSkip flags
162 preds = [isHaskellFunctionality, isShellFunctionality]
163 in do
164 (lines, blocks) <- loadFile fileName
165 fds <- return $ collectFunctionalityDefinitions lines
166 fds' <- return $ clearFuncs fds funcsToClear
167 blocks' <- return $ stripFunctionalities blocks funcsToSkip False
168 blocks'' <- return $ assignFunctionalities blocks' [] (fds' ++ funcDefs)
169 [haskellBlocks, shellBlocks] <- return $ partitionTests preds blocks''
170 haskellBlocks' <- testHaskell haskellBlocks flags
171 shellBlocks' <- testShell shellBlocks flags
172 further <- testFiles rest flags
173 return (haskellBlocks' ++ shellBlocks' ++ further)
174
175 --
176 -- Transforming tests before running them
177 --
178
179 clearFuncs [] names = []
180 clearFuncs (def@(name,fn):rest) names
181 | name `elem` names = clearFuncs rest names
182 | otherwise = (def:clearFuncs rest names)
183
184 --
185 -- Running the tests
186 --
187
188 testHaskell blocks flags =
189 runTests blocks "GeneratedFalderalTests.hs" "haskell" ((determineHaskellRunCommand flags) ++ " GeneratedFalderalTests.hs") (Messy `elem` flags)
190
191 testShell blocks flags =
192 runTests blocks "GeneratedFalderalTests.sh" "shell" ((determineShellRunCommand flags) ++ " GeneratedFalderalTests.sh") (Messy `elem` flags)
193
194 --
195 -- Determining the failures
196 --
197
198 determineFailures blocks substrExc =
199 filter (isFailingTest substrExc) blocks
200
201 isFailingTest True (Test _ _ _ _ (Exception x) (Just (Exception y))) =
202 if x `isInfixOf` y then False else True
203 isFailingTest _ (Test _ _ _ _ x (Just y)) =
204 if x == y then False else True
205 isFailingTest _ _ =
206 True
+0
-9
impl/Test.Falderal/install-cygwin.sh less more
0 #!/bin/sh
1
2 if [ "x$1" = "xclean" ]; then
3 cabal clean
4 fi
5
6 cabal install --prefix=C:\\cygwin\\home\\$USER\\ --user && cabal clean
7 mv $HOME/bin/falderal.exe $HOME/bin/falderal
8
+0
-7
impl/Test.Falderal/install.sh less more
0 #!/bin/sh
1
2 if [ "x$1" = "xclean" ]; then
3 cabal clean
4 fi
5
6 cabal install --prefix=$HOME --user && cabal clean
+0
-243
impl/Test.Falderal/test.sh less more
0 #!/bin/sh
1
2 # A tiny test harness for Falderal itself.
3 # You'll want to make sure the version you're testing is actually
4 # installed via Cabal first:
5 # $ cabal clean && cabal install --prefix=$HOME --user
6
7 FALDERAL=`pwd`/bin/falderal
8
9 echo 'Testing formatting...'
10
11 # Formatting test broken now that Falderal accepts indented blocks.
12 # I don't care enough to fix this; this tool should not be in the formatting
13 # business anymore, and py-falderal is taking over anyway.
14
15 #$FALDERAL format identity eg/LiterateHaskellDemo.lhs >formatted.txt
16 #diff -u eg/LiterateHaskellDemo.lhs formatted.txt
17 #EID=$?
18 #rm -f formatted.txt
19 EID=0
20
21 echo 'Testing LiterateHaskellDemo...'
22
23 cat >expected.txt <<EOF
24 FAILED:
25 This is an intentionally failing test, to demonstrate how Falderal will
26 present it.
27
28 Impl : Haskell function LiterateHaskellDemo:everySecond
29 Input : Something
30 Expected: Output "Anything"
31 Actual : Output "oehn"
32
33 FAILED:
34 Another intentionally failing test to demonstrate how Falderal will
35 present expecting an exception and not getting one.
36
37 Impl : Haskell function LiterateHaskellDemo:everySecond
38 Input : ridiculous
39 Expected: Exception "Prelude.head: empty list"
40 Actual : Output "iiuos"
41
42 FAILED:
43 An intentionally failing test to demonstrate that it is important
44 to get the formatting of the output right, when testing with show.
45
46 Impl : Haskell function LiterateHaskellDemo:showParseBits
47 Input : 01
48 Expected: Output "[False, True]"
49 Actual : Output "[False,True]"
50
51 FAILED:
52 An intentionally failing test to demonstrate show what a failure
53 looks like on multi-line input.
54
55 Impl : Haskell function LiterateHaskellDemo:showParseBits
56 Input:
57 01
58 10
59 Expected: Output "[False,False,True,True]"
60 Actual : Output "[False,True,True,False]"
61
62 FAILED:
63 (#3) If we have a set of tests where the tests after the first one have no
64 descriptions of their own, we can take this to suggest they are all
65 testing the same thing. In this case, the literal text that is displayed
66 when any of them fails is the text that comes before the first of them,
67 annotated with the number of the test in the set that failed. The
68 intentionally-failing third test below demonstrates this.
69
70 Impl : Haskell function LiterateHaskellDemo:showParseBits
71 Input : 0000
72 Expected: Output "[False,False,False,Flse]"
73 Actual : Output "[False,False,False,False]"
74
75 --------------------------------
76 Total tests: 17, failures: 5
77 --------------------------------
78
79 EOF
80 cd eg
81 $FALDERAL test LiterateHaskellDemo.lhs >../actual.txt
82 cd ..
83 diff -u expected.txt actual.txt
84 ELHS=$?
85 rm -f expected.txt actual.txt
86
87 echo 'Testing wc.falderal (multiple impls, var exp)...'
88
89 cat >expected.txt <<EOF
90 FAILED : An intentionally failing test.
91
92 Impl : Shell command "wc -w"
93 Input : Not four words!
94 Expected: Output "4"
95 Actual : Output "3"
96
97 --------------------------------
98 Total tests: 7, failures: 1
99 --------------------------------
100
101 EOF
102 cd eg
103 $FALDERAL test wc.falderal >../actual.txt
104 cd ..
105 diff -u expected.txt actual.txt
106 EWC=$?
107 rm -f expected.txt actual.txt
108
109 echo 'Testing echo.falderal (test-text var, missing newline)...'
110
111 cat >expected.txt <<EOF
112 --------------------------------
113 Total tests: 6, failures: 0
114 --------------------------------
115
116 EOF
117 $FALDERAL test eg/echo.falderal >actual.txt
118 diff -u expected.txt actual.txt
119 EECHO=$?
120 rm -f expected.txt actual.txt
121
122 echo 'Testing Erroneous.falderal...'
123
124 cat >expected.txt <<EOF
125 NOT RUN : (#2)
126
127 Impl : Haskell function Erroneous:countLines
128 Input:
129 These are eight words
130 that span two lines.
131 Expected: Output "2"
132
133 NOT RUN : (#3)
134
135 Impl : Haskell function Erroneous:countLines
136 Input:
137 These are eight words
138 that span
139 three lines.
140 Expected: Output "3"
141
142 --------------------------------
143 Total tests: 3, failures: 2
144 --------------------------------
145
146 EOF
147 cd eg
148 $FALDERAL test Erroneous.falderal >../actual.txt 2>/dev/null
149 cd ..
150 diff -u expected.txt actual.txt
151 EERR=$?
152 rm -f expected.txt actual.txt
153
154 echo 'Testing functionality definition on command line...'
155
156 cat >expected.txt <<EOF
157 falderal: Can't find functionality "Count lines" in []
158 EOF
159 cd eg
160 $FALDERAL test Underspecified.falderal >../actual.txt 2>&1
161 cd ..
162 diff -u expected.txt actual.txt
163 ECL1=$?
164 rm -f expected.txt actual.txt
165
166 cat >expected.txt <<EOF
167 --------------------------------
168 Total tests: 1, failures: 0
169 --------------------------------
170
171 EOF
172 cd eg
173 $FALDERAL test --functionality 'Count lines:shell command "wc -l"' Underspecified.falderal >../actual.txt 2>&1
174 cd ..
175 diff -u expected.txt actual.txt
176 ECL2=$?
177 rm -f expected.txt actual.txt
178
179 cat >expected.txt <<EOF
180 falderal: Can't find functionality "Echo" in []
181 EOF
182 $FALDERAL -c "Echo" test eg/echo.falderal >actual.txt 2>&1
183 diff -u expected.txt actual.txt
184 ECL3=$?
185 rm -f expected.txt actual.txt
186
187 cat >expected.txt <<EOF
188 --------------------------------
189 Total tests: 3, failures: 0
190 --------------------------------
191
192 EOF
193 $FALDERAL -c "Echo" -f "Echo:shell command \"echo '%(test-text)'\"" test eg/echo.falderal >actual.txt
194 diff -u expected.txt actual.txt
195 ECL4=$?
196 rm -f expected.txt actual.txt
197
198 echo 'Testing functionality skipping from the command line...'
199
200 cat >expected.txt <<EOF
201 --------------------------------
202 Total tests: 0, failures: 0
203 --------------------------------
204
205 EOF
206 $FALDERAL test -k "Echo" eg/echo.falderal >actual.txt
207 diff -u expected.txt actual.txt
208 EECHO=$?
209 rm -f expected.txt actual.txt
210
211 echo 'Testing that Tests-for pragma needs to be specified...'
212
213 cat >expected.txt <<EOF
214 falderal: Found a test before any Tests-for was specified
215 EOF
216 $FALDERAL test eg/NoTestsSpecified.falderal >actual.txt 2>&1
217 diff -u expected.txt actual.txt
218 ENOTEST=$?
219 rm -f expected.txt actual.txt
220
221 echo 'Testing that functionalities do not bleed into successive files...'
222
223 cat >expected.txt <<EOF
224 falderal: Can't find functionality "Count lines" in []
225 EOF
226 cd eg
227 $FALDERAL test wc.falderal Underspecified.falderal >../actual.txt 2>&1
228 cd ..
229 diff -u expected.txt actual.txt
230 ENOBLEED=$?
231 rm -f expected.txt actual.txt
232
233 if [ $EID != 0 -o $ELHS != 0 -o $EERR != 0 -o $ECL1 != 0 -o $ECL2 != 0 -o \
234 $ECL3 != 0 -o $ECL4 != 0 -o $EWC != 0 -o $EECHO != 0 -o \
235 $ENOTEST != 0 -o $ENOBLEED != 0 ]
236 then
237 echo "Internal tests failed!"
238 exit 1
239 else
240 echo "All tests passed."
241 exit 0
242 fi