{- -----------------------------------------------------------------------------
Copyright 2020 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 (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 -> LanguageModule SourceContext ->
  FilePath -> [FilePath] -> [CompileMetadata] -> (String,String) ->
  TrackedErrorsIO ((Int,Int),TrackedErrors ())
runSingleTest :: b
-> LanguageModule SourceContext
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> TrackedErrorsIO ((Int, Int), TrackedErrors ())
runSingleTest b
b LanguageModule SourceContext
cm FilePath
p [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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
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 :: * -> *).
(MonadIO m, ErrorContextM m) =>
IntegrationTest SourceContext -> m ((Int, Int), TrackedErrors ())
runSingle [IntegrationTest SourceContext]
ts'
          let passed :: Int
passed = [Int] -> Int
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 (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 (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
      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]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *) c.
MonadIO m =>
ExpectedResult c
-> [FilePath]
-> [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) (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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ((Int
passed,Int
failed),TrackedErrors ()
combined)

    run :: ExpectedResult c
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
run (ExpectCompilerError [c]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      let result :: TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result = [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     Identity
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *).
CollectErrorsM m =>
[FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then FilePath -> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Expected compilation failure"
         else (TrackedErrors () -> [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
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 (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
$ TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings TrackedErrorsT
  Identity
  ([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
$ TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerError TrackedErrorsT
  Identity
  ([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 [c]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      let result :: TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result = [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     Identity
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *).
CollectErrorsM m =>
[FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT
     m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result TrackedErrorsT
  m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrorsT m [TrackedErrors ()]
-> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TrackedErrors ()] -> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *) a. Monad m => a -> m a
return []
         else (TrackedErrors () -> [TrackedErrors ()])
-> TrackedErrorsT m (TrackedErrors ())
-> TrackedErrorsT m [TrackedErrors ()]
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 (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
$ TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> CompilerMessage
forall a. TrackedErrors a -> CompilerMessage
getCompilerWarnings TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> TrackedErrors ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines FilePath
warnings) [] []

    run (ExpectRuntimeError [c]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args [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 (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 (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Exactly one unittest is required when crash is expected"
      [TestProcedure SourceContext] -> TrackedErrorsT m ()
forall (m :: * -> *) a.
(CollectErrorsM m, Show a, Ord a) =>
[TestProcedure a] -> m ()
uniqueTestNames [TestProcedure SourceContext]
ts
      Bool
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Bool
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
False [OutputPattern]
rs [OutputPattern]
es [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts

    run (ExpectRuntimeSuccess [c]
_ [OutputPattern]
rs [OutputPattern]
es) [FilePath]
args [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 (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 (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
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT m [TrackedErrors ()]
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
Bool
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
True [OutputPattern]
rs [OutputPattern]
es [FilePath]
args [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
comp
                         then () -> TrackedErrors ()
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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
err
                        then () -> TrackedErrors ()
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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
out
                        then () -> TrackedErrors ()
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 (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 (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 (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
-> [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m [TrackedErrors ()]
execute Bool
s2 [OutputPattern]
rs [OutputPattern]
es [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts = do
      let result :: TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result = [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> TrackedErrorsT
     Identity
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall (m :: * -> *).
CollectErrorsM m =>
[FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll [FilePath]
args [AnyCategory SourceContext]
cs [DefinedCategory SourceContext]
ds [TestProcedure SourceContext]
ts
      if TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
forall (t :: (* -> *) -> * -> *) a.
(ErrorContextT t, ErrorContextM (t Identity)) =>
t Identity a -> Bool
isCompilerError TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
         then [TrackedErrors ()] -> m [TrackedErrors ()]
forall (m :: * -> *) a. Monad m => a -> m a
return [TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> TrackedErrors () -> TrackedErrors ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> TrackedErrors ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()]
         else do
           let ([CxxOutput]
xx,CxxOutput
main,[(FunctionName, [SourceContext])]
fs) = TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall a. TrackedErrors a -> a
getCompilerSuccess TrackedErrorsT
  Identity
  ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
result
           (FilePath
dir,FilePath
binaryName) <- CxxOutput -> [CxxOutput] -> m (FilePath, FilePath)
forall (m :: * -> *).
(MonadIO m, CollectErrorsM m) =>
CxxOutput -> [CxxOutput] -> m (FilePath, FilePath)
createBinary CxxOutput
main [CxxOutput]
xx
           [TrackedErrors ()]
results <- IO [TrackedErrors ()] -> m [TrackedErrors ()]
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)
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]
-> TrackedErrorsT
     Identity
     ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
-> Bool
-> (FunctionName, [SourceContext])
-> TrackedErrorsT IO ()
forall (m :: * -> *) a a a.
(MonadIO m, Show a, Show a) =>
FilePath
-> [OutputPattern]
-> [OutputPattern]
-> TrackedErrors a
-> Bool
-> (a, [a])
-> TrackedErrorsT m ()
executeTest FilePath
binaryName [OutputPattern]
rs [OutputPattern]
es TrackedErrorsT
  Identity
  ([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 (m :: * -> *) a. Monad m => a -> m a
return [TrackedErrors ()]
results

    executeTest :: FilePath
-> [OutputPattern]
-> [OutputPattern]
-> TrackedErrors a
-> Bool
-> (a, [a])
-> TrackedErrorsT m ()
executeTest FilePath
binary [OutputPattern]
rs [OutputPattern]
es TrackedErrors a
res Bool
s2 (a
f2,[a]
c) = TrackedErrorsT m () -> TrackedErrorsT m ()
forall (m :: * -> *) b. (CollectErrorsM m, MonadIO m) => m b -> m b
printOutcome (TrackedErrorsT m () -> TrackedErrorsT m ())
-> TrackedErrorsT m () -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ 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 FilePath -> TrackedErrorsT m () -> TrackedErrorsT m ()
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]
      (TestCommandResult Bool
s2' [FilePath]
out [FilePath]
err) <- b -> TestCommand -> TrackedErrorsT m TestCommandResult
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, ErrorContextM m) =>
b -> TestCommand -> m TestCommandResult
runTestCommand b
b TestCommand
command
      case (Bool
s2,Bool
s2') of
           (Bool
True,Bool
False) -> [TrackedErrorsT m ()] -> TrackedErrorsT m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ ([TrackedErrorsT m ()] -> TrackedErrorsT m ())
-> [TrackedErrorsT m ()] -> TrackedErrorsT m ()
forall a b. (a -> b) -> a -> b
$ (TrackedErrors a -> TrackedErrorsT m ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerError TrackedErrors a
res)TrackedErrorsT m ()
-> [TrackedErrorsT m ()] -> [TrackedErrorsT m ()]
forall a. a -> [a] -> [a]
:((FilePath -> TrackedErrorsT m ())
-> [FilePath] -> [TrackedErrorsT m ()]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> TrackedErrorsT m ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM ([FilePath] -> [TrackedErrorsT m ()])
-> [FilePath] -> [TrackedErrorsT m ()]
forall a b. (a -> b) -> a -> b
$ [FilePath]
err [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
out)
           (Bool
False,Bool
True) -> [TrackedErrorsT m ()] -> TrackedErrorsT m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CollectErrorsM m) =>
f (m a) -> m ()
collectAllM_ [FilePath -> TrackedErrorsT m ()
forall (m :: * -> *) a. ErrorContextM m => FilePath -> m a
compilerErrorM FilePath
"Expected runtime failure",
                                         TrackedErrors a -> TrackedErrorsT m ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m ()
asCompilerError TrackedErrors a
res TrackedErrorsT m () -> FilePath -> TrackedErrorsT m ()
forall (m :: * -> *) a. ErrorContextM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput from compiler:"]
           (Bool, Bool)
_ -> TrackedErrors () -> TrackedErrorsT m ()
forall (m :: * -> *) a.
Monad m =>
TrackedErrors a -> TrackedErrorsT m a
fromTrackedErrors (TrackedErrors () -> TrackedErrorsT m ())
-> TrackedErrors () -> TrackedErrorsT m ()
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
        printOutcome :: m b -> m b
printOutcome m b
outcome = do
          Bool
failed <- m b -> m Bool
forall (m :: * -> *) a. CollectErrorsM m => m a -> m Bool
isCompilerErrorM m b
outcome
          if Bool
failed
             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
"--- 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 ---"
             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
"--- 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 ---"
          m b
outcome

    compileAll :: [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
compileAll [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
      LanguageModule SourceContext
-> Namespace
-> [FilePath]
-> [AnyCategory SourceContext]
-> [DefinedCategory SourceContext]
-> [TestProcedure SourceContext]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [SourceContext])])
forall c (m :: * -> *).
(Ord c, Show c, CollectErrorsM m) =>
LanguageModule c
-> Namespace
-> [FilePath]
-> [AnyCategory c]
-> [DefinedCategory c]
-> [TestProcedure c]
-> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
compileTestsModule LanguageModule SourceContext
cm Namespace
ns1 [FilePath]
args [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 (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 (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 -> [CxxOutput] -> m (FilePath, FilePath)
createBinary (CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
_ Set Namespace
ns Set CategoryName
req [FilePath]
content) [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
      -- TODO: Cache CompileMetadata here for debugging failures.
      let sources' :: [ObjectFile]
sources' = [CompileMetadata]
-> FilePath
-> FilePath
-> [([FilePath], CxxOutput)]
-> [ObjectFile]
resolveObjectDeps [CompileMetadata]
deps FilePath
p FilePath
dir [([FilePath], CxxOutput)]
sources
      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 os :: [ObjectFile]
os  = [CompileMetadata] -> [ObjectFile]
getObjectFilesForDeps [CompileMetadata]
deps
      let ofr :: Set Namespace -> Set CategoryName -> [FilePath]
ofr = [ObjectFile] -> Set Namespace -> Set CategoryName -> [FilePath]
getObjectFileResolver ([ObjectFile]
sources' [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ [ObjectFile]
os)
      let os' :: [FilePath]
os' = Set Namespace -> Set CategoryName -> [FilePath]
ofr Set Namespace
ns Set CategoryName
req
      let command :: CxxCommand
command = FilePath
-> [FilePath] -> FilePath -> [FilePath] -> [FilePath] -> CxxCommand
CompileToBinary FilePath
main [FilePath]
os' FilePath
binary [FilePath]
paths' [FilePath]
flags
      FilePath
file <- b -> CxxCommand -> m FilePath
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, ErrorContextM m) =>
b -> CxxCommand -> m FilePath
runCxxCommand b
b CxxCommand
command
      (FilePath, FilePath) -> m (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir,FilePath
file)
    writeSingleFile :: FilePath -> CxxOutput -> m ([FilePath], CxxOutput)
writeSingleFile FilePath
d ca :: CxxOutput
ca@(CxxOutput Maybe CategoryName
_ FilePath
f2 Namespace
_ Set Namespace
_ Set CategoryName
_ [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 (m :: * -> *) a. Monad m => a -> m a
return ([FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
f2],CxxOutput
ca)
         else ([FilePath], CxxOutput) -> m ([FilePath], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],CxxOutput
ca)