Idris2-boot/tests/Main.idr

129 lines
4.5 KiB
Idris
Raw Normal View History

module Main
import System
%default covering
ttimpTests : List String
ttimpTests
= ["basic001", "basic002", "basic003", "basic004", "basic005",
"basic006",
"coverage001", "coverage002",
"dot001",
"eta001", "eta002",
"lazy001",
"nest001", "nest002",
"perf001", "perf002", "perf003",
"record001", "record002",
"rewrite001",
"qtt001", "qtt002", "qtt003",
"search001", "search002", "search003", "search004", "search005",
"total001", "total002", "total003",
2019-05-29 13:57:07 +03:00
"with001"]
idrisTests : List String
idrisTests
= ["basic001", "basic002", "basic003", "basic004", "basic005",
"basic006", "basic007", "basic008", "basic009", "basic010",
"basic011", "basic012", "basic013", "basic014", "basic015",
"basic016", "basic017", "basic018", "basic019", "basic020",
2019-07-12 10:32:36 +03:00
"basic021", "basic022", "basic023", "basic024", "basic025",
"coverage001", "coverage002", "coverage003", "coverage004",
2019-06-25 23:46:28 +03:00
"error001", "error002", "error003", "error004", "error005",
"error006", "error007", "error008", "error009",
"import001", "import002",
"interactive001", "interactive002", "interactive003", "interactive004",
"interactive005", "interactive006", "interactive007", "interactive008",
"interactive009", "interactive010", "interactive011", "interactive012",
"interface001", "interface002", "interface003", "interface004",
"interface005",
2019-06-24 20:08:32 +03:00
"lazy001",
2019-06-27 21:28:14 +03:00
"linear001", "linear002", "linear003", "linear004", "linear005",
2019-06-29 23:37:30 +03:00
"perror001", "perror002", "perror003", "perror004", "perror005",
"perror006",
"record001", "record002",
"total001", "total002", "total003", "total004", "total005",
"total006"]
typeddTests : List String
typeddTests
= ["chapter01", "chapter02", "chapter03", "chapter04", "chapter05",
2019-07-09 00:46:20 +03:00
"chapter06", "chapter07", "chapter08", "chapter09", "chapter10",
"chapter11", "chapter12"]
chezTests : List String
chezTests
= ["chez001", "chez002", "chez003", "chez004",
2019-06-30 00:43:06 +03:00
"chez005", "chez006", "chez007"]
ideModeTests : List String
ideModeTests
= [ "ideMode001" ]
chdir : String -> IO Bool
chdir dir
= do ok <- foreign FFI_C "chdir" (String -> IO Int) dir
pure (ok == 0)
fail : String -> IO ()
fail err
= do putStrLn err
exitWith (ExitFailure 1)
runTest : String -> String -> String -> IO Bool
runTest dir prog test
= do chdir (dir ++ "/" ++ test)
putStr $ dir ++ "/" ++ test ++ ": "
system $ "sh ./run " ++ prog ++ " | tr -d '\\r' > output"
Right out <- readFile "output"
| Left err => do print err
pure False
Right exp <- readFile "expected"
| Left err => do print err
pure False
if (out == exp)
then putStrLn "success"
else putStrLn $ "FAILURE: found " ++ out
chdir "../.."
pure (out == exp)
exists : String -> IO Bool
exists f
= do Right ok <- openFile f Read
| Left err => pure False
closeFile ok
pure True
firstExists : List String -> IO (Maybe String)
firstExists [] = pure Nothing
firstExists (x :: xs) = if !(exists x) then pure (Just x) else firstExists xs
findChez : IO (Maybe String)
findChez
2019-07-10 01:45:33 +03:00
= do env <- getEnv "CHEZ"
case env of
Just n => pure $ Just n
Nothing => firstExists [p ++ x | p <- ["/usr/bin/", "/usr/local/bin/"],
x <- ["scheme", "chez", "chezscheme9.5"]]
main : IO ()
main
2019-06-11 13:54:47 +03:00
= do [_, idris2] <- getArgs
| _ => do putStrLn "Usage: runtests [ttimp path]"
2019-06-11 13:54:47 +03:00
ttimps <- traverse (runTest "ttimp" idris2) ttimpTests
idrs <- traverse (runTest "idris2" idris2) idrisTests
2019-06-30 19:38:40 +03:00
typedds <- traverse (runTest "typedd-book" idris2) typeddTests
ideModes <- traverse (runTest "ideMode" idris2) ideModeTests
chexec <- findChez
chezs <- maybe (do putStrLn "Chez Scheme not found"
pure [])
(\c => do putStrLn $ "Found Chez Scheme at " ++ c
traverse (runTest "chez" idris2) chezTests)
chexec
let res = ttimps ++ typedds ++ idrs ++ ideModes ++ chezs
putStrLn (show (length (filter id res)) ++ "/" ++ show (length res)
2019-06-30 00:43:06 +03:00
++ " tests successful")
if (any not res)
then exitWith (ExitFailure 1)
else exitWith ExitSuccess