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\n" ++ "\n" ++ "\n

Result	Input	Gold	Output\n" ++ unlines (map testToHTML res) ++ "

\n" testToHTML (in_file,(res,(input,gold,output))) = ""++concatMap td [pre res,in_file++":\n"++pre input,pre gold,pre output] pre s = "

"++s++"

" td s = ""++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