never executed always true always false

    1 {-# LANGUAGE RecordWildCards #-}
    2 
    3 module Conjure.Custom ( tests ) where
    4 
    5 -- conjure
    6 import Conjure.Prelude
    7 import Conjure.Language.Pretty 
    8 import Conjure.ModelAllSolveAll ( TestTimeLimit(..) )
    9 
   10 -- tasty
   11 import Test.Tasty ( TestTree, testGroup )
   12 import Test.Tasty.HUnit ( testCaseSteps, assertFailure )
   13 
   14 -- text
   15 import Data.Text.IO as T ( readFile, writeFile )
   16 
   17 -- shelly
   18 import Shelly ( cd, bash, errExit, lastStderr )
   19 
   20 
   21 tests :: IO (TestTimeLimit -> TestTree)
   22 tests = do
   23     let baseDir = "tests/custom"
   24     dirs <- mapM (isTestDir baseDir) =<< getAllDirs baseDir
   25     let testCases tl = concatMap (testSingleDir tl) (catMaybes dirs)
   26     return $ \ tl -> testGroup "custom" (testCases tl)
   27 
   28 
   29 data TestDirFiles = TestDirFiles
   30     { name           :: String          -- a name for the test case
   31     , tBaseDir       :: FilePath        -- dir
   32     , expectedTime   :: Int
   33     }
   34     deriving Show
   35 
   36 
   37 -- returns True if the argument points to a directory that is not hidden
   38 isTestDir :: FilePath -> FilePath -> IO (Maybe TestDirFiles)
   39 isTestDir baseDir dir = do
   40     dirContents <- getDirectoryContents dir
   41     let runSh = filter ("run.sh" ==) dirContents
   42     case runSh of
   43         [_] -> do
   44             expectedTime <-
   45                 if "expected-time.txt" `elem` dirContents
   46                     then fromMaybe 0 . readMay . textToString <$> T.readFile (dir ++ "/expected-time.txt")
   47                     else return 0
   48             return $ Just TestDirFiles
   49                         { name           = drop (length baseDir + 1) dir
   50                         , tBaseDir       = dir
   51                         , expectedTime   = expectedTime
   52                         }
   53         _ -> return Nothing
   54 
   55 
   56 testSingleDir :: TestTimeLimit -> TestDirFiles -> [TestTree]
   57 testSingleDir (TestTimeLimit timeLimitMin timeLimitMax) TestDirFiles{..} =
   58     let
   59         shouldRun = or [ timeLimitMax == 0
   60                        , timeLimitMin <= expectedTime && expectedTime <= timeLimitMax
   61                        ]
   62     in
   63         if shouldRun
   64             then return $ testCaseSteps (map (\ ch -> if ch == '/' then '.' else ch) name) $ \ step -> do
   65                 step "Running"
   66                 (stdout, stderr) <- sh $ errExit False $ do
   67                     -- stdout <- run (tBaseDir </> "run.sh") []
   68                     cd (tBaseDir)
   69                     stdout <- bash "./run.sh" []
   70                     stderr <- lastStderr
   71                     return (stdout, stderr)
   72                 T.writeFile (tBaseDir </> "stdout") stdout
   73                 T.writeFile (tBaseDir </> "stderr") stderr
   74 
   75                 let
   76                     readIfExists :: FilePath -> IO String
   77                     readIfExists f = fromMaybe "" <$> readFileIfExists f
   78 
   79                 step "Checking stderr"
   80                 stderrG <- readIfExists (tBaseDir </> "stderr")
   81                 stderrE <- readIfExists (tBaseDir </> "stderr.expected")
   82                 unless (stderrE == stderrG) $
   83                     assertFailure $ renderNormal $ vcat
   84                         [ "unexpected stderr:" <++> vcat (map pretty (lines stderrG))
   85                         , "was expecting:    " <++> vcat (map pretty (lines stderrE)) ]
   86                 step "Checking stdout"
   87                 stdoutG <- readIfExists (tBaseDir </> "stdout")
   88                 stdoutE <- readIfExists (tBaseDir </> "stdout.expected")
   89                 unless (stdoutE == stdoutG) $
   90                     assertFailure $ renderNormal $ vcat
   91                         [ "unexpected stdout:" <++> vcat (map pretty (lines stdoutG))
   92                         , "was expecting:    " <++> vcat (map pretty (lines stdoutE)) ]
   93             else []
   94