git.iko.soy/rowtype-yoga/purescript-native
on ba2cc5c help sign in
rowtype-yoga/purescript-native/src/Tests.hs
142 lines 4.9 kB history raw
1module Tests (runTests) where
3import Prelude.Compat
4import Data.List
5import Control.Applicative
6import Control.Monad
8import System.Process
9import System.FilePath
10import System.IO
11import System.Directory
13-------------------------------------------------------------------------------
14testsDir :: IO (FilePath, FilePath)
15-------------------------------------------------------------------------------
16testsDir = do
17 baseDir <- getCurrentDirectory
18 return (baseDir </> "purescript-tests", baseDir)
20-------------------------------------------------------------------------------
21runTests :: IO ()
22-------------------------------------------------------------------------------
23runTests = do
25 (outputDir, baseDir) <- testsDir
27 outputDirExists <- doesDirectoryExist outputDir
28 when outputDirExists $ removeDirectoryRecursive outputDir
29 createDirectory outputDir
31 let srcDir = outputDir </> "src"
32 createDirectory srcDir
34 callProcess "git" ["clone", "--branch", "v0.13.0", "--depth", "1", "https://github.com/purescript/purescript.git"]
35 let passingDir = baseDir </> "purescript" </> "tests" </> "purs" </> "passing"
36 passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passingDir
38 setCurrentDirectory outputDir
39 callProcess "pscpp" ["--makefile"]
41 fetchPackages
42 callProcess "git" ["clone", "--depth", "1", "https://github.com/andyarvanitis/purescript-cpp-ffi.git", "ffi"]
44 callProcess "rm" ["-rf", ".psc-package/psc-0.13.0/prelude/v4.1.0"]
45 callProcess "git" ["clone", "--branch", "v4.1.1", "--depth", "1", "https://github.com/purescript/purescript-prelude.git", ".psc-package/psc-0.13.0/prelude/v4.1.0"]
47 let tests = filter (`notElem` skipped) passingTestCases
49 tmp <- getTemporaryDirectory
50 createDirectoryIfMissing False (tmp </> logpath)
51 outputFile <- openFile (tmp </> logpath </> logfile) WriteMode
52 hClose outputFile
54 -- Run the tests
55 --
56 forM_ tests $ \inputFile -> do
57 --
58 -- Compile/build
59 --
60 putStrLn $ "Compiling test " ++ inputFile ++ " ..."
61 setCurrentDirectory outputDir
62 copyFile (passingDir </> inputFile) (srcDir </> inputFile)
64 let testCaseDir = passingDir </> (takeWhile (/='.') inputFile)
65 testCaseDirExists <- doesDirectoryExist testCaseDir
66 when testCaseDirExists $ callProcess "cp" ["-R", testCaseDir, srcDir]
68 callProcess "make" ["clean"]
69 callProcess "make" ["debug", "-j8"]
70 --
71 -- Run C++ files
72 --
73 outputFile <- openFile (tmp </> logpath </> logfile) AppendMode
74 hPutStrLn outputFile ("\n" ++ inputFile ++ ":")
75 proc <- runProcess ("output" </> "bin" </> "main") [] Nothing Nothing Nothing (Just outputFile) Nothing
77 removeFile (srcDir </> inputFile)
78 when testCaseDirExists $ callProcess "rm" ["-rf", srcDir </> (takeWhile (/='.') inputFile)]
80 -- TODO: support failing test cases
81 --
82 -- let failing = baseDir </> "examples" </> "failing"
83 -- failingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents failing
84 --
86 setCurrentDirectory baseDir
87 putStrLn "PureScript tests finished"
88 putStrLn $ "Total tests available: " ++ show (length passingTestCases)
89 putStrLn $ "Tests run: " ++ show (length tests)
90 putStrLn $ "Tests skipped: " ++ show (length skipped)
92-------------------------------------------------------------------------------
93packages :: [String]
94-------------------------------------------------------------------------------
95packages =
96 [ "arrays"
97 , "assert"
98 , "console"
99 , "control"
100 , "effect"
101 , "foldable-traversable"
102 , "functions"
103 , "generics-rep"
104 , "invariant"
105 , "newtype"
106 , "partial"
107 , "prelude"
108 , "proxy"
109 , "refs"
110 , "st"
111 , "type-equality"
112 , "typelevel-prelude"
113 ]
115-------------------------------------------------------------------------------
116fetchPackages :: IO ()
117-------------------------------------------------------------------------------
118fetchPackages = do
119 callProcess "psc-package" ["init"]
120 mapM (callProcess "psc-package" . (\p -> ["install", p])) packages
121 return ()
123-------------------------------------------------------------------------------
124skipped :: [String]
125-------------------------------------------------------------------------------
126skipped =
127 [ "2172.purs" -- foreign in Main needed (test manually)
128 , "EffFn.purs" -- foreign in Main needed (test manually)
129 , "FunWithFunDeps.purs" -- foreign in Main needed (test manually)
130 , "NumberLiterals.purs" -- unreliable float string comparison (test manually)
131 , "PolyLabels.purs" -- foreign in Main needed (test manually)
132 , "RowUnion.purs" -- foreign in Main needed (test manually)
133 , "ShadowedModuleName.purs" -- ?
134 , "StringEdgeCases.purs" -- javascript char encoding specific
135 , "StringEscapes.purs" -- Partially javascript-char-encoding-specific (test manually)
136 ]
138logpath :: FilePath
139logpath = "purescript-output"
141logfile :: FilePath
142logfile = "purescript-tests.out"