diff options
Diffstat (limited to 'testkiki/testkiki.hs')
-rw-r--r-- | testkiki/testkiki.hs | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/testkiki/testkiki.hs b/testkiki/testkiki.hs new file mode 100644 index 0000000..d84f92d --- /dev/null +++ b/testkiki/testkiki.hs | |||
@@ -0,0 +1,58 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-# LANGUAGE DoAndIfThenElse #-} | ||
3 | import System.Environment | ||
4 | --import System.Posix.Env.ByteString (getEnv) | ||
5 | import System.Posix.Files | ||
6 | import Test.Hspec | ||
7 | import System.Process | ||
8 | import Control.Exception | ||
9 | import System.Directory | ||
10 | import System.FilePath | ||
11 | import System.Exit | ||
12 | import System.IO | ||
13 | --import System.Posix.ByteString.FilePath | ||
14 | import Control.Applicative | ||
15 | import Control.Monad | ||
16 | |||
17 | |||
18 | data TestKikiSettings = TKS | ||
19 | { chroot :: FilePath | ||
20 | } | ||
21 | deriving (Show,Eq) | ||
22 | |||
23 | kiki = "./dist/build/kiki/kiki" | ||
24 | |||
25 | main = do | ||
26 | args <- getArgs | ||
27 | cwd <- getCurrentDirectory | ||
28 | let chomp x = takeWhile (/='\n') x | ||
29 | date <- maybe (return "") | ||
30 | (\x -> chomp <$> readProcess x ["+%Y-%m-%d-%H%M"] "") =<< findExecutable "date" | ||
31 | |||
32 | let tdir = cwd </> "TESTS" </> date | ||
33 | |||
34 | {- -- Remove old TESTS, clean up directory | ||
35 | - -- XXX: get this to work right with HSpec | ||
36 | - | ||
37 | - when (args == ["clean"]) $ do | ||
38 | - removeDirectoryRecursive (cwd </> "TESTS") | ||
39 | -} | ||
40 | |||
41 | existsAlready <- or <$> (sequence $ map ($ tdir) [doesDirectoryExist,doesFileExist]) | ||
42 | |||
43 | if existsAlready then do | ||
44 | hPutStrLn stderr ("Path " ++ show tdir ++ " already exists, remove or change working folder to run clean tests.") | ||
45 | exitFailure | ||
46 | else do | ||
47 | let chrootdir = cwd </> tdir </> "chroot" | ||
48 | createDirectoryIfMissing True chrootdir | ||
49 | let config = TKS { chroot = chrootdir } | ||
50 | print config | ||
51 | putStrLn "===" | ||
52 | doTests config | ||
53 | |||
54 | doTests :: TestKikiSettings -> IO () | ||
55 | doTests tkConfig = hspec $ do | ||
56 | describe "TODO: error" $ | ||
57 | it "throws an exception" $ | ||
58 | evaluate (error "TODO:testsuite") `shouldThrow` anyException | ||