diff options
| author | hallgren <hallgren@chalmers.se> | 2013-12-03 17:13:39 +0000 |
|---|---|---|
| committer | hallgren <hallgren@chalmers.se> | 2013-12-03 17:13:39 +0000 |
| commit | f5cda1e6a385ec6fe847db1ab77b67535ae41e7d (patch) | |
| tree | eeb7bf975ec366645652064bb1a9cc92908d2c86 /testsuite | |
| parent | 6b3ba6d3ba5548d29e9175835e0ab1f1b17966c1 (diff) | |
testsuite: Use Cabal's new test suite interface
* The old way: a user hook in Setup.hs
* The new way: specify it in gf.cabal
* The test suite is now called gf-tests, and it runs testsuite/run.hs.
* You can run it manually with 'runhaskell testsuite/run.hs'. It also runs,
together with rgl-tests, when you do 'cabal test'
* Currently only 9 of 34 tests pass. Many failures have silly causes:
- Error messages that look slightly different
- Same output but in a different order
- Absolute paths in output
Diffstat (limited to 'testsuite')
| -rw-r--r-- | testsuite/run.hs | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/testsuite/run.hs b/testsuite/run.hs new file mode 100644 index 000000000..1f671eabf --- /dev/null +++ b/testsuite/run.hs @@ -0,0 +1,77 @@ +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) 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: 500px; 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 (res,(input,gold,output)) = + "<tr>"++concatMap (td.pre) [res,input,gold,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" + res <- runTest in_file out_file gold_file + putStrLn $ fst res++": "++in_file + return [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 |