{- -----------------------------------------------------------------------------
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 Data.List (isSuffixOf,nub)
import System.Directory
import System.IO
import System.Posix.Temp (mkdtemp)
import System.FilePath
import Text.Parsec
import Text.Regex.TDFA -- Not safe!

import Base.CompileError
import Base.CompileInfo
import Cli.Programs
import CompilerCxx.Category
import CompilerCxx.Naming
import Module.CompileMetadata
import Module.Paths
import Module.ProcessMetadata
import Parser.SourceFile
import Types.IntegrationTest
import Types.TypeCategory


runSingleTest :: CompilerBackend b => b -> LanguageModule SourcePos ->
  FilePath -> [FilePath] -> [CompileMetadata] -> (String,String) ->
  CompileInfoIO ((Int,Int),CompileInfo ())
runSingleTest :: b
-> LanguageModule SourcePos
-> FilePath
-> [FilePath]
-> [CompileMetadata]
-> (FilePath, FilePath)
-> CompileInfoIO ((Int, Int), CompileInfo ())
runSingleTest b
b LanguageModule SourcePos
cm FilePath
p [FilePath]
paths [CompileMetadata]
deps (FilePath
f,FilePath
s) = do
  IO () -> CompileInfoT IO ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoT IO ()) -> IO () -> CompileInfoT 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), CompileInfo ())
allResults <- CompileInfo ([Pragma SourcePos], [IntegrationTest SourcePos])
-> CompileInfoIO ((Int, Int), CompileInfo ())
forall (m :: * -> *) a.
(MonadIO m, CompileErrorM m) =>
CompileInfo (a, [IntegrationTest SourcePos])
-> m ((Int, Int), CompileInfo ())
checkAndRun ((FilePath, FilePath)
-> CompileInfo ([Pragma SourcePos], [IntegrationTest SourcePos])
forall (m :: * -> *).
CompileErrorM m =>
(FilePath, FilePath)
-> m ([Pragma SourcePos], [IntegrationTest SourcePos])
parseTestSource (FilePath
f,FilePath
s))
  ((Int, Int), CompileInfo ())
-> CompileInfoIO ((Int, Int), CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (((Int, Int), CompileInfo ())
 -> CompileInfoIO ((Int, Int), CompileInfo ()))
-> ((Int, Int), CompileInfo ())
-> CompileInfoIO ((Int, Int), CompileInfo ())
forall a b. (a -> b) -> a -> b
$ (CompileInfo () -> CompileInfo ())
-> ((Int, Int), CompileInfo ()) -> ((Int, Int), CompileInfo ())
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 -> CompileInfo () -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a -> m a
??>) ((Int, Int), CompileInfo ())
allResults where
    checkAndRun :: CompileInfo (a, [IntegrationTest SourcePos])
-> m ((Int, Int), CompileInfo ())
checkAndRun CompileInfo (a, [IntegrationTest SourcePos])
ts
      | CompileInfo (a, [IntegrationTest SourcePos]) -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo (a, [IntegrationTest SourcePos])
ts = do
        IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM 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), CompileInfo ()) -> m ((Int, Int), CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
0,Int
1),CompileInfo (a, [IntegrationTest SourcePos])
ts CompileInfo (a, [IntegrationTest SourcePos])
-> CompileInfo () -> CompileInfo ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CompileInfo ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      | Bool
otherwise = do
          let (a
_,[IntegrationTest SourcePos]
ts') = CompileInfo (a, [IntegrationTest SourcePos])
-> (a, [IntegrationTest SourcePos])
forall a. CompileInfo a -> a
getCompileSuccess CompileInfo (a, [IntegrationTest SourcePos])
ts
          [CompileInfo ()]
allResults <- [m (CompileInfo ())] -> m [CompileInfo ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m (CompileInfo ())] -> m [CompileInfo ()])
-> [m (CompileInfo ())] -> m [CompileInfo ()]
forall a b. (a -> b) -> a -> b
$ (IntegrationTest SourcePos -> m (CompileInfo ()))
-> [IntegrationTest SourcePos] -> [m (CompileInfo ())]
forall a b. (a -> b) -> [a] -> [b]
map IntegrationTest SourcePos -> m (CompileInfo ())
forall (m :: * -> *).
(MonadIO m, CompileErrorM m) =>
IntegrationTest SourcePos -> m (CompileInfo ())
runSingle [IntegrationTest SourcePos]
ts'
          let passed :: Int
