git.iko.soy/rowtype-yoga/purescript-native
on 7db07cc help sign in
rowtype-yoga/purescript-native/pcc/TestMain.hs
129 lines 4.3 kB history raw
1-------------------------------------------------------------------------------
2--
3-- Module : Main
4-- Copyright : (c) 2015 Andy Arvanitis and other contributors
5-- License : MIT
6--
7-- Maintainer : Andy Arvanitis
8-- Stability : experimental
9-- Portability :
10--
11--
12--
13-------------------------------------------------------------------------------
14module Main where
16import Data.List
17import Control.Applicative
18import Control.Monad
20import System.Process
21import System.FilePath
22import System.Directory
24-------------------------------------------------------------------------------
25testsDir :: IO (FilePath, FilePath)
26-------------------------------------------------------------------------------
27testsDir = do
28 baseDir <- getCurrentDirectory
29 return (baseDir </> "pcc-tests", baseDir)
31-------------------------------------------------------------------------------
32main :: IO ()
33-------------------------------------------------------------------------------
34main = do
36 (outputDir, baseDir) <- testsDir
38 outputDirExists <- doesDirectoryExist outputDir
39 when outputDirExists $ removeDirectoryRecursive outputDir
40 createDirectory outputDir
42 fetchPackages
44 let srcDir = outputDir </> "src"
45 createDirectory srcDir
47 let passingDir = baseDir </> "examples" </> "passing"
48 passingTestCases <- sort . filter (".purs" `isSuffixOf`) <$> getDirectoryContents passingDir
50 -- Auto-generate Makefile
51 setCurrentDirectory outputDir
52 callProcess "pcc" []
54 let tests = filter (`notElem` skipped) passingTestCases
56 -- Run the tests
57 --
58 forM_ tests $ \inputFile -> do
59 --
60 -- Compile/build
61 --
62 putStrLn $ "Compiling test " ++ inputFile ++ " ..."
63 setCurrentDirectory outputDir
64 copyFile (passingDir </> inputFile) (srcDir </> inputFile)
66 let testCaseDir = passingDir </> (takeWhile (/='.') inputFile)
67 testCaseDirExists <- doesDirectoryExist testCaseDir
68 when testCaseDirExists $ callProcess "cp" ["-R", testCaseDir, srcDir]
70 callProcess "make" ["clean"]
71 callProcess "make" ["debug"]
72 --
73 -- Run C++ files
74 --
75 callProcess ("output" </> "bin" </> "main") []
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 "pcc-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-------------------------------------------------------------------------------
93repo :: String
94-------------------------------------------------------------------------------
95repo = "git://github.com/pure11/"
97-------------------------------------------------------------------------------
98packages :: [(String, String)]
99-------------------------------------------------------------------------------
100packages =
101 [ ("purescript-eff", "")
102 , ("purescript-prelude", "")
103 , ("purescript-assert", "")
104 , ("purescript-st", "")
105 , ("purescript-console", "")
106 , ("purescript-functions", "")
107 , ("purescript-partial", "")
108 , ("purescript-newtype", "")
109 ]
111-------------------------------------------------------------------------------
112fetchPackages :: IO ()
113-------------------------------------------------------------------------------
114fetchPackages = do
115 (outputDir, baseDir) <- testsDir
116 let packageDir = outputDir </> "packages"
117 createDirectory packageDir
118 setCurrentDirectory packageDir
119 forM_ packages $ \package -> let branch = snd package in
120 callProcess "git" $ ["clone"] ++ (if null branch then [] else ["--branch", branch]) ++ [repo ++ (fst package) ++ ".git"]
121 setCurrentDirectory baseDir
123-------------------------------------------------------------------------------
124skipped :: [String]
125-------------------------------------------------------------------------------
126skipped =
127 [ "NumberLiterals.purs" -- unreliable float comparison, test manually
128 , "FunWithFunDeps.purs" -- requires FFI
129 ]