{- -----------------------------------------------------------------------------
Copyright 2020-2021,2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

module Cli.TestRunner (
  runSingleTest,
) where

import Control.Arrow (second)
import Control.Monad (when)
import Control.Monad.IO.Class
import Data.List (intercalate,isSuffixOf,nub,sort)
import System.Directory
import System.IO
import System.Posix.Temp (mkdtemp)
import System.FilePath
import Text.Regex.TDFA
import qualified Data.Map as Map

import Base.CompilerError
import Base.TrackedErrors
import Cli.Programs
import CompilerCxx.CxxFiles
import CompilerCxx.LanguageModule
import CompilerCxx.Naming
import Module.CompileMetadata
import Module.Paths
import Module.ProcessMetadata
import Parser.SourceFile
import Parser.TextParser (SourceContext)
import Types.IntegrationTest
import Types.Procedure
import Types.TypeCategory


runSingleTest :: CompilerBackend b => b -> FilePath ->
  LanguageModule SourceContext -> [FilePath] -> [CompileMetadata] ->
  (String,String) -> TrackedErrorsIO ((Int,Int),TrackedErrors ())
runSingleTest :: forall b.
CompilerBackend b =>
b
-> FilePath
-> LanguageModule SourceContext
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
runSingleTest b
b FilePath
cl LanguageModule SourceContext
cm [FilePath]
paths [CompileMetadata]
deps (FilePath
f,FilePath
s) = do
  IO () -> TrackedErrorsT IO ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> TrackedErrorsT IO ()) -> IO () -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\nExecuting tests from " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
  ((Int, Int), TrackedErrors ())
allResults <- TrackedErrorsT
  Identity
  ([PragmaSource SourceContext], [IntegrationTest SourceContext])
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m) =>
TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
-> m ((Int, Int), TrackedErrors ())
checkAndRun ((FilePath, FilePath)
-> TrackedErrorsT
     Identity
     ([PragmaSource SourceContext], [IntegrationTest SourceContext])
forall (m :: * -> *).
ErrorContextM m =>
(FilePath, FilePath)
-> m ([PragmaSource SourceContext],
      [IntegrationTest SourceContext])
parseTestSource (FilePath
f,FilePath
s))
  ((Int, Int), TrackedErrors ())
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
forall a. a -> TrackedErrorsT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int, Int), TrackedErrors ())
 -> TrackedErrorsIO ((Int, Int), TrackedErrors ()))
-> ((Int, Int), TrackedErrors ())
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ (TrackedErrors () -> TrackedErrors ())
-> ((Int, Int), TrackedErrors ()) -> ((Int, Int), TrackedErrors ())
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((FilePath
"\nIn test file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f) FilePath -> TrackedErrors () -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a -> m a
??>) ((Int, Int), TrackedErrors ())
allResults where
    checkAndRun :: TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
-> m ((Int, Int), TrackedErrors ())
checkAndRun TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
ts
      | TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
ts = do
        IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse tests in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
        ((Int, Int), TrackedErrors ()) -> m ((Int, Int), TrackedErrors ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
0,Int
1),TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
ts TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
-> TrackedErrors () -> TrackedErrors ()
forall a b.
TrackedErrorsT Identity a
-> TrackedErrorsT Identity b -> TrackedErrorsT Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      | Bool
otherwise = do
          let (a
_,[IntegrationTest SourceContext]
ts') = TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
-> (a, [IntegrationTest SourceContext])
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT Identity (a, [IntegrationTest SourceContext])
ts
          [((Int, Int), TrackedErrors ())]
allResults <- (IntegrationTest SourceContext -> m ((Int, Int), TrackedErrors ()))
-> [IntegrationTest SourceContext]
-> m [((Int, Int), TrackedErrors ())]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM IntegrationTest SourceContext -> m ((Int, Int), TrackedErrors ())
forall {m :: * -> *}.
(ErrorContextM m, MonadIO m) =>
IntegrationTest SourceContext -> m ((Int, Int), TrackedErrors ())
runSingle [IntegrationTest SourceContext]
ts'
          let passed :: Int
passed = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((Int, Int), TrackedErrors ()) -> Int)
-> [((Int, Int), TrackedErrors ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> (((Int, Int), TrackedErrors ()) -> (Int, Int))
-> ((Int, Int), TrackedErrors ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), TrackedErrors ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), TrackedErrors ())]
allResults
          let failed :: Int
failed = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((Int, Int), TrackedErrors ()) -> Int)
-> [((Int, Int), TrackedErrors ())] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> (((Int, Int), TrackedErrors ()) -> (Int, Int))
-> ((Int, Int), TrackedErrors ())
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), TrackedErrors ()) -> (Int, Int)
forall a b. (a, b) -> a
fst) [((Int, Int), TrackedErrors ())]
allResults
          let result :: TrackedErrors ()