passed = [CompileInfo ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CompileInfo ()] -> Int) -> [CompileInfo ()] -> Int
forall a b. (a -> b) -> a -> b
$ (CompileInfo () -> Bool) -> [CompileInfo ()] -> [CompileInfo ()]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (CompileInfo () -> Bool) -> CompileInfo () -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileInfo () -> Bool
forall a. CompileInfo a -> Bool
isCompileError) [CompileInfo ()]
allResults
          let failed :: Int
failed = [CompileInfo ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CompileInfo ()] -> Int) -> [CompileInfo ()] -> Int
forall a b. (a -> b) -> a -> b
$ (CompileInfo () -> Bool) -> [CompileInfo ()] -> [CompileInfo ()]
forall a. (a -> Bool) -> [a] -> [a]
filter CompileInfo () -> Bool
forall a. CompileInfo a -> Bool
isCompileError [CompileInfo ()]
allResults
          ((Int, Int), CompileInfo ()) -> m ((Int, Int), CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
passed,Int
failed),[CompileInfo ()] -> CompileInfo ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CompileErrorM m) =>
f (m a) -> m ()
collectAllM_ [CompileInfo ()]
allResults)
    runSingle :: IntegrationTest SourcePos -> m (CompileInfo ())
runSingle IntegrationTest SourcePos
t = do
      let name :: FilePath
name = FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IntegrationTestHeader SourcePos -> FilePath
forall c. IntegrationTestHeader c -> FilePath
ithTestName (IntegrationTest SourcePos -> IntegrationTestHeader SourcePos
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourcePos
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 = [SourcePos] -> FilePath
forall a. Show a => [a] -> FilePath
formatFullContextBrace (IntegrationTestHeader SourcePos -> [SourcePos]
forall c. IntegrationTestHeader c -> [c]
ithContext (IntegrationTestHeader SourcePos -> [SourcePos])
-> IntegrationTestHeader SourcePos -> [SourcePos]
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourcePos -> IntegrationTestHeader SourcePos
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourcePos
t)
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM 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 test " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" ***"
      CompileInfo ()
outcome <- (CompileInfo () -> CompileInfo ())
-> m (CompileInfo ()) -> m (CompileInfo ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath
"\nIn test \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IntegrationTestHeader SourcePos -> FilePath
forall c. IntegrationTestHeader c -> FilePath
ithTestName (IntegrationTest SourcePos -> IntegrationTestHeader SourcePos
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourcePos
t) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
context) FilePath -> CompileInfo () -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a -> m a
??>) (m (CompileInfo ()) -> m (CompileInfo ()))
-> m (CompileInfo ()) -> m (CompileInfo ())
forall a b. (a -> b) -> a -> b
$
                   ExpectedResult SourcePos
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
forall (m :: * -> *).
MonadIO m =>
ExpectedResult SourcePos
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
run (IntegrationTestHeader SourcePos -> ExpectedResult SourcePos
forall c. IntegrationTestHeader c -> ExpectedResult c
ithResult (IntegrationTestHeader SourcePos -> ExpectedResult SourcePos)
-> IntegrationTestHeader SourcePos -> ExpectedResult SourcePos
forall a b. (a -> b) -> a -> b
$ IntegrationTest SourcePos -> IntegrationTestHeader SourcePos
forall c. IntegrationTest c -> IntegrationTestHeader c
itHeader IntegrationTest SourcePos
t) (IntegrationTest SourcePos -> [AnyCategory SourcePos]
forall c. IntegrationTest c -> [AnyCategory c]
itCategory IntegrationTest SourcePos
t) (IntegrationTest SourcePos -> [DefinedCategory SourcePos]
forall c. IntegrationTest c -> [DefinedCategory c]
itDefinition IntegrationTest SourcePos
t)
      if CompileInfo () -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo ()
