From e40babf7ef744375eae355742acf47d4e6323f2e Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Mon, 25 Apr 2016 15:42:33 -0400
Subject: testsuite

---
 testkiki/testkiki.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 testkiki/testkiki.hs

(limited to 'testkiki/testkiki.hs')

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 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+import System.Environment
+--import System.Posix.Env.ByteString (getEnv)
+import System.Posix.Files
+import Test.Hspec
+import System.Process
+import Control.Exception
+import System.Directory
+import System.FilePath
+import System.Exit
+import System.IO
+--import System.Posix.ByteString.FilePath
+import Control.Applicative
+import Control.Monad
+
+
+data TestKikiSettings = TKS
+        { chroot :: FilePath
+        }
+    deriving (Show,Eq)
+
+kiki = "./dist/build/kiki/kiki"
+
+main = do
+    args <- getArgs
+    cwd <- getCurrentDirectory
+    let chomp x = takeWhile (/='\n') x
+    date <- maybe (return "") 
+                  (\x -> chomp <$> readProcess x ["+%Y-%m-%d-%H%M"] "") =<< findExecutable "date"
+
+    let tdir = cwd </> "TESTS" </> date
+
+    {- -- Remove old TESTS, clean up directory
+     - -- XXX: get this to work right with HSpec
+     -
+     - when (args == ["clean"]) $ do
+     -  removeDirectoryRecursive (cwd </> "TESTS")
+     -}
+
+    existsAlready <- or <$> (sequence $ map ($ tdir) [doesDirectoryExist,doesFileExist])
+
+    if existsAlready then do
+        hPutStrLn stderr ("Path " ++ show tdir ++ " already exists, remove or change working folder to run clean tests.")
+        exitFailure
+    else do
+        let chrootdir = cwd </> tdir </> "chroot"
+        createDirectoryIfMissing True chrootdir
+        let config = TKS { chroot = chrootdir }
+        print config 
+        putStrLn "==="
+        doTests config
+
+doTests :: TestKikiSettings -> IO ()
+doTests tkConfig = hspec $ do
+    describe "TODO: error" $ 
+        it "throws an exception" $ 
+            evaluate (error "TODO:testsuite") `shouldThrow` anyException
-- 
cgit v1.2.3