Commit 34bf2ae8468773b8e7e0b88d68e6030cbb11ff93 - Falderal

Abandon the persistent results branch for now. --HG-- branch : persistent-results catseye 13 years ago

2 changed file(s) with 13 addition(s) and 46 deletion(s). Raw diff Collapse all Expand all

-16

Test/Falderal/Runner.hs less more

19	19	cleanRun False cmd = do
20	20	return ()
21	21
22		runTests :: [Block] -> String -> String -> String -> Bool -> Maybe String -> IO [Block]
	22	runTests :: [Block] -> String -> String -> String -> Bool -> IO [Block]
23	23
24	24	-- TODO: what to do with exitCode?
25	25
26		runTests [] _ _ _ _ _ = do
	26	runTests [] _ _ _ _ = do
27	27	return []
28		runTests blocks filename formatName command messy persistTo = do
	28	runTests blocks filename formatName command messy = do
29	29	outputFileHandle <- openFile filename WriteMode
30	30	text <- return $ format formatName [] blocks
31	31	hPutStr outputFileHandle text
32	32	hClose outputFileHandle
33		case persistTo of
34		Just resultsFilename -> do
35		exitCode <- system (command ++ " >>" ++ resultsFilename)
36		contents <- readFile resultsFilename
37		cleanRun (not messy) ("rm -f " ++ filename)
38		return []
39		Nothing -> do
40		exitCode <- system (command ++ " >results.txt")
41		contents <- readFile "results.txt"
42		results <- return $ collectResults $ lines $ contents
43		cleanRun (not messy) ("rm -f " ++ filename)
44		cleanRun (not messy) ("rm -f results.txt")
45		return $ decorateTestsWithResults blocks results
	33	exitCode <- system (command ++ " >results.txt")
	34	contents <- readFile "results.txt"
	35	results <- return $ collectResults $ lines $ contents
	36	cleanRun (not messy) ("rm -f " ++ filename)
	37	cleanRun (not messy) ("rm -f results.txt")
	38	return $ decorateTestsWithResults blocks results
46	39
47	40	collectResults [] =
48	41	[]

-30

falderal.hs less more

26	26	\| ShellRunCommand String
27	27	\| Verbosity String
28	28	\| Functionality String
29		\| Persist String
30	29	\| Messy
31	30	deriving (Show, Ord, Eq)
32	31

72	71	(flags, newArgs, []) -> dispatch newArgs flags
73	72	(_, _, msgs) -> error $ concat msgs ++ usageInfo header options
74	73
75		header = "Usage: falderal <command> [<option>...] <filename>...\n\
	74	header = "Usage: falderal <command> [<option>...] <filename.falderal>...\n\
76	75	\where <command> is one of:\n\
77		\ format\n\
	76	\ format <format-name>\n\
78	77	\ test\n\
79		\ report\n\
80	78	\ version"
81	79
82	80	options :: [OptDescr Flag]

84	82	Option ['h'] ["haskell-command"] (ReqArg HaskellRunCommand "CMD") "command to run Haskell tests (default: 'runhaskell')",
85	83	Option ['f'] ["functionality"] (ReqArg Functionality "SPEC") "specify implementation of a functionality under test",
86	84	Option ['m'] ["messy"] (NoArg Messy) "messy: do not delete generated files (default: clean)",
87		Option ['p'] ["persist"] (ReqArg Persist "FILE") "suppress report, and persist results to the given file",
88	85	Option ['r'] ["report-format"] (ReqArg ReportFormat "FORMAT") "success/failure report format (default: standard)",
89	86	Option ['s'] ["shell-command"] (ReqArg ShellRunCommand "CMD") "command to run shell scripts (default: 'sh')",
90	87	Option ['v'] ["verbosity"] (ReqArg Verbosity "LEVEL") "verbosity level, higher is more verbose (default: 0)"

108	105	report reportFormat (haskellBlocks' ++ shellBlocks')
109	106	exitWith ExitSuccess
110	107
111		dispatch ("report":fileNames) flags =
112		let
113		reportFormat = determineReportFormat flags
114		verbosity = determineVerbosity flags
115		[fileName] = fileNames
116		in do
117		-- resultBlocks <- loadResults fileName
118		-- report reportFormat resultBlocks
119		exitWith ExitSuccess
120
121	108	dispatch ("version":_) _ = do
122	109	putStrLn "Test.Falderal version 0.5"
123	110
124	111	dispatch _ _ = putStrLn header
125	112
126	113	testHaskell blocks flags =
127		testTests blocks flags "GeneratedFalderalTests.hs" "haskell" determineHaskellRunCommand
	114	runTests blocks "GeneratedFalderalTests.hs" "haskell" ((determineHaskellRunCommand flags) ++ " GeneratedFalderalTests.hs") (Messy `elem` flags)
128	115
129	116	testShell blocks flags =
130		testTests blocks flags "GeneratedFalderalTests.sh" "shell" determineShellRunCommand
131
132		testTests blocks flags resultsGenerator formatName cmdDeterminer =
133		let
134		cmd = cmdDeterminer flags
135		messy = Messy `elem` flags
136		isPersist (Persist _) = True
137		isPersist _ = False
138		persistTo =
139		case filter (isPersist) flags of
140		[] -> Nothing
141		[Persist fileName] -> Just fileName
142		in
143		runTests blocks resultsGenerator formatName (cmd ++ " " ++ resultsGenerator) messy persistTo
	117	runTests blocks "GeneratedFalderalTests.sh" "shell" ((determineShellRunCommand flags) ++ " GeneratedFalderalTests.sh") (Messy `elem` flags)