outcome
         then IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM 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
"*** Test " 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, CompileErrorM 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
"*** Test " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" passed ***"
      CompileInfo () -> m (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return CompileInfo ()
outcome

    run :: ExpectedResult SourcePos
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
run (ExpectCompileError [SourcePos]
_ [OutputPattern]
rs [OutputPattern]
es) [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds = do
      let result :: CompileInfoT Identity ([CxxOutput], CxxOutput)
result = Maybe (Expression SourcePos)
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> CompileInfoT Identity ([CxxOutput], CxxOutput)
forall (m :: * -> *).
CompileErrorM m =>
Maybe (Expression SourcePos)
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m ([CxxOutput], CxxOutput)
compileAll Maybe (Expression SourcePos)
forall a. Maybe a
Nothing [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CompileInfoT Identity ([CxxOutput], CxxOutput) -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfoT Identity ([CxxOutput], CxxOutput)
result
         then m (CompileInfo ())
forall a. HasCallStack => a
undefined  -- Should be caught in compileAll.
         else CompileInfo () -> m (CompileInfo ())
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileInfo () -> m (CompileInfo ()))
-> CompileInfo () -> m (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ do
           let warnings :: FilePath
warnings = CompileMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompileMessage -> FilePath) -> CompileMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ CompileInfoT Identity ([CxxOutput], CxxOutput) -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileWarnings CompileInfoT Identity ([CxxOutput], CxxOutput)
result
           let errors :: FilePath
errors   = CompileMessage -> FilePath
forall a. Show a => a -> FilePath
show (CompileMessage -> FilePath) -> CompileMessage -> FilePath
forall a b. (a -> b) -> a -> b
$ CompileInfoT Identity ([CxxOutput], CxxOutput) -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileError CompileInfoT Identity ([CxxOutput], CxxOutput)
result
           [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> CompileInfo ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines FilePath
warnings [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines FilePath
errors) [] []

    run (ExpectRuntimeError   [SourcePos]
_ Expression SourcePos
e [OutputPattern]
rs [OutputPattern]
es) [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds = Bool
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
forall (m :: * -> *).
MonadIO m =>
Bool
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
execute Bool
False Expression SourcePos
e [OutputPattern]
rs [OutputPattern]
es [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds
    run (ExpectRuntimeSuccess [SourcePos]
_ Expression SourcePos
e [OutputPattern]
rs [OutputPattern]
es) [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds = Bool
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
forall (m :: * -> *).
MonadIO m =>
Bool
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
execute Bool
True  Expression SourcePos
e [OutputPattern]
rs [OutputPattern]
es [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds

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

    execute :: Bool
-> Expression SourcePos
-> [OutputPattern]
-> [OutputPattern]
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m (CompileInfo ())
execute Bool
s2 Expression SourcePos
e [OutputPattern]
rs [OutputPattern]
es [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds = CompileInfoT m () -> m (CompileInfo ())
forall (m :: * -> *) a.
Monad m =>
CompileInfoT m a -> m (CompileInfo a)
toCompileInfo (CompileInfoT m () -> m (CompileInfo ()))
-> CompileInfoT m () -> m (CompileInfo ())
forall a b. (a -> b) -> a -> b
$ do
      let result :: CompileInfoT Identity ([CxxOutput], CxxOutput)
result = Maybe (Expression SourcePos)
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> CompileInfoT Identity ([CxxOutput], CxxOutput)
forall (m :: * -> *).
CompileErrorM m =>
Maybe (Expression SourcePos)
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m ([CxxOutput], CxxOutput)
compileAll (Expression SourcePos -> Maybe (Expression SourcePos)
forall a. a -> Maybe a
Just Expression SourcePos
e) [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds
      if CompileInfoT Identity ([CxxOutput], CxxOutput) -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfoT Identity ([CxxOutput], CxxOutput)
result
         then CompileInfoT Identity ([CxxOutput], CxxOutput)
-> CompileInfoT m ([CxxOutput], CxxOutput)
forall (m :: * -> *) a.
Monad m =>
CompileInfo a -> CompileInfoT m a
fromCompileInfo CompileInfoT Identity ([CxxOutput], CxxOutput)
result CompileInfoT m ([CxxOutput], CxxOutput)
-> CompileInfoT m () -> CompileInfoT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> CompileInfoT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         else do
           let warnings :: CompileMessage
warnings = CompileInfoT Identity ([CxxOutput], CxxOutput) -> CompileMessage
forall a. CompileInfo a -> CompileMessage
getCompileWarnings CompileInfoT Identity ([CxxOutput], CxxOutput)
result
           let ([CxxOutput]
xx,CxxOutput
main) = CompileInfoT Identity ([CxxOutput], CxxOutput)
-> ([CxxOutput], CxxOutput)
forall a. CompileInfo a -> a
getCompileSuccess CompileInfoT Identity ([CxxOutput], CxxOutput)
result
           (FilePath
dir,FilePath
binaryName) <- CxxOutput -> [CxxOutput] -> CompileInfoT m (FilePath, FilePath)
forall (m :: * -> *).
(MonadIO m, CompileErrorM m) =>
CxxOutput -> [CxxOutput] -> m (FilePath, FilePath)
createBinary CxxOutput
main [CxxOutput]
xx
           let command :: TestCommand
command = FilePath -> FilePath -> TestCommand
TestCommand FilePath
binaryName (FilePath -> FilePath
takeDirectory FilePath
binaryName)
           (TestCommandResult Bool
s2' [FilePath]
out [FilePath]
err) <- b -> TestCommand -> CompileInfoT m TestCommandResult
forall b (m :: * -> *).
(CompilerBackend b, MonadIO m, CompileErrorM m) =>
b -> TestCommand -> m TestCommandResult
runTestCommand b
b TestCommand
command
           case (Bool
s2,Bool
s2') of
                (Bool
True,Bool
False) -> [CompileInfoT m ()] -> CompileInfoT m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CompileErrorM m) =>
f (m a) -> m ()
collectAllM_ ([CompileInfoT m ()] -> CompileInfoT m ())
-> [CompileInfoT m ()] -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ (CompileInfoT Identity ([CxxOutput], CxxOutput) -> CompileInfoT m ()
forall (m :: * -> *) a.
Monad m =>
CompileInfo a -> CompileInfoT m ()
asCompileError CompileInfoT Identity ([CxxOutput], CxxOutput)
result)CompileInfoT m () -> [CompileInfoT m ()] -> [CompileInfoT m ()]
forall a. a -> [a] -> [a]
:((FilePath -> CompileInfoT m ())
-> [FilePath] -> [CompileInfoT m ()]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> CompileInfoT m ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM ([FilePath] -> [CompileInfoT m ()])
-> [FilePath] -> [CompileInfoT m ()]
forall a b. (a -> b) -> a -> b
$ [FilePath]
err [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
out)
                (Bool
False,Bool
True) ->
                  if CompileMessage -> Bool
isEmptyCompileMessage CompileMessage
warnings
                     then FilePath -> CompileInfoT m ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM FilePath
"Expected runtime failure"
                     else [CompileInfoT m ()] -> CompileInfoT m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, CompileErrorM m) =>
f (m a) -> m ()
collectAllM_ [FilePath -> CompileInfoT m ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM FilePath
"Expected runtime failure",
                                        CompileInfoT Identity ([CxxOutput], CxxOutput) -> CompileInfoT m ()
forall (m :: * -> *) a.
Monad m =>
CompileInfo a -> CompileInfoT m ()
asCompileError CompileInfoT Identity ([CxxOutput], CxxOutput)
result CompileInfoT m () -> FilePath -> CompileInfoT m ()
forall (m :: * -> *) a. CompileErrorM m => m a -> FilePath -> m a
<?? FilePath
"\nOutput from compiler:"]
                (Bool, Bool)
_ -> do
                  let result2 :: CompileInfo ()
result2 = [OutputPattern]
-> [OutputPattern]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> CompileInfo ()
checkContent [OutputPattern]
rs [OutputPattern]
es (FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ CompileMessage -> FilePath
forall a. Show a => a -> FilePath
show CompileMessage
warnings) [FilePath]
err [FilePath]
out
                  Bool -> CompileInfoT m () -> CompileInfoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CompileInfo () -> Bool
forall a. CompileInfo a -> Bool
isCompileError CompileInfo ()
result2) (CompileInfoT m () -> CompileInfoT m ())
-> CompileInfoT m () -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ IO () -> CompileInfoT m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM m) => IO a -> m a
errorFromIO (IO () -> CompileInfoT m ()) -> IO () -> CompileInfoT m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
dir
                  CompileInfo () -> CompileInfoT m ()
forall (m :: * -> *) a.
Monad m =>
CompileInfo a -> CompileInfoT m a
fromCompileInfo CompileInfo ()
result2

    compileAll :: Maybe (Expression SourcePos)
-> [AnyCategory SourcePos]
-> [DefinedCategory SourcePos]
-> m ([CxxOutput], CxxOutput)
compileAll Maybe (Expression SourcePos)
e [AnyCategory SourcePos]
cs [DefinedCategory SourcePos]
ds = 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 SourcePos]
cs' = (AnyCategory SourcePos -> AnyCategory SourcePos)
-> [AnyCategory SourcePos] -> [AnyCategory SourcePos]
forall a b. (a -> b) -> [a] -> [b]
map (Namespace -> AnyCategory SourcePos -> AnyCategory SourcePos
forall c. Namespace -> AnyCategory c -> AnyCategory c
setCategoryNamespace Namespace
ns1) [AnyCategory SourcePos]
cs
      let xs :: PrivateSource SourcePos
xs = PrivateSource :: forall c.
Namespace
-> Bool
-> [AnyCategory c]
-> [DefinedCategory c]
-> PrivateSource c
PrivateSource {
          psNamespace :: Namespace
psNamespace = Namespace
ns1,
          psTesting :: Bool
psTesting = Bool
True,
          psCategory :: [AnyCategory SourcePos]
psCategory = [AnyCategory SourcePos]
cs',
          psDefine :: [DefinedCategory SourcePos]
psDefine = [DefinedCategory SourcePos]
ds
        }
      [CxxOutput]
xx <- LanguageModule SourcePos
-> [PrivateSource SourcePos] -> m [CxxOutput]
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
compileLanguageModule LanguageModule SourcePos
cm [PrivateSource SourcePos
xs]
      CxxOutput
main <- case Maybe (Expression SourcePos)
e of
                   Just Expression SourcePos
e2 -> LanguageModule SourcePos
-> PrivateSource SourcePos -> Expression SourcePos -> m CxxOutput
forall c (m :: * -> *).
(Show c, CompileErrorM m) =>
LanguageModule c -> PrivateSource c -> Expression c -> m CxxOutput
compileTestMain LanguageModule SourcePos
cm PrivateSource SourcePos
xs Expression SourcePos
e2
                   Maybe (Expression SourcePos)
Nothing -> FilePath -> m CxxOutput
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM FilePath
""
      ([CxxOutput], CxxOutput) -> m ([CxxOutput], CxxOutput)
forall (m :: * -> *) a. Monad m => a -> m a
return ([CxxOutput]
xx,CxxOutput
main)

    checkRequired :: [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> CompileInfo ()
checkRequired [OutputPattern]
rs [FilePath]
comp [FilePath]
err [FilePath]
out = (OutputPattern -> CompileInfo ())
-> [OutputPattern] -> CompileInfo ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> CompileInfo ()
checkSubsetForRegex Bool
True  [FilePath]
comp [FilePath]
err [FilePath]
out) [OutputPattern]
rs
    checkExcluded :: [OutputPattern]
-> [FilePath] -> [FilePath] -> [FilePath] -> CompileInfo ()
checkExcluded [OutputPattern]
es [FilePath]
comp [FilePath]
err [FilePath]
out = (OutputPattern -> CompileInfo ())
-> [OutputPattern] -> CompileInfo ()
forall (m :: * -> *) a b.
CompileErrorM m =>
(a -> m b) -> [a] -> m ()
mapErrorsM_ (Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> CompileInfo ()
checkSubsetForRegex Bool
False [FilePath]
comp [FilePath]
err [FilePath]
out) [OutputPattern]
es
    checkSubsetForRegex :: Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> OutputPattern
-> CompileInfo ()
checkSubsetForRegex Bool
expected [FilePath]
comp [FilePath]
err [FilePath]
out (OutputPattern OutputScope
OutputAny FilePath
r) =
      Bool -> [FilePath] -> FilePath -> FilePath -> CompileInfo ()
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 -> CompileInfo ()
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 -> CompileInfo ()
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 -> CompileInfo ()
checkForRegex Bool
expected [FilePath]
out FilePath
r FilePath
"test stdout"
    checkForRegex :: Bool -> [String] -> String -> String -> CompileInfo ()
    checkForRegex :: Bool -> [FilePath] -> FilePath -> FilePath -> CompileInfo ()
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 -> CompileInfo () -> CompileInfo ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
found Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
expected) (CompileInfo () -> CompileInfo ())
-> CompileInfo () -> CompileInfo ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> CompileInfo ()) -> FilePath -> CompileInfo ()
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 -> CompileInfo () -> CompileInfo ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
found Bool -> Bool -> Bool
&& Bool
expected) (CompileInfo () -> CompileInfo ())
-> CompileInfo () -> CompileInfo ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CompileInfo ()
forall (m :: * -> *) a. CompileErrorM m => FilePath -> m a
compileErrorM (FilePath -> CompileInfo ()) -> FilePath -> CompileInfo ()
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
_ [Namespace]
ns [CategoryName]
req [FilePath]
content) [CxxOutput]
xx = do
      FilePath
dir <- IO FilePath -> m FilePath
forall (m :: * -> *) a. (MonadIO m, CompileErrorM 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, CompileErrorM 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.
CompileErrorM m =>
(a -> m b) -> [a] -> m [b]
mapErrorsM (FilePath -> CxxOutput -> m ([FilePath], CxxOutput)
forall (m :: * -> *).
(MonadIO m, CompileErrorM 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, CompileErrorM 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 :: [Namespace] -> [CategoryName] -> [FilePath]
ofr = [ObjectFile] -> [Namespace] -> [CategoryName] -> [FilePath]
getObjectFileResolver ([ObjectFile]
sources' [ObjectFile] -> [ObjectFile] -> [ObjectFile]
forall a. [a] -> [a] -> [a]
++ [ObjectFile]
os)
      let os' :: [FilePath]
os' = [Namespace] -> [CategoryName] -> [FilePath]
ofr [Namespace]
ns [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, CompileErrorM 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
_ [Namespace]
_ [CategoryName]
_ [FilePath]
content) = do
      IO () -> m ()
forall (m :: * -> *) a. (MonadIO m, CompileErrorM 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)