mirror of
https://github.com/anoma/juvix.git
synced 2024-12-28 10:04:49 +03:00
e0ae356cd7
Use `prettyString` instead of relying on `Show` instance for `Doc a` so that it is more consistent with `prettyText`.
104 lines
3.6 KiB
Haskell
104 lines
3.6 KiB
Haskell
module Tree.Eval.Base where
|
|
|
|
import Base
|
|
import Juvix.Compiler.Tree.Data.InfoTable
|
|
import Juvix.Compiler.Tree.Data.TransformationId
|
|
import Juvix.Compiler.Tree.Error
|
|
import Juvix.Compiler.Tree.Evaluator
|
|
import Juvix.Compiler.Tree.Language.Base
|
|
import Juvix.Compiler.Tree.Language.Value
|
|
import Juvix.Compiler.Tree.Pretty
|
|
import Juvix.Compiler.Tree.Transformation
|
|
import Juvix.Compiler.Tree.Translation.FromSource
|
|
import Juvix.Data.PPOutput
|
|
|
|
treeEvalAssertion ::
|
|
Path Abs File ->
|
|
Path Abs File ->
|
|
[TransformationId] ->
|
|
(InfoTable -> Assertion) ->
|
|
(String -> IO ()) ->
|
|
Assertion
|
|
treeEvalAssertion = treeEvalAssertionParam evalAssertion
|
|
|
|
treeEvalAssertionParam ::
|
|
(Handle -> Symbol -> InfoTable -> IO ()) ->
|
|
Path Abs File ->
|
|
Path Abs File ->
|
|
[TransformationId] ->
|
|
(InfoTable -> Assertion) ->
|
|
(String -> IO ()) ->
|
|
Assertion
|
|
treeEvalAssertionParam evalParam mainFile expectedFile trans testTrans step = do
|
|
step "Parse"
|
|
s <- readFile mainFile
|
|
case runParser mainFile s of
|
|
Left err -> assertFailure (prettyString err)
|
|
Right tab0 -> do
|
|
step "Validate"
|
|
case run $ runError @JuvixError $ applyTransformations [Validate] tab0 of
|
|
Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
|
|
Right tab1 -> do
|
|
unless (null trans) $
|
|
step "Transform"
|
|
case run $ runError @JuvixError $ applyTransformations trans tab1 of
|
|
Left err -> assertFailure (prettyString (fromJuvixError @GenericError err))
|
|
Right tab -> do
|
|
testTrans tab
|
|
case tab ^. infoMainFunction of
|
|
Just sym -> do
|
|
withTempDir'
|
|
( \dirPath -> do
|
|
let outputFile = dirPath <//> $(mkRelFile "out.out")
|
|
hout <- openFile (toFilePath outputFile) WriteMode
|
|
step "Evaluate"
|
|
evalParam hout sym tab
|
|
hClose hout
|
|
actualOutput <- readFile outputFile
|
|
step "Compare expected and actual program output"
|
|
expected <- readFile expectedFile
|
|
assertEqDiffText ("Check: RUN output = " <> toFilePath expectedFile) actualOutput expected
|
|
)
|
|
Nothing -> assertFailure "no 'main' function"
|
|
|
|
evalAssertion :: Handle -> Symbol -> InfoTable -> IO ()
|
|
evalAssertion hout sym tab = do
|
|
r' <- doEval hout tab (lookupFunInfo tab sym)
|
|
case r' of
|
|
Left err -> do
|
|
hClose hout
|
|
assertFailure (prettyString err)
|
|
Right value' -> do
|
|
case value' of
|
|
ValVoid -> return ()
|
|
_ -> hPutStrLn hout (ppPrint tab value')
|
|
|
|
doEval ::
|
|
Handle ->
|
|
InfoTable ->
|
|
FunctionInfo ->
|
|
IO (Either TreeError Value)
|
|
doEval hout tab funInfo = catchEvalErrorIO (hEvalIO stdin hout tab funInfo)
|
|
|
|
treeEvalErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
|
|
treeEvalErrorAssertion mainFile step = do
|
|
step "Parse"
|
|
s <- readFile mainFile
|
|
case runParser mainFile s of
|
|
Left err -> assertFailure (prettyString err)
|
|
Right tab ->
|
|
case tab ^. infoMainFunction of
|
|
Just sym -> do
|
|
withTempDir'
|
|
( \dirPath -> do
|
|
let outputFile = dirPath <//> $(mkRelFile "out.out")
|
|
hout <- openFile (toFilePath outputFile) WriteMode
|
|
step "Evaluate"
|
|
r' <- doEval hout tab (lookupFunInfo tab sym)
|
|
hClose hout
|
|
case r' of
|
|
Left _ -> assertBool "" True
|
|
Right _ -> assertFailure "no error"
|
|
)
|
|
Nothing -> assertFailure "no main function"
|