result = [TrackedErrors ()] -> TrackedErrors ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ ([TrackedErrors ()] -> TrackedErrors ())
-> [TrackedErrors ()] -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ (((Int, Int), TrackedErrors ()) -> TrackedErrors ())
-> [((Int, Int), TrackedErrors ())] -> [TrackedErrors ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Int), TrackedErrors ()) -> TrackedErrors ()
forall a b. (a, b) -> b
snd [((Int, Int), TrackedErrors ())]
allResults
          ((Int, Int), TrackedErrors ()) -> m ((Int, Int), TrackedErrors ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
passed,Int
failed),TrackedErrors ()
result)

    runSingle :: IntegrationTest SourceContext -> m ((Int, Int), TrackedErrors ())
runSingle IntegrationTest SourceContext
t = do
      let name :: FilePath
name = FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IntegrationTestHeader SourceContext -> FilePath
forall c. IntegrationTestHeader c -> FilePath
ithTestName (IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" (from " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")"
      let context :: FilePath
context = [SourceContext] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContextBrace (IntegrationTestHeader SourceContext -> [SourceContext]
forall c. IntegrationTestHeader c -> [c]
ithContext (IntegrationTestHeader SourceContext -> [SourceContext])
-> IntegrationTestHeader SourceContext -> [SourceContext]
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t)
      let scope :: FilePath
scope = FilePath
"\nIn testcase \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IntegrationTestHeader SourceContext -> FilePath
forall c. IntegrationTestHeader c -> FilePath
ithTestName (IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
context
      IntegrationTestHeader SourceContext -> m ()
forall {m :: * -> *} {c}.
ErrorContextM m =>
IntegrationTestHeader c -> m ()
warnUnused (IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t) m () -> FilePath -> m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
scope
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\n*** Executing testcase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ***"
      TrackedErrors [TrackedErrors ()]
result <- TrackedErrorsT m [TrackedErrors ()]
-> m (TrackedErrors [TrackedErrors ()])
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT m [TrackedErrors ()]
 -> m (TrackedErrors [TrackedErrors ()]))
-> TrackedErrorsT m [TrackedErrors ()]
-> m (TrackedErrors [TrackedErrors ()])
forall a b. (a -> b) -> a -> b
$ ExpectedResult SourceContext
-> [FilePath]
-> Maybe Integer
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall {m :: * -> *} {a}.
(MonadIO m, Num a, Ord a, Show a) =>
ExpectedResult SourceContext
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
run (IntegrationTestHeader SourceContext -> ExpectedResult SourceContext
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult (IntegrationTestHeader SourceContext
 -> ExpectedResult SourceContext)
-> IntegrationTestHeader SourceContext
-> ExpectedResult SourceContext
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t)
                                      (IntegrationTestHeader SourceContext -> [FilePath]
forall c. IntegrationTestHeader c -> [FilePath]
ithArgs (IntegrationTestHeader SourceContext -> [FilePath])
-> IntegrationTestHeader SourceContext -> [FilePath]
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t)
                                      (IntegrationTestHeader SourceContext -> Maybe Integer
forall c. IntegrationTestHeader c -> Maybe Integer
ithTimeout (IntegrationTestHeader SourceContext -> Maybe Integer)
-> IntegrationTestHeader SourceContext -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourceContext
-> IntegrationTestHeader SourceContext
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourceContext
t)
                                      (IntegrationTest SourceContext -> [AnyCategory SourceContext]
forall c. IntegrationTest c -> [AnyCategory c]
itCategory IntegrationTest SourceContext
t) (IntegrationTest SourceContext -> [DefinedCategory SourceContext]
forall c. IntegrationTest c -> [DefinedCategory c]
itDefinition IntegrationTest SourceContext
t) (IntegrationTest SourceContext -> [TestProcedure SourceContext]
forall c. IntegrationTest c -> [TestProcedure c]
itTests IntegrationTest SourceContext
t)
      if TrackedErrors [TrackedErrors ()] -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors [TrackedErrors ()]
result
         then ((Int, Int), TrackedErrors ()) -> m ((Int, Int), TrackedErrors ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
0,Int
1),FilePath
scope FilePath -> TrackedErrors () -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a -> m a
??> (TrackedErrors [TrackedErrors ()]
result TrackedErrors [TrackedErrors ()]
-> TrackedErrors () -> TrackedErrors ()
forall a b.
TrackedErrorsT Identity a
-> TrackedErrorsT Identity b -> TrackedErrorsT Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
         else do
           let allResults :: [TrackedErrors ()]
allResults = TrackedErrors [TrackedErrors ()] -> [TrackedErrors ()]
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrors [TrackedErrors ()]
result
           let passed :: Int
passed = [TrackedErrors ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TrackedErrors ()] -> Int) -> [TrackedErrors ()] -> Int
forall a b. (a -> b) -> a -> b
$ (TrackedErrors () -> Bool)
-> [TrackedErrors ()] -> [TrackedErrors ()]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (TrackedErrors () -> Bool) -> TrackedErrors () -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError) [TrackedErrors ()]
allResults
           let failed :: Int
failed = [TrackedErrors ()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TrackedErrors ()] -> Int) -> [TrackedErrors ()] -> Int
forall a b. (a -> b) -> a -> b
$ (TrackedErrors () -> Bool)
-> [TrackedErrors ()] -> [TrackedErrors ()]
forall a. (a -> Bool) -> [a] -> [a]
filter TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError [TrackedErrors ()]
allResults
           let combined :: TrackedErrors ()
combined = FilePath
scope FilePath -> TrackedErrors () -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a -> m a
??> [TrackedErrors ()] -> TrackedErrors ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [TrackedErrors ()]
allResults
           if Int
failed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
             then IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"*** Some tests in testcase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" failed ***"
             else IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"*** All tests in testcase " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" passed ***"
           ((Int, Int), TrackedErrors ()) -> m ((Int, Int), TrackedErrors ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
passed,Int
failed),TrackedErrors ()
combined)

    warnUnused :: IntegrationTestHeader c -> m ()
warnUnused (IntegrationTestHeader [c]
_ FilePath
_ [FilePath]
args Maybe Integer
timeout ExpectedResult c
ex) = m ()
check where
      check :: m ()
check =
        case ExpectedResult c
ex of
             (ExpectCompilerError [c]
_ [OutputPattern]
_ [OutputPattern]
_) -> do
               FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
warnArgs    FilePath
"error"
               FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
warnTimeout FilePath
"error"
             (ExpectCompiles [c]
_ [OutputPattern]
_ [OutputPattern]
_) -> do
               FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
warnArgs    FilePath
"compiles"
               FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
warnTimeout FilePath
"compiles"
             ExpectedResult c
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      warnArgs :: FilePath -> m ()
warnArgs FilePath
ex2 =
        case [FilePath]
