1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
import Data.List(partition)
import System.IO
import Distribution.Simple.BuildPaths(exeExtension)
import System.Process(readProcess)
import System.Directory(doesFileExist,getDirectoryContents)
import System.FilePath((</>),(<.>),takeExtension)
import System.Exit(exitSuccess,exitFailure)
main =
do res <- walk "testsuite"
let cnt = length res
(good,bad) = partition ((=="OK").fst.snd) res
ok = length good
fail = ok<cnt
putStrLn $ show ok++"/"++show cnt++ " passed/tests"
let overview = "dist/test/gf-tests.html"
writeFile overview (toHTML bad)
if ok<cnt
then do putStrLn $ overview++" contains an overview of the failed tests"
exitFailure
else exitSuccess
where
toHTML res =
"<!DOCTYPE html>\n"
++ "<meta charset=\"UTF-8\">\n"
++ "<style>\n"
++ "pre { max-width: 600px; overflow: scroll; }\n"
++ "th,td { vertical-align: top; text-align: left; }\n"
++ "</style>\n"
++ "<table border=1>\n<tr><th>Result<th>Input<th>Gold<th>Output\n"
++ unlines (map testToHTML res)
++ "</table>\n"
testToHTML (in_file,(res,(input,gold,output))) =
"<tr>"++concatMap td [pre res,in_file++":\n"++pre input,pre gold,pre output]
pre s = "<pre>"++s++"</pre>"
td s = "<td>"++s
walk path = fmap concat . mapM (walkFile . (path </>)) =<< ls path
walkFile fpath = do
exists <- doesFileExist fpath
if exists
then if takeExtension fpath == ".gfs"
then do let in_file = fpath
gold_file = fpath <.> ".gold"
out_file = fpath <.> ".out"
putStr $ in_file++": "; hFlush stdout
res <- runTest in_file out_file gold_file
putStrLn $ fst res
return [(in_file,res)]
else return []
else walk fpath
runTest in_file out_file gold_file = do
input <- readFile in_file
writeFile out_file =<< run_gf input
exists <- doesFileExist gold_file
if exists
then do out <- compatReadFile out_file
gold <- compatReadFile gold_file
let info = (input,gold,out)
return $! if out == gold then ("OK",info) else ("FAIL",info)
else do out <- compatReadFile out_file
return ("MISSING GOLD",(input,"",out))
-- Avoid failures caused by Win32/Unix text file incompatibility
compatReadFile path =
do h <- openFile path ReadMode
hSetNewlineMode h universalNewlineMode
hGetContents h
-- Should consult the Cabal configuration!
run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path]
default_gf = "dist/build/gf/gf"<.>exeExtension
gf_lib_path = "dist/build/rgl"
-- | List files, excluding "." and ".."
ls path = filter (`notElem` [".",".."]) `fmap` getDirectoryContents path
|
