1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-25 16:45:20 +03:00
juvix/test/Base.hs
Jan Mas Rovira 4cdcb2f747
Add anoma nockma tests (#3134)
* Fixes a bug in calling Anoma stdlib from Nock code
* Runs the anoma compilation test with the anoma node nockma evaluator.

I've classified the tests in 4 categories:
1. `Working`. The test works as expected.
2. `Trace`. We need more work on our end to get the traces from the
anoma node and check that they match the expected result.
3. `NodeError`. The anoma node returns `failed to prove the nock
program`.
4. `Wrong`. The anoma node returns some value that does not match the
expected value.

---------

Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>
Co-authored-by: Łukasz Czajka <62751+lukaszcz@users.noreply.github.com>
Co-authored-by: Paul Cadman <git@paulcadman.dev>
2024-11-05 13:28:28 +00:00

214 lines
6.4 KiB
Haskell

module Base
( module Test.Tasty,
module Test.Tasty.HUnit,
module Juvix.Prelude,
module Base,
module Juvix.Extra.Paths,
module Juvix.Prelude.Env,
module Juvix.Compiler.Pipeline.Run,
module Juvix.Compiler.Pipeline.EntryPoint.IO,
)
where
import Control.Exception qualified as E
import Control.Monad.Extra as Monad
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import GHC.Generics qualified as GHC
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination
import Juvix.Compiler.Pipeline.EntryPoint.IO
import Juvix.Compiler.Pipeline.Loader.PathResolver
import Juvix.Compiler.Pipeline.Run
import Juvix.Data.Effect.TaggedLock
import Juvix.Extra.Paths hiding (rootBuildDir)
import Juvix.Prelude hiding (assert, readProcess)
import Juvix.Prelude.Env
import Juvix.Prelude.Pretty
import System.Process qualified as P
import Test.Tasty
import Test.Tasty.HUnit hiding (assertFailure, testCase)
import Test.Tasty.HUnit qualified as HUnit
data AssertionDescr
= Single Assertion
| Steps ((String -> IO ()) -> Assertion)
data TestDescr = TestDescr
{ _testName :: String,
_testRoot :: Path Abs Dir,
-- | relative to root
_testAssertion :: AssertionDescr
}
newtype WASMInfo = WASMInfo
{ _wasmInfoActual :: Path Abs File -> IO Text
}
makeLenses ''TestDescr
data StdlibMode
= StdlibInclude
| StdlibExclude
deriving stock (Show, Eq)
data CompileMode
= WASI StdlibMode
| WASM WASMInfo
mkTest :: TestDescr -> TestTree
mkTest TestDescr {..} = case _testAssertion of
Single assertion -> testCase _testName (withCurrentDir _testRoot assertion)
Steps steps -> testCaseSteps _testName (withCurrentDir _testRoot . steps)
withPrecondition :: Assertion -> IO TestTree -> IO TestTree
withPrecondition assertion ifSuccess = do
E.catch (assertion >> ifSuccess) $ \case
E.SomeException e -> return (testCase @String "Precondition failed" (assertFailure (show e)))
assertEqDiffText :: String -> Text -> Text -> Assertion
assertEqDiffText = assertEqDiff unpack
assertEqDiff :: (Eq a) => (a -> String) -> String -> a -> a -> Assertion
assertEqDiff show_ msg a b
| a == b = return ()
| otherwise = do
putStrLn (pack $ ppDiff (getGroupedDiff pa pb))
putStrLn "End diff"
Monad.fail msg
where
pa = lines $ show_ a
pb = lines $ show_ b
assertEqDiffShow :: (Eq a, Show a) => String -> a -> a -> Assertion
assertEqDiffShow = assertEqDiff show
assertCmdExists :: Path Rel File -> Assertion
assertCmdExists cmd =
assertBool ("Command: " <> toFilePath cmd <> " is not present on $PATH")
. isJust
=<< findExecutable cmd
testTaggedLockedToIO :: (MonadIO m) => Sem PipelineAppEffects a -> m a
testTaggedLockedToIO =
runM
. ignoreLogger
. runReader testPipelineOptions
. runTaggedLock LockModeExclusive
testRunIO ::
forall a m.
(MonadIO m) =>
EntryPoint ->
Sem (PipelineEff PipelineAppEffects) a ->
m (ResolverState, PipelineResult a)
testRunIO e =
testTaggedLockedToIO
. runIO defaultGenericOptions e
testDefaultEntryPointIO :: (MonadIO m) => Path Abs Dir -> Path Abs File -> m EntryPoint
testDefaultEntryPointIO cwd mainFile =
testTaggedLockedToIO $
defaultEntryPointIO cwd (Just mainFile)
testDefaultEntryPointNoFileIO :: Path Abs Dir -> IO EntryPoint
testDefaultEntryPointNoFileIO cwd = testTaggedLockedToIO (defaultEntryPointIO cwd Nothing)
testRunIOEither ::
EntryPoint ->
Sem (PipelineEff PipelineAppEffects) a ->
IO (Either JuvixError (ResolverState, PipelineResult a))
testRunIOEither entry =
testTaggedLockedToIO
. runIOEither entry
testRunIOEitherTermination ::
EntryPoint ->
Sem (Termination ': PipelineEff PipelineAppEffects) a ->
IO (Either JuvixError (ResolverState, PipelineResult a))
testRunIOEitherTermination entry =
testRunIOEither entry
. evalTermination iniTerminationState
assertFailure :: (MonadIO m) => String -> m a
assertFailure = liftIO . HUnit.assertFailure
runSimpleErrorHUnit :: (Members '[EmbedIO] r) => Sem (Error SimpleError ': r) a -> Sem r a
runSimpleErrorHUnit m = do
res <- runError m
case res of
Left (SimpleError msg) -> assertFailure (toPlainString msg)
Right r -> return r
wantsError ::
forall err b.
(Generic err, GenericHasConstructor (GHC.Rep err)) =>
(b -> err) ->
Path Abs File ->
err ->
Maybe String
wantsError wanted file actualErr
| genericSameConstructor wantedErr actualErr = Nothing
| otherwise =
Just
( "In "
<> prettyString file
<> "\nExpected "
<> genericConstructorName wantedErr
<> "\nFound "
<> genericConstructorName actualErr
)
where
wantedErr :: err
wantedErr = wanted impossible
-- | The same as `P.readProcess` but instead of inheriting `stderr` redirects it
-- to the child's `stdout`.
readProcess :: FilePath -> [String] -> Text -> IO Text
readProcess = readProcessCwd' Nothing Nothing
readProcessWithEnv :: [(String, String)] -> FilePath -> [String] -> Text -> IO Text
readProcessWithEnv env = readProcessCwd' (Just env) Nothing
readProcessCwd :: FilePath -> FilePath -> [String] -> Text -> IO Text
readProcessCwd cwd = readProcessCwd' Nothing (Just cwd)
readProcessCwd' :: Maybe [(String, String)] -> Maybe FilePath -> FilePath -> [String] -> Text -> IO Text
readProcessCwd' menv mcwd cmd args stdinText =
withTempDir'
( \dirPath -> do
(_, hin) <- openTempFile dirPath "stdin"
(_, hout) <- openTempFile dirPath "stdout"
hPutStr hin stdinText
hSeek hin AbsoluteSeek 0
(_, _, _, ph) <-
P.createProcess_
"readProcess"
(P.proc cmd args)
{ P.std_in = P.UseHandle hin,
P.std_out = P.UseHandle hout,
P.std_err = P.UseHandle hout,
P.cwd = mcwd,
P.env = menv
}
P.waitForProcess ph
hSeek hout AbsoluteSeek 0
r <- hGetContents hout
hClose hin
hClose hout
return r
)
to3DigitString :: Int -> Text
to3DigitString n
| n < 10 = "00" <> show n
| n < 100 = "0" <> show n
| n < 1000 = show n
| otherwise = error ("The given number has more than 3 digits. Given number = " <> prettyText n)
-- | E.g. Test001: str
numberedTestName :: Int -> Text -> Text
numberedTestName i str = "Test" <> to3DigitString i <> ": " <> str
testCase :: (HasTextBackend str) => str -> Assertion -> TestTree
testCase name = HUnit.testCase (toPlainString name)