args of
             [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             [FilePath]
_  -> FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Explicit args are ignored in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ex2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" tests: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args)
      warnTimeout :: FilePath -> m ()
warnTimeout FilePath
ex2 =
        case Maybe Integer
timeout of
             Maybe Integer
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             Just  Integer
t -> FilePath -> m ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
compilerWarningM (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Explicit timeouts are ignored in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
ex2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" tests: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
t

    run :: ExpectedResult SourceContext
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
run (ExpectCompilerError [SourceContext]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
_ Maybe a
_ [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result <- TrackedErrorsT
  (TrackedErrorsT m)
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m
     (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT
   (TrackedErrorsT m)
   ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
 -> TrackedErrorsT
      m
      (TrackedErrors
         ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])))
-> TrackedErrorsT
     (TrackedErrorsT m)
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m
     (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall a b. (a -> b) -> a -> b
$ Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     (TrackedErrorsT m)
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall {m :: * -> *}.
Monad m =>
Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll Maybe ([SourceContext], TypeInstance)
forall a. Maybe a
Nothing [] [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then FilePath -> TrackedErrorsT m [TrackedErrors ()]
forall a. FilePath -> TrackedErrorsT m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Expected compilation failure"
         else (TrackedErrors () -> [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
forall a b. (a -> b) -> TrackedErrorsT m a -> TrackedErrorsT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TrackedErrors () -> [TrackedErrors ()] -> [TrackedErrors ()]
forall a. a -> [a] -> [a]
:[]) (TrackedErrorsT m (TrackedErrors ())
 -> TrackedErrorsT m [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
forall a b. (a -> b) -> a -> b
$ TrackedErrors () -> TrackedErrorsT m (TrackedErrors ())
forall a. a -> TrackedErrorsT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> TrackedErrorsT m (TrackedErrors ()))
-> TrackedErrors () -> TrackedErrorsT m (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
           let warnings :: FilePath
warnings = CompilerMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompilerMessage -> FilePath) -> CompilerMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           let errors :: FilePath
errors   = CompilerMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompilerMessage -> FilePath) -> CompilerMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> TrackedErrors ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines FilePath
warnings [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines FilePath
errors) [] []

    run (ExpectCompiles [SourceContext]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
_ Maybe a
_ [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result <- TrackedErrorsT
  (TrackedErrorsT m)
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m
     (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT
   (TrackedErrorsT m)
   ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
 -> TrackedErrorsT
      m
      (TrackedErrors
         ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])))
-> TrackedErrorsT
     (TrackedErrorsT m)
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m
     (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall a b. (a -> b) -> a -> b
$ Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     (TrackedErrorsT m)
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall {m :: * -> *}.
Monad m =>
Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll Maybe ([SourceContext], TypeInstance)
forall a. Maybe a
Nothing [] [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result TrackedErrorsT
  m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT m [TrackedErrors ()]
-> TrackedErrorsT m [TrackedErrors ()]
forall a b.
TrackedErrorsT m a -> TrackedErrorsT m b -> TrackedErrorsT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TrackedErrors ()] -> TrackedErrorsT m [TrackedErrors ()]
forall a. a -> TrackedErrorsT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
         else (TrackedErrors () -> [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
forall a b. (a -> b) -> TrackedErrorsT m a -> TrackedErrorsT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TrackedErrors () -> [TrackedErrors ()] -> [TrackedErrors ()]
forall a. a -> [a] -> [a]
:[]) (TrackedErrorsT m (TrackedErrors ())
 -> TrackedErrorsT m [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
forall a b. (a -> b) -> a -> b
$ TrackedErrors () -> TrackedErrorsT m (TrackedErrors ())
forall a. a -> TrackedErrorsT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TrackedErrors () -> TrackedErrorsT m (TrackedErrors ()))
-> TrackedErrors () -> TrackedErrorsT m (TrackedErrors ())
forall a b. (a -> b) -> a -> b
$ do
           let warnings :: FilePath
warnings = CompilerMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompilerMessage -> FilePath) -> CompilerMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> TrackedErrors ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines FilePath
warnings) [] []

    run (ExpectRuntimeError [SourceContext]
_ Maybe ([SourceContext], TypeInstance)
t [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args Maybe a
timeout [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      Bool -> TrackedErrorsT m () -> TrackedErrorsT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TestProcedure SourceContext] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TestProcedure SourceContext]
ts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1) (TrackedErrorsT m () -> TrackedErrorsT m ())
-> TrackedErrorsT m () -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> TrackedErrorsT m ()
forall a. FilePath -> TrackedErrorsT m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Exactly one unittest is required when failure is expected"
      [TestProcedure SourceContext] -> TrackedErrorsT m ()
forall {m :: * -> *} {a}.
(CollectErrorsM m, Show a, Ord a) =>
[TestProcedure a] -> m ()
uniqueTestNames [TestProcedure SourceContext]
ts
      Bool
-> Maybe ([SourceContext], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m, Num a, Ord a, Show a) =>
Bool
-> Maybe ([SourceContext], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
False Maybe ([SourceContext], TypeInstance)
t [OutputPattern]
rs [OutputPattern]
es [FilePath]
args Maybe a
timeout [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts

    run (ExpectRuntimeSuccess [SourceContext]
_ Maybe ([SourceContext], TypeInstance)
t [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args Maybe a
timeout [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      Bool -> TrackedErrorsT m () -> TrackedErrorsT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TestProcedure SourceContext] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestProcedure SourceContext]
ts) (TrackedErrorsT m () -> TrackedErrorsT m ())
-> TrackedErrorsT m () -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> TrackedErrorsT m ()
forall a. FilePath -> TrackedErrorsT m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"At least one unittest is required when success is expected"
      [TestProcedure SourceContext] -> TrackedErrorsT m ()
forall {m :: * -> *} {a}.
(CollectErrorsM m, Show a, Ord a) =>
[TestProcedure a] -> m ()
uniqueTestNames [TestProcedure SourceContext]
ts
      Bool
-> Maybe ([SourceContext], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m, Num a, Ord a, Show a) =>
Bool
-> Maybe ([SourceContext], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
True Maybe ([SourceContext], TypeInstance)
t [OutputPattern]
rs [OutputPattern]
es [FilePath]
args Maybe a
timeout [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts

    checkContent :: [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> TrackedErrors ()
checkContent [OutputPattern]
rs [OutputPattern]
es [FilePath]
comp [FilePath]
err [FilePath]
out = do
      let cr :: TrackedErrors ()
cr = [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> TrackedErrors ()
checkRequired [OutputPattern]
rs [FilePath]
comp [FilePath]
err [FilePath]
out
      let ce :: TrackedErrors ()
ce = [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> TrackedErrors ()
checkExcluded [OutputPattern]
es [FilePath]
comp [FilePath]
err [FilePath]
out
      let compError :: TrackedErrors ()
compError = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
comp
                         then () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         else ((FilePath -> TrackedErrorsT Identity Any)
-> [FilePath] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsT Identity Any
forall a. FilePath -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM [FilePath]
comp) TrackedErrors () -> FilePath -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput from compiler:"
      let errError :: TrackedErrors ()
errError = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
err
                        then () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else ((FilePath -> TrackedErrorsT Identity Any)
-> [FilePath] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsT Identity Any
forall a. FilePath -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM [FilePath]
err) TrackedErrors () -> FilePath -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput to stderr from test:"
      let outError :: TrackedErrors ()
outError = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
out
                        then () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else ((FilePath -> TrackedErrorsT Identity Any)
-> [FilePath] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ FilePath -> TrackedErrorsT Identity Any
forall a. FilePath -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM [FilePath]
out) TrackedErrors () -> FilePath -> TrackedErrors ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput to stdout from test:"
      if TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors ()
cr Bool -> Bool -> Bool
|| TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors ()
ce
         then [TrackedErrors ()] -> TrackedErrors ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [TrackedErrors ()
cr,TrackedErrors ()
ce,TrackedErrors ()
compError,TrackedErrors ()
errError,TrackedErrors ()
outError]
         else [TrackedErrors ()] -> TrackedErrors ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [TrackedErrors ()
cr,TrackedErrors ()
ce]

    uniqueTestNames :: [TestProcedure a] -> m ()
uniqueTestNames [TestProcedure a]
ts = do
      let ts' :: Map FunctionName [TestProcedure a]
ts' = ([TestProcedure a] -> [TestProcedure a] -> [TestProcedure a])
-> [(FunctionName, [TestProcedure a])]
-> Map FunctionName [TestProcedure a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [TestProcedure a] -> [TestProcedure a] -> [TestProcedure a]
forall a. [a] -> [a] -> [a]
(++) ([(FunctionName, [TestProcedure a])]
 -> Map FunctionName [TestProcedure a])
-> [(FunctionName, [TestProcedure a])]
-> Map FunctionName [TestProcedure a]
forall a b. (a -> b) -> a -> b
$ (TestProcedure a -> (FunctionName, [TestProcedure a]))
-> [TestProcedure a] -> [(FunctionName, [TestProcedure a])]
forall a b. (a -> b) -> [a] -> [b]
map (\TestProcedure a
t -> (TestProcedure a -> FunctionName
forall c. TestProcedure c -> FunctionName
tpName TestProcedure a
t,[TestProcedure a
t])) [TestProcedure a]
ts
      ((FunctionName, [TestProcedure a]) -> m ())
-> [(FunctionName, [TestProcedure a])] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (FunctionName, [TestProcedure a]) -> m ()
forall {m :: * -> *} {a} {a}.
(CollectErrorsM m, Show a, Show a, Ord a) =>
(a, [TestProcedure a]) -> m ()
testClash ([(FunctionName, [TestProcedure a])] -> m ())
-> [(FunctionName, [TestProcedure a])] -> m ()
forall a b. (a -> b) -> a -> b
$ Map FunctionName [TestProcedure a]
-> [(FunctionName, [TestProcedure a])]
forall k a. Map k a -> [(k, a)]
Map.toList Map FunctionName [TestProcedure a]
ts'
    testClash :: (a, [TestProcedure a]) -> m ()
testClash (a
_,[TestProcedure a
_]) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    testClash (a
n,[TestProcedure a]
ts) = FilePath
"unittest " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is defined multiple times" FilePath -> m () -> m ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a -> m a
!!>
      (([a] -> m Any) -> [[a]] -> m ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (FilePath -> m Any
forall a. FilePath -> m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m Any) -> ([a] -> FilePath) -> [a] -> m Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Defined at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath) -> ([a] -> FilePath) -> [a] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContext) ([[a]] -> m ()) -> [[a]] -> m ()
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ (TestProcedure a -> [a]) -> [TestProcedure a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map TestProcedure a -> [a]
forall c. TestProcedure c -> [c]
tpContext [TestProcedure a]
ts)

    execute :: Bool
-> Maybe ([SourceContext], TypeInstance)
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> Maybe a
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
s2 Maybe ([SourceContext], TypeInstance)
t [OutputPattern]
rs [OutputPattern]
es [FilePath]
args Maybe a
timeout [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result <- TrackedErrorsT
  m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> m (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT
   m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
 -> m (TrackedErrors
         ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])))
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> m (TrackedErrors
        ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
forall a b. (a -> b) -> a -> b
$ Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall {m :: * -> *}.
Monad m =>
Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll Maybe ([SourceContext], TypeInstance)
t [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then [TrackedErrors ()] -> m [TrackedErrors ()]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrors () -> TrackedErrors ()
forall a b.
TrackedErrorsT Identity a
-> TrackedErrorsT Identity b -> TrackedErrorsT Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
forall a. a -> TrackedErrorsT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()]
         else do
           let ([CxxOutput]
xx,CxxOutput
main,[(FunctionName, [SourceContext])]
fs) = TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           (FilePath
dir,FilePath
binaryName) <- CxxOutput -> Maybe a -> [CxxOutput] -> m (FilePath, FilePath)
forall {m :: * -> *} {a}.
(MonadIO m, CollectErrorsM m, Num a, Ord a, Show a) =>
CxxOutput -> Maybe a -> [CxxOutput] -> m (FilePath, FilePath)
createBinary CxxOutput
main Maybe a
timeout [CxxOutput]
xx
           [TrackedErrors ()]
results <- IO [TrackedErrors ()] -> m [TrackedErrors ()]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TrackedErrors ()] -> m [TrackedErrors ()])
-> IO [TrackedErrors ()] -> m [TrackedErrors ()]
forall a b. (a -> b) -> a -> b
$ [IO (TrackedErrors ())] -> IO [TrackedErrors ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO (TrackedErrors ())] -> IO [TrackedErrors ()])
-> [IO (TrackedErrors ())] -> IO [TrackedErrors ()]
forall a b. (a -> b) -> a -> b
$ ((FunctionName, [SourceContext]) -> IO (TrackedErrors ()))
-> [(FunctionName, [SourceContext])] -> [IO (TrackedErrors ())]
forall a b. (a -> b) -> [a] -> [b]
map (TrackedErrorsT IO () -> IO (TrackedErrors ())
forall (m :: * -> *) a.
Monad m =>
TrackedErrorsT m a -> m (TrackedErrors a)
toTrackedErrors (TrackedErrorsT IO () -> IO (TrackedErrors ()))
-> ((FunctionName, [SourceContext]) -> TrackedErrorsT IO ())
-> (FunctionName, [SourceContext])
-> IO (TrackedErrors ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> [OutputPattern]
-> [OutputPattern]
-> TrackedErrors
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
-> (FunctionName, [SourceContext])
-> TrackedErrorsT IO ()
forall {a} {a} {a}.
(Show a, Show a) =>
FilePath
-> [OutputPattern]
-> [OutputPattern]
-> TrackedErrors a
-> Bool
-> (a, [a])
-> TrackedErrorsT IO ()
executeTest FilePath
binaryName [OutputPattern]
rs [OutputPattern]
es TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result Bool
s2) [(FunctionName, [SourceContext])]
fs
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (TrackedErrors () -> Bool) -> [TrackedErrors ()] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TrackedErrors () -> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError [TrackedErrors ()]
results) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
dir
           [TrackedErrors ()] -> m [TrackedErrors ()]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TrackedErrors ()]
results

    executeTest :: FilePath
-> [OutputPattern]
-> [OutputPattern]
-> TrackedErrors a
-> Bool
-> (a, [a])
-> TrackedErrorsT IO ()
executeTest FilePath
binary [OutputPattern]
rs [OutputPattern]
es TrackedErrors a
res Bool
s2 (a
f2,[a]
c) = TrackedErrorsT IO () -> TrackedErrorsT IO ()
forall {t :: (* -> *) -> * -> *} {a}.
(ErrorContextT t, ErrorContextM (t IO)) =>
t IO a -> t IO a
printOutcome (TrackedErrorsT IO () -> TrackedErrorsT IO ())
-> TrackedErrorsT IO () -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
context FilePath -> TrackedErrorsT IO () -> TrackedErrorsT IO ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a -> m a
??> do
      let command :: TestCommand
command = FilePath -> FilePath -> [FilePath] -> TestCommand
TestCommand FilePath
binary (FilePath -> FilePath
takeDirectory FilePath
binary) [a -> FilePath
forall a. Show a => a -> FilePath
show a
f2,FilePath
cl]
      TrackedErrorsT IO () -> TrackedErrorsT IO ()
forall a. TrackedErrorsT IO a -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => m a -> m a
resetBackgroundM (TrackedErrorsT IO () -> TrackedErrorsT IO ())
-> TrackedErrorsT IO () -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> TrackedErrorsT IO ()
forall {m :: * -> *}. ErrorContextM m => FilePath -> m ()
compilerBackgroundM (FilePath -> TrackedErrorsT IO ())
-> FilePath -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"See output files for testcase in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
takeDirectory FilePath
binary)
        (TestCommandResult Bool
s2' [FilePath]
out [FilePath]
err) <- b -> TestCommand -> TrackedErrorsT IO TestCommandResult
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> TestCommand -> m TestCommandResult
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> TestCommand -> m TestCommandResult
runTestCommand b
b TestCommand
command
        case (Bool
s2,Bool
s2') of
             (Bool
True,Bool
False) -> [TrackedErrorsT IO ()] -> TrackedErrorsT IO ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ ([TrackedErrorsT IO ()] -> TrackedErrorsT IO ())
-> [TrackedErrorsT IO ()] -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ (TrackedErrors a -> TrackedErrorsT IO ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerError TrackedErrors a
res)TrackedErrorsT IO ()
-> [TrackedErrorsT IO ()] -> [TrackedErrorsT IO ()]
forall a. a -> [a] -> [a]
:((FilePath -> TrackedErrorsT IO ())
-> [FilePath] -> [TrackedErrorsT IO ()]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> TrackedErrorsT IO ()
forall a. FilePath -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM ([FilePath] -> [TrackedErrorsT IO ()])
-> [FilePath] -> [TrackedErrorsT IO ()]
forall a b. (a -> b) -> a -> b
$ [FilePath]
err [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
out)
             (Bool
False,Bool
True) -> [TrackedErrorsT IO ()] -> TrackedErrorsT IO ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [FilePath -> TrackedErrorsT IO ()
forall a. FilePath -> TrackedErrorsT IO a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Expected runtime failure",
                                           TrackedErrors a -> TrackedErrorsT IO ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerError TrackedErrors a
res TrackedErrorsT IO () -> FilePath -> TrackedErrorsT IO ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput from compiler:"]
             (Bool, Bool)
_ -> TrackedErrors () -> TrackedErrorsT IO ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors (TrackedErrors () -> TrackedErrorsT IO ())
-> TrackedErrors () -> TrackedErrorsT IO ()
forall a b. (a -> b) -> a -> b
$ [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> TrackedErrors ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CompilerMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompilerMessage -> FilePath) -> CompilerMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ TrackedErrors a -> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings TrackedErrors a
res) [FilePath]
err [FilePath]
out
      where
        context :: FilePath
context = FilePath
"\nIn unittest " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
f2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [a] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContextBrace [a]
c
        printOutcome :: t IO a -> t IO a
printOutcome t IO a
outcome =
          t IO a -> IO () -> IO () -> t IO a
forall (m :: * -> *) a.
(Monad m, ErrorContextM (t m)) =>
t m a -> m () -> m () -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(ErrorContextT t, Monad m, ErrorContextM (t m)) =>
t m a -> m () -> m () -> t m a
ifElseSuccessT t IO a
outcome
            (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"--- unittest " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
f2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" passed ---")
            (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"--- unittest " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
f2 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" failed ---")

    compileAll :: Maybe ([SourceContext], TypeInstance)
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll Maybe ([SourceContext], TypeInstance)
t [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      let ns1 :: Namespace
ns1 = FilePath -> Namespace
StaticNamespace (FilePath -> Namespace) -> FilePath -> Namespace
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. Hashable a => a -> FilePath
privateNamespace FilePath
s
      let cs' :: [AnyCategory SourceContext]
cs' = (AnyCategory SourceContext -> AnyCategory SourceContext)
-> [AnyCategory SourceContext] -> [AnyCategory SourceContext]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace -> AnyCategory SourceContext -> AnyCategory SourceContext
forall c. Namespace -> AnyCategory c -> AnyCategory c
setCategoryNamespace Namespace
ns1) [AnyCategory SourceContext]
cs
      TrackedErrors
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors (TrackedErrors
   ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
 -> TrackedErrorsT
      m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])]))
-> TrackedErrors
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall a b. (a -> b) -> a -> b
$ LanguageModule SourceContext
-> Namespace
-> [FilePath]
-> Maybe ([SourceContext], TypeInstance)
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrors
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Namespace
-> [FilePath]
-> Maybe ([c], TypeInstance)
-> [AnyCategory c]
-> [DefinedCategory c]
-> [TestProcedure c]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
compileTestsModule LanguageModule SourceContext
cm Namespace
ns1 [FilePath]
args Maybe ([SourceContext], TypeInstance)
t [AnyCategory SourceContext]
cs' [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts

    checkRequired :: [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> TrackedErrors ()
checkRequired [OutputPattern]
rs [FilePath]
comp [FilePath]
err [FilePath]
out = (OutputPattern -> TrackedErrors ())
-> [OutputPattern] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> TrackedErrors ()
checkSubsetForRegex Bool
True  [FilePath]
comp [FilePath]
err [FilePath]
out) [OutputPattern]
rs
    checkExcluded :: [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> TrackedErrors ()
checkExcluded [OutputPattern]
es [FilePath]
comp [FilePath]
err [FilePath]
out = (OutputPattern -> TrackedErrors ())
-> [OutputPattern] -> TrackedErrors ()
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m ()
mapCompilerM_ (Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> TrackedErrors ()
checkSubsetForRegex Bool
False [FilePath]
comp [FilePath]
err [FilePath]
out) [OutputPattern]
es
    checkSubsetForRegex :: Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> TrackedErrors ()
checkSubsetForRegex Bool
expected [FilePath]
comp [FilePath]
err [FilePath]
out (OutputPattern OutputScope
OutputAny FilePath
r) =
      Bool -> [FilePath] -> FilePath -> FilePath -> TrackedErrors ()
checkForRegex Bool
expected ([FilePath]
comp [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
err [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
out) FilePath
r FilePath
"compiler output or test output"
    checkSubsetForRegex Bool
expected [FilePath]
comp [FilePath]
_ [FilePath]
_ (OutputPattern OutputScope
OutputCompiler FilePath
r) =
      Bool -> [FilePath] -> FilePath -> FilePath -> TrackedErrors ()
checkForRegex Bool
expected [FilePath]
comp FilePath
r FilePath
"compiler output"
    checkSubsetForRegex Bool
expected [FilePath]
_ [FilePath]
err [FilePath]
_ (OutputPattern OutputScope
OutputStderr FilePath
r) =
      Bool -> [FilePath] -> FilePath -> FilePath -> TrackedErrors ()
checkForRegex Bool
expected [FilePath]
err FilePath
r FilePath
"test stderr"
    checkSubsetForRegex Bool
expected [FilePath]
_ [FilePath]
_ [FilePath]
out (OutputPattern OutputScope
OutputStdout FilePath
r) =
      Bool -> [FilePath] -> FilePath -> FilePath -> TrackedErrors ()
checkForRegex Bool
expected [FilePath]
out FilePath
r FilePath
"test stdout"
    checkForRegex :: Bool -> [String] -> String -> String -> TrackedErrors ()
    checkForRegex :: Bool -> [FilePath] -> FilePath -> FilePath -> TrackedErrors ()
checkForRegex Bool
expected [FilePath]
ms FilePath
r FilePath
n = do
      let found :: Bool
found = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
r) [FilePath]
ms
      Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
found Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
expected) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ FilePath -> TrackedErrors ()
forall a. FilePath -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> TrackedErrors ()) -> FilePath -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Pattern \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
r FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" present in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
      Bool -> TrackedErrors () -> TrackedErrors ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
found Bool -> Bool -> Bool
&& Bool
expected) (TrackedErrors () -> TrackedErrors ())
-> TrackedErrors () -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ FilePath -> TrackedErrors ()
forall a. FilePath -> TrackedErrorsT Identity a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> TrackedErrors ()) -> FilePath -> TrackedErrors ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Pattern \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
r FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" missing from " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n
    createBinary :: CxxOutput -> Maybe a -> [CxxOutput] -> m (FilePath, FilePath)
createBinary (CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
_ Set Namespace
_ Set CategoryName
_ Set FilePath
_ [FilePath]
content) Maybe a
timeout [CxxOutput]
xx = do
      FilePath
dir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
mkdtemp FilePath
"/tmp/ztest_"
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Writing temporary files to " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir
      [([FilePath], CxxOutput)]
sources <- (CxxOutput -> m ([FilePath], CxxOutput))
-> [CxxOutput] -> m [([FilePath], CxxOutput)]
forall (m :: * -> *) a b.
CollectErrorsM m =>
(a -> m b) -> [a] -> m [b]
mapCompilerM (FilePath -> CxxOutput -> m ([FilePath], CxxOutput)
forall {m :: * -> *}.
(MonadIO m, ErrorContextM m) =>
FilePath -> CxxOutput -> m ([FilePath], CxxOutput)
writeSingleFile FilePath
dir) [CxxOutput]
xx
      let main :: FilePath
main   = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
f2
      let binary :: FilePath
binary = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"testcase"
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
main (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      let flags :: [FilePath]
flags = [CompileMetadata] -> [FilePath]
getLinkFlagsForDeps [CompileMetadata]
deps
      let paths' :: [FilePath]
paths' = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
fixPath (FilePath
dirFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
paths)
      let libraries :: [FilePath]
libraries = [CompileMetadata] -> [FilePath]
getLibrariesForDeps [CompileMetadata]
deps
      [(FilePath, Maybe FilePath)]
macro <- Maybe a -> m [(FilePath, Maybe FilePath)]
forall {a} {m :: * -> *}.
(Num a, Ord a, ErrorContextM m, Show a) =>
Maybe a -> m [(FilePath, Maybe FilePath)]
timeoutMacro Maybe a
timeout
      let command :: CxxCommand
command = FilePath
-> [FilePath]
-> [(FilePath, Maybe FilePath)]
-> FilePath
-> [FilePath]
-> [FilePath]
-> CxxCommand
CompileToBinary FilePath
main ([[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((([FilePath], CxxOutput) -> [FilePath])
-> [([FilePath], CxxOutput)] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath], CxxOutput) -> [FilePath]
forall a b. (a, b) -> a
fst [([FilePath], CxxOutput)]
sources) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
libraries) [(FilePath, Maybe FilePath)]
macro FilePath
binary [FilePath]
paths' [FilePath]
flags
      FilePath
file <- b -> CxxCommand -> m FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
b -> CxxCommand -> m FilePath
syncCxxCommand b
b CxxCommand
command
      (FilePath, FilePath) -> m (FilePath, FilePath)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir,FilePath
file)
    timeoutMacro :: Maybe a -> m [(FilePath, Maybe FilePath)]
timeoutMacro (Just a
0) = [(FilePath, Maybe FilePath)] -> m [(FilePath, Maybe FilePath)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []  -- No timeout.
    timeoutMacro Maybe a
Nothing  = [(FilePath, Maybe FilePath)] -> m [(FilePath, Maybe FilePath)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
testTimeoutMacro,FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"30")]  -- Default timeout.
    timeoutMacro (Just a
t)
      | a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
|| a
t a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
65535 = FilePath -> m [(FilePath, Maybe FilePath)]
forall a. FilePath -> m a
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM (FilePath -> m [(FilePath, Maybe FilePath)])
-> FilePath -> m [(FilePath, Maybe FilePath)]
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid testcase timeout " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
t FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" => use timeout 0 for unlimited time"
      | Bool
otherwise = [(FilePath, Maybe FilePath)] -> m [(FilePath, Maybe FilePath)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
testTimeoutMacro,FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (a -> FilePath
forall a. Show a => a -> FilePath
show a
t))]  -- Custom timeout.
    writeSingleFile :: FilePath -> CxxOutput -> m ([FilePath], CxxOutput)
writeSingleFile FilePath
d ca :: CxxOutput
ca@(CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
_ Set Namespace
_ Set CategoryName
_ Set FilePath
_ [FilePath]
content) = do
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, ErrorContextM m) => IO a -> m a
errorFromIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f2) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
content
      if FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
".cpp" FilePath
f2
         then ([FilePath], CxxOutput) -> m ([FilePath], CxxOutput)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f2],CxxOutput
ca)
         else ([FilePath], CxxOutput) -> m ([FilePath], CxxOutput)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],CxxOutput
ca)