diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f2142b9689..8e59af4636 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -119,6 +119,49 @@ jobs: path: main submodules: true + - name: Add ~/.local/bin to PATH + run: | + mkdir -p "$HOME/.local/bin" + echo "$HOME/.local/bin" >> $GITHUB_PATH + + - name: Set up Elixir + id: beam + uses: erlef/setup-beam@v1.18.2 + with: + elixir-version: "1.17.3" + otp-version: "27.1" + + - name: Install protoc + run: | + sudo apt install -y protobuf-compiler + protoc --version + + - name: Cache anoma + id: cache-anoma + uses: actions/cache@v3 + with: + path: | + ${{ env.HOME }}/anoma + key: "${{ runner.os }}-anoma" + + - name: Build anoma + if: steps.cache-anoma.outputs.cache-hit != 'true' + run: | + cd $HOME + git clone https://github.com/anoma/anoma.git + cd anoma + git checkout 98e3660b91cd55f1d9424dcff9420425ae98f5f8 + mix local.hex --force + mix escript.install hex protobuf --force + echo "$HOME/.mix/escripts" >> $GITHUB_PATH + mix deps.get + mix compile + mix do --app anoma_client escript.build + + - name: Install grpcurl + run: | + curl -sSL "https://github.com/fullstorydev/grpcurl/releases/download/v1.9.1/grpcurl_1.9.1_linux_x86_64.tar.gz" | tar -xz -C ~/.local/bin --no-wildcards grpcurl + - name: Cache LLVM and Clang id: cache-llvm uses: actions/cache@v3 @@ -146,10 +189,9 @@ jobs: run: | echo "WASI_SYSROOT_PATH=$GITHUB_WORKSPACE/wasi-sysroot" >> $GITHUB_ENV - - name: Add ~/.local/bin to PATH + - name: Set ANOMA_PATH run: | - mkdir -p "$HOME/.local/bin" - echo "$HOME/.local/bin" >> $GITHUB_PATH + echo "ANOMA_PATH=$HOME/anoma" >> $GITHUB_ENV - run: echo "HOME=$HOME" >> $GITHUB_ENV shell: bash diff --git a/app/Commands/Dev/Anoma/Node.hs b/app/Commands/Dev/Anoma/Node.hs index f885c82967..e6a41e59ef 100644 --- a/app/Commands/Dev/Anoma/Node.hs +++ b/app/Commands/Dev/Anoma/Node.hs @@ -11,4 +11,5 @@ runCommand opts = runAppError @SimpleError $ do anomaDir :: AnomaPath <- AnomaPath <$> fromAppPathDir (opts ^. nodeAnomaPath) runAnoma anomaDir $ do - void noHalt + p <- getAnomaProcesses + void (waitForProcess (p ^. anomaNodeHandle)) diff --git a/src/Anoma/Effect/Base.hs b/src/Anoma/Effect/Base.hs index f35781c1f6..bb1c5941fd 100644 --- a/src/Anoma/Effect/Base.hs +++ b/src/Anoma/Effect/Base.hs @@ -4,9 +4,12 @@ -- 2. grpcurl module Anoma.Effect.Base ( Anoma, - noHalt, + getAnomaProcesses, anomaRpc, AnomaPath (..), + AnomaProcesses (..), + anomaNodeHandle, + anomaClientHandle, anomaPath, runAnoma, module Anoma.Rpc.Base, @@ -23,13 +26,21 @@ import Juvix.Extra.Paths (anomaStartExs) import Juvix.Prelude import Juvix.Prelude.Aeson (Value, eitherDecodeStrict, encode) +data AnomaProcesses = AnomaProcesses + { _anomaNodeHandle :: ProcessHandle, + _anomaClientHandle :: ProcessHandle + } + +newtype ListenPort = ListenPort Int + data Anoma :: Effect where -- | Keep the node and client running - NoHalt :: Anoma m ExitCode + GetAnomaProcesses :: Anoma m AnomaProcesses -- | grpc call AnomaRpc :: GrpcMethodUrl -> Value -> Anoma m Value makeSem ''Anoma +makeLenses ''AnomaProcesses newtype AnomaPath = AnomaPath {_anomaPath :: Path Abs Dir} @@ -38,9 +49,6 @@ newtype GrpcPort = GrpcPort {_grpcPort :: Int} makeLenses ''AnomaPath makeLenses ''GrpcPort -listenPort :: Int -listenPort = 50051 - relativeToAnomaDir :: (Members '[Reader AnomaPath] r) => Path Rel x -> Sem r (Path Abs x) relativeToAnomaDir p = do anoma <- asks (^. anomaPath) @@ -48,18 +56,19 @@ relativeToAnomaDir p = do withSpawnAnomaClient :: (Members '[Process, Logger, EmbedIO, Reader AnomaPath, Reader GrpcPort, Error SimpleError] r) => - (ProcessHandle -> Sem r a) -> + (Int -> ProcessHandle -> Sem r a) -> Sem r a withSpawnAnomaClient body = do cprocess <- mkProcess withCreateProcess cprocess $ \_stdin mstdout _stderr procHandle -> do let out = fromJust mstdout txt <- hGetLine out - case takeWhile (/= '.') (unpack txt) of - "Connected to node" -> do + case span (/= '.') (unpack txt) of + ("Connected to node", rest) -> do + let port = readJust (last (nonEmpty' (words rest))) logInfo "Anoma client successfully started" - logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty listenPort))) - body procHandle + logInfo (mkAnsiText ("Listening on port " <> annotate AnnImportant (pretty port))) + body port procHandle _ -> throw (SimpleError (mkAnsiText @Text "Something went wrong when starting the anoma client")) where mkProcess :: (Members '[Reader AnomaPath, Reader GrpcPort] r') => Sem r' CreateProcess @@ -70,7 +79,7 @@ withSpawnAnomaClient body = do ( proc (toFilePath anomaClient) [ "--listen-port", - show listenPort, + "0", "--node-host", "localhost", "--node-port", @@ -106,7 +115,11 @@ withSpawnAnomaNode body = withSystemTempFile "start.exs" $ \fp tmpHandle -> do cwd = Just (toFilePath anomapath) } -anomaRpc' :: (Members '[Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) => GrpcMethodUrl -> Value -> Sem r Value +anomaRpc' :: + (Members '[Reader ListenPort, Reader AnomaPath, Process, EmbedIO, Error SimpleError] r) => + GrpcMethodUrl -> + Value -> + Sem r Value anomaRpc' method payload = do cproc <- grpcCliProcess method withCreateProcess cproc $ \mstdin mstdout _stderr _procHandle -> do @@ -120,9 +133,10 @@ anomaRpc' method payload = do Right r -> return r Left err -> throw (SimpleError (mkAnsiText err)) -grpcCliProcess :: (Members '[Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess +grpcCliProcess :: (Members '[Reader ListenPort, Reader AnomaPath] r) => GrpcMethodUrl -> Sem r CreateProcess grpcCliProcess method = do importPath <- relativeToAnomaDir relProtoDir + ListenPort listenPort <- ask return ( proc "grpcurl" @@ -141,11 +155,22 @@ grpcCliProcess method = do std_out = CreatePipe } +-- | Assumes the node and client are already running +-- runAnomaTest :: forall r a. (Members '[Reader ListenPort, Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a +-- runAnomaTest anomapath body = runReader anomapath . runProcess $ +-- (`interpret` inject body) $ \case +-- GetAnomaProcesses -> error "unsupported" +-- AnomaRpc method i -> anomaRpc' method i runAnoma :: forall r a. (Members '[Logger, EmbedIO, Error SimpleError] r) => AnomaPath -> Sem (Anoma ': r) a -> Sem r a -runAnoma anomapath body = runReader anomapath . runConcurrent . runProcess $ +runAnoma anomapath body = runReader anomapath . runProcess $ withSpawnAnomaNode $ \grpcport _nodeOut nodeH -> runReader (GrpcPort grpcport) $ - withSpawnAnomaClient $ \_clientH -> do + withSpawnAnomaClient $ \listenPort clientH -> runReader (ListenPort listenPort) $ do (`interpret` inject body) $ \case - NoHalt -> waitForProcess nodeH + GetAnomaProcesses -> + return + AnomaProcesses + { _anomaNodeHandle = nodeH, + _anomaClientHandle = clientH + } AnomaRpc method i -> anomaRpc' method i diff --git a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs index c486dc99fd..ca00a4b988 100644 --- a/src/Juvix/Compiler/Nockma/Translation/FromTree.hs +++ b/src/Juvix/Compiler/Nockma/Translation/FromTree.hs @@ -885,9 +885,8 @@ callAnomaLib fun args = do let ref = AnomaLibFunction fun fPath = anomaLibPath ref getFunCode = opAddress "callStdlibFunCode" stdpath >># fPath - argsPath <- stackPath ArgsTuple let adjustArgs = case nonEmpty args of - Just args' -> opReplace "callStdlib-args" argsPath ((opAddress "stdlibR" [R]) >># foldTerms args') (opAddress "stdlibL" [L]) + Just args' -> opReplace "callStdlib-args" [R, L] ((opAddress "stdlibR" [R]) >># foldTerms args') (opAddress "stdlibL" [L]) Nothing -> opAddress "adjustArgsNothing" [L] callFn = opCall "callStdlib" (closurePath FunCode) adjustArgs meta = diff --git a/src/Juvix/Data/Error/GenericError.hs b/src/Juvix/Data/Error/GenericError.hs index 7dac8376e9..ef11cd05db 100644 --- a/src/Juvix/Data/Error/GenericError.hs +++ b/src/Juvix/Data/Error/GenericError.hs @@ -120,3 +120,10 @@ runErrorIO' :: Sem (Error a ': r) b -> Sem r b runErrorIO' = runReader defaultGenericOptions . runErrorIO . raiseUnder + +runSimpleErrorIO :: (Members '[EmbedIO] r) => Sem (Error SimpleError ': r) a -> Sem r a +runSimpleErrorIO m = do + res <- runError m + case res of + Left (SimpleError msg) -> hRenderIO True stderr msg >> exitFailure + Right r -> return r diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 2698916a26..37d0fbf0dc 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -146,6 +146,7 @@ import Data.Int import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap import Data.IntSet (IntSet) +import Data.IntSet qualified as IntSet import Data.Kind qualified as GHC import Data.List.Extra hiding (allSame, foldr1, groupSortOn, head, last, mconcatMap, replicate, unzip) import Data.List.Extra qualified as List @@ -729,6 +730,9 @@ uncurryF g input_ = uncurry g <$> input_ intMapToList :: IntMap a -> [Indexed a] intMapToList = map (uncurry Indexed) . IntMap.toList +intSet :: (Foldable f) => f (Int) -> IntSet +intSet = IntSet.fromList . toList + intMap :: (Foldable f) => f (Int, a) -> IntMap a intMap = IntMap.fromList . toList diff --git a/src/Juvix/Prelude/Env.hs b/src/Juvix/Prelude/Env.hs index 29927f39fc..e0b6968361 100644 --- a/src/Juvix/Prelude/Env.hs +++ b/src/Juvix/Prelude/Env.hs @@ -7,15 +7,18 @@ import System.Environment -- | Environment variables relevant to Juvix data EnvVar = EnvWasiSysrootPath + | EnvAnomaPath deriving stock (Show, Eq) envVarString :: EnvVar -> String envVarString = \case EnvWasiSysrootPath -> "WASI_SYSROOT_PATH" + EnvAnomaPath -> "ANOMA_PATH" envVarHint :: EnvVar -> Maybe String envVarHint = \case - EnvWasiSysrootPath -> Just "Set to the location of the wasi-clib sysroot" + EnvWasiSysrootPath -> Just "It should point to the location of the wasi-clib sysroot" + EnvAnomaPath -> Just "It should point to the location of the Anoma repository" getEnvVar :: (MonadIO m) => EnvVar -> m String getEnvVar var = fromMaybeM (error (pack msg)) (liftIO (lookupEnv (envVarString var))) @@ -23,6 +26,9 @@ getEnvVar var = fromMaybeM (error (pack msg)) (liftIO (lookupEnv (envVarString v msg :: String msg = "Missing environment variable " <> envVarString var <> maybe "" (". " <>) (envVarHint var) +getAnomaPathAbs :: (MonadIO m) => m (Path Abs Dir) +getAnomaPathAbs = absDir <$> getEnvVar EnvAnomaPath + getWasiSysrootPathStr :: (MonadIO m) => m String getWasiSysrootPathStr = getEnvVar EnvWasiSysrootPath diff --git a/test/Anoma/Compilation/Positive.hs b/test/Anoma/Compilation/Positive.hs index 7e8aaca619..00dff59858 100644 --- a/test/Anoma/Compilation/Positive.hs +++ b/test/Anoma/Compilation/Positive.hs @@ -1,7 +1,8 @@ -module Anoma.Compilation.Positive where +module Anoma.Compilation.Positive (allTests) where +import Anoma.Effect.Base +import Anoma.Effect.RunNockma import Base -import Data.HashMap.Strict qualified as HashMap import Juvix.Compiler.Backend (Target (TargetAnoma)) import Juvix.Compiler.Nockma.Anoma import Juvix.Compiler.Nockma.Evaluator @@ -9,42 +10,121 @@ import Juvix.Compiler.Nockma.Language import Juvix.Compiler.Nockma.Translation.FromSource.QQ import Juvix.Compiler.Nockma.Translation.FromTree import Juvix.Prelude qualified as Prelude -import Nockma.Eval.Positive +import Nockma.Eval.Positive (Check, Test (..), eqNock, eqTraces) +import Nockma.Eval.Positive qualified as NockmaEval + +data AnomaTest = AnomaTest + { _anomaEnableDebug :: Bool, + _anomaProgramStorage :: Storage Natural, + _anomaTestNum :: Int, + _anomaTestTag :: Text, + _anomaRelRoot :: Prelude.Path Rel Dir, + _anomaMainFile :: Prelude.Path Rel File, + _anomaArgs :: [Term Natural], + _anomaCheck :: Check () + } root :: Prelude.Path Abs Dir root = relToProject $(mkRelDir "tests/Anoma/Compilation/positive") -mkAnomaCallTest' :: Bool -> Storage Natural -> Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree -mkAnomaCallTest' enableDebug _testProgramStorage _testName relRoot mainFile args _testCheck = - testCase (unpack _testName) (mkTestIO >>= mkNockmaAssertion) +anomaTestName :: AnomaTest -> Text +anomaTestName AnomaTest {..} = numberedTestName _anomaTestNum _anomaTestTag + +fromAnomaTest :: AnomaTest -> TestTree +fromAnomaTest a@AnomaTest {..} = + testCase testname (mkTestIO >>= NockmaEval.mkNockmaAssertion) where + testname :: Text + testname = anomaTestName a + mkTestIO :: IO Test mkTestIO = do - anomaRes <- withRootCopy compileMain - let _testProgramFormula = anomaCall args + anomaRes <- withRootCopy (compileMain _anomaEnableDebug _anomaRelRoot _anomaMainFile) + let _testProgramFormula = anomaCall (map (opQuote "Quote arg") _anomaArgs) _testProgramSubject = anomaRes ^. anomaClosure _testEvalOptions = defaultEvalOptions _testAssertEvalError :: Maybe (NockEvalError Natural -> Assertion) = Nothing - return Test {..} + return + Test + { _testName = testname, + _testCheck = _anomaCheck, + _testProgramStorage = _anomaProgramStorage, + .. + } + +mkAnomaTest' :: + Bool -> + Storage Natural -> + Int -> + Text -> + Prelude.Path Rel Dir -> + Prelude.Path Rel File -> + [Term Natural] -> + Check () -> + AnomaTest +mkAnomaTest' _anomaEnableDebug _anomaProgramStorage _anomaTestNum _anomaTestTag _anomaRelRoot _anomaMainFile _anomaArgs _anomaCheck = + AnomaTest + { .. + } + +envAnomaPath :: (MonadIO m) => m AnomaPath +envAnomaPath = AnomaPath <$> getAnomaPathAbs - withRootCopy :: (Prelude.Path Abs Dir -> IO a) -> IO a - withRootCopy action = withSystemTempDir "test" $ \tmpRootDir -> do - copyDirRecur root tmpRootDir - action tmpRootDir +mkAnomaNodeTest :: AnomaTest -> TestTree +mkAnomaNodeTest a@AnomaTest {..} = + testCase (anomaTestName a) assertion + where + assertion :: Assertion + assertion = do + program :: Term Natural <- (^. anomaClosure) <$> withRootCopy (compileMain False _anomaRelRoot _anomaMainFile) + -- For some reason the evaluation fails if no args are given + let args' + | null _anomaArgs = [toNock (nockVoid @Natural)] + | otherwise = _anomaArgs + testAnomaPath <- envAnomaPath + runM + . ignoreLogger + . runSimpleErrorHUnit + . runAnoma testAnomaPath + $ do + out <- runNockma program args' + runM + . runReader out + . runReader [] + $ _anomaCheck + +withRootCopy :: (Prelude.Path Abs Dir -> IO a) -> IO a +withRootCopy action = withSystemTempDir "test" $ \tmpRootDir -> do + copyDirRecur root tmpRootDir + action tmpRootDir - compileMain :: Prelude.Path Abs Dir -> IO AnomaResult - compileMain rootCopyDir = do - let testRootDir = rootCopyDir relRoot - entryPoint <- - set entryPointTarget (Just TargetAnoma) . set entryPointDebug enableDebug - <$> testDefaultEntryPointIO testRootDir (testRootDir mainFile) - (^. pipelineResult) . snd <$> testRunIO entryPoint upToAnoma +compileMain :: Bool -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> Prelude.Path Abs Dir -> IO AnomaResult +compileMain enableDebug relRoot mainFile rootCopyDir = do + let testRootDir = rootCopyDir relRoot + entryPoint <- + set entryPointTarget (Just TargetAnoma) . set entryPointDebug enableDebug + <$> testDefaultEntryPointIO testRootDir (testRootDir mainFile) + (^. pipelineResult) . snd <$> testRunIO entryPoint upToAnoma -mkAnomaCallTestNoDebug :: Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree -mkAnomaCallTestNoDebug = mkAnomaCallTest' False emptyStorage +mkAnomaTestNoDebug :: + Int -> + Text -> + Prelude.Path Rel Dir -> + Prelude.Path Rel File -> + [Term Natural] -> + Check () -> + AnomaTest +mkAnomaTestNoDebug = mkAnomaTest' False emptyStorage -mkAnomaCallTest :: Text -> Prelude.Path Rel Dir -> Prelude.Path Rel File -> [Term Natural] -> Check () -> TestTree -mkAnomaCallTest = mkAnomaCallTest' True emptyStorage +mkAnomaTest :: + Int -> + Text -> + Prelude.Path Rel Dir -> + Prelude.Path Rel File -> + [Term Natural] -> + Check () -> + AnomaTest +mkAnomaTest = mkAnomaTest' True emptyStorage checkNatOutput :: [Natural] -> Check () checkNatOutput = checkOutput . fmap toNock @@ -56,627 +136,840 @@ checkOutput expected = case unsnoc expected of eqTraces xs eqNock x +data TestClass + = ClassWorking + | -- | The test uses trace, so we need to wait until we update the anoma-node + -- and parse the traces from the response + ClassTrace + | -- | The anoma node returns a response with an error + ClassNodeError + | -- | The anoma node returns a value but it doesn't match the expected value + ClassWrong + | -- | We have no test with this number + ClassMissing + deriving stock (Eq, Show) + +classify :: AnomaTest -> TestClass +classify AnomaTest {..} = case _anomaTestNum of + 1 -> ClassWorking + 2 -> ClassWorking + 3 -> ClassTrace + 4 -> ClassMissing + 5 -> ClassWorking + 6 -> ClassTrace + 7 -> ClassTrace + 8 -> ClassWorking + 9 -> ClassTrace + 10 -> ClassWorking + 11 -> ClassTrace + 12 -> ClassTrace + 13 -> ClassTrace + 14 -> ClassTrace + 15 -> ClassTrace + 16 -> ClassWorking + 17 -> ClassWorking + 18 -> ClassWorking + 19 -> ClassWorking + 20 -> ClassTrace + 21 -> ClassTrace + 22 -> ClassTrace + 23 -> ClassTrace + 24 -> ClassWorking + 25 -> ClassTrace + 26 -> ClassWorking + 27 -> ClassMissing + 28 -> ClassTrace + 29 -> ClassTrace + 30 -> ClassTrace + 31 -> ClassWorking + 32 -> ClassTrace + 33 -> ClassTrace + 34 -> ClassTrace + 35 -> ClassTrace + 36 -> ClassWorking + 37 -> ClassWorking + 38 -> ClassWorking + 39 -> ClassTrace + 40 -> ClassWorking + 41 -> ClassWorking + 42 -> ClassMissing + 43 -> ClassTrace + 45 -> ClassWorking + 46 -> ClassWorking + 47 -> ClassWorking + 48 -> ClassMissing + 49 -> ClassTrace + 50 -> ClassWorking + 51 -> ClassMissing + 52 -> ClassWorking + 53 -> ClassWorking + 54 -> ClassWorking + 55 -> ClassWorking + 56 -> ClassWorking + 57 -> ClassWorking + 58 -> ClassWorking + 59 -> ClassWorking + 60 -> ClassWorking + 61 -> ClassTrace + 62 -> ClassWorking + 63 -> ClassTrace + 64 -> ClassWorking + 65 -> ClassWorking + 66 -> ClassWorking + 67 -> ClassWorking + 68 -> ClassWorking + 69 -> ClassWorking + 70 -> ClassWorking + 71 -> ClassWorking + 72 -> ClassWorking + 73 -> ClassWorking + 74 -> ClassTrace + 75 -> ClassTrace + 76 -> ClassTrace + 77 -> ClassNodeError + 78 -> ClassNodeError + 79 -> ClassWorking + 80 -> ClassTrace + 81 -> ClassTrace + 82 -> ClassTrace + 83 -> ClassTrace + 84 -> ClassTrace + 85 -> ClassTrace + 86 -> ClassTrace + _ -> error "non-exhaustive test classification" + allTests :: TestTree allTests = testGroup "Anoma positive tests" - [ mkAnomaCallTest - "Test001: Arithmetic operators" - $(mkRelDir ".") - $(mkRelFile "test001.juvix") - [nockNatLiteral 5] - (checkNatOutput [11]), - mkAnomaCallTest - "Test002: Arithmetic operators inside lambdas" - $(mkRelDir ".") - $(mkRelFile "test002.juvix") - [nockNatLiteral 2] - (checkNatOutput [11]), - mkAnomaCallTest - "Test003: Integer arithmetic" - $(mkRelDir ".") - $(mkRelFile "test003.juvix") - [] - (checkNatOutput [1, 4, 2, 4, 0]), - mkAnomaCallTestNoDebug - "Test003: Integer arithmetic - no debug" - $(mkRelDir ".") - $(mkRelFile "test003.juvix") - [] - (checkNatOutput [1, 4, 2, 4, 0]), - mkAnomaCallTest - "Test005: Higher-order functions" - $(mkRelDir ".") - $(mkRelFile "test005.juvix") - [nockNatLiteral 1] - (checkNatOutput [6]), - mkAnomaCallTest - "Test006: If-then-else and lazy boolean operators" - $(mkRelDir ".") - $(mkRelFile "test006.juvix") - [] - (checkOutput [[nock| 2 |], [nock| true |], [nock| false |]]), - mkAnomaCallTest - "Test007: Pattern matching and lambda-case" - $(mkRelDir ".") - $(mkRelFile "test007.juvix") - [] - $ do - let l :: Term Natural = [nock| [1 2 nil] |] - checkOutput [[nock| false |], [nock| true |], [nock| 0 |], [nock| [1 nil] |], [nock| 1 |], l, l], - mkAnomaCallTest - "Test008: Recursion" - $(mkRelDir ".") - $(mkRelFile "test008.juvix") - [nockNatLiteral 1000] - (eqNock [nock| 500500 |]), - mkAnomaCallTest - "Test009: Tail recursion" - $(mkRelDir ".") - $(mkRelFile "test009.juvix") - [nockNatLiteral 1000] - $ checkNatOutput [500500, 120, 3628800, 479001600], - mkAnomaCallTest - "Test010: Let" - $(mkRelDir ".") - $(mkRelFile "test010.juvix") - [] - (checkNatOutput [32]), - mkAnomaCallTest - "Test011: Tail recursion: Fibonacci numbers in linear time" - $(mkRelDir ".") - $(mkRelFile "test011.juvix") - [] - $ do - let fib10 :: Natural = 55 - fib100 :: Natural = 354224848179261915075 - fib1000 :: Natural = 43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875 - checkNatOutput [fib10, fib100, fib1000], - mkAnomaCallTest - "Test012: Trees" - $(mkRelDir ".") - $(mkRelFile "test012.juvix") - [nockNatLiteral 1000] - $ checkNatOutput - [ 13200200200, - 21320020020013200200200, - 3213200200200132002002002132002002001320020020021320020020013200200200, - 13213200200200132002002002132002002001320020020021320020020013200200200, - 21321320020020013200200200213200200200132002002002132002002001320020020013213200200200132002002002132002002001320020020021320020020013200200200 - ], - mkAnomaCallTest - "Test013: Functions returning functions with variable capture" - $(mkRelDir ".") - $(mkRelFile "test013.juvix") - [] - $ checkNatOutput [1, 0, 2, 5], - mkAnomaCallTest - "Test014: Arithmetic" - $(mkRelDir ".") - $(mkRelFile "test014.juvix") - [] - $ checkNatOutput [7, 17, 37, 31], - mkAnomaCallTest - "Test015: Local functions with free variables" - $(mkRelDir ".") - $(mkRelFile "test015.juvix") - [] - $ checkNatOutput [600, 25, 30, 45, 55, 16], - mkAnomaCallTest - "Test016: Recursion through higher-order functions" - $(mkRelDir ".") - $(mkRelFile "test016.juvix") - [] - $ checkNatOutput [55], - mkAnomaCallTest - "Test017: Tail recursion through higher-order functions" - $(mkRelDir ".") - $(mkRelFile "test017.juvix") - [nockNatLiteral 1000] - $ checkNatOutput [500500], - mkAnomaCallTest - "Test018: Higher-order functions and recursion" - $(mkRelDir ".") - $(mkRelFile "test018.juvix") - [] - $ checkNatOutput [11], - mkAnomaCallTest - "Test019: Self-application" - $(mkRelDir ".") - $(mkRelFile "test019.juvix") - [] - $ checkNatOutput [7], - mkAnomaCallTest - "Test020: Recursive functions: McCarthy's 91 function, subtraction by increments" - $(mkRelDir ".") - $(mkRelFile "test020.juvix") - [] - $ checkNatOutput [91, 91, 91, 91, 100, 6, 6, 400, 4000], - mkAnomaCallTest - "Test021: Fast exponentiation" - $(mkRelDir ".") - $(mkRelFile "test021.juvix") - [] - $ checkNatOutput [8, 2187, 48828125], - mkAnomaCallTest - "Test022: Lists" - $(mkRelDir ".") - $(mkRelFile "test022.juvix") - [nockNatLiteral 1000] - $ checkOutput - [ [nock| [10 9 8 7 6 5 4 3 2 1 nil] |], - [nock| [1 2 3 4 5 6 7 8 9 10 nil] |], - [nock| [10 9 8 7 6 nil] |], - [nock| [0 1 2 3 4 5 6 7 8 9 nil] |], - [nock| 500500 |], - [nock| 500500 |] - ], - mkAnomaCallTest - "Test023: Mutual recursion" - $(mkRelDir ".") - $(mkRelFile "test023.juvix") - [] - $ checkNatOutput [32, 869, 6385109], - mkAnomaCallTest - "Test024: Nested binders with variable capture" - $(mkRelDir ".") - $(mkRelFile "test024.juvix") - [] - $ checkNatOutput [6688], - mkAnomaCallTest - "Test025: Euclid's algorithm" - $(mkRelDir ".") - $(mkRelFile "test025.juvix") - [] - $ checkNatOutput [14, 70, 1, 1, 1], - mkAnomaCallTest - "Test026: Functional queues" - $(mkRelDir ".") - $(mkRelFile "test026.juvix") - [] - $ checkOutput [makeList (toNock @Natural <$> [1 .. 100])], - -- TODO allow lambda branches of different number of patterns - -- mkAnomaCallTest - -- "Test027: Church numerals" - -- $(mkRelDir ".") - -- $(mkRelFile "test027.juvix") - -- [] - -- $ checkNatOutput [7, 10, 21], - mkAnomaCallTest - "Test028: Streams without memoization" - $(mkRelDir ".") - $(mkRelFile "test028.juvix") - [nockNatLiteral 10, nockNatLiteral 50] - $ checkNatOutput [31, 233], - mkAnomaCallTest - "Test029: Ackermann function" - $(mkRelDir ".") - $(mkRelFile "test029.juvix") - [] - $ checkNatOutput [8, 9, 15, 17, 29], - mkAnomaCallTest - "Test030: Ackermann function (higher-order definition)" - $(mkRelDir ".") - $(mkRelFile "test030.juvix") - [] - $ checkNatOutput [10, 21, 2187, 15], - mkAnomaCallTest - "Test031: Nested lists" - $(mkRelDir ".") - $(mkRelFile "test031.juvix") - [] - $ checkOutput [[nock| [4 3 2 1 3 2 1 2 1 1 nil ] |]], - mkAnomaCallTest - "Test032: Merge sort" - $(mkRelDir ".") - $(mkRelFile "test032.juvix") - [] - $ do - let l = makeList (toNock @Natural <$> [2 .. 11]) - checkOutput [l, l, l], - mkAnomaCallTest - "Test033: Eta-expansion of builtins and constructors" - $(mkRelDir ".") - $(mkRelFile "test033.juvix") - [] - $ checkOutput - [ [nock| 9 |], - [nock| [7 2] |], - [nock| 5 |], - [nock| [3 2] |], - [nock| [1 2] |] - ], - mkAnomaCallTest - "Test034: Recursive let" - $(mkRelDir ".") - $(mkRelFile "test034.juvix") - [] - $ checkNatOutput [500500, 32, 869, 41, 85], - mkAnomaCallTest - "Test035: Pattern matching" - $(mkRelDir ".") - $(mkRelFile "test035.juvix") - [] - $ checkOutput - [ [nock| [9 7 5 3 1 nil] |], - [nock| 300 |], - [nock| 4160 |], - [nock| 2336 |], - [nock| 1 |], - [nock| 0 |] - ], - mkAnomaCallTest - "Test036: Eta-expansion" - $(mkRelDir ".") - $(mkRelFile "test036.juvix") - [] - $ checkNatOutput [18], - mkAnomaCallTest - "Test037: Applications with lets and cases in function position" - $(mkRelDir ".") - $(mkRelFile "test037.juvix") - [] - $ checkNatOutput [9], - mkAnomaCallTest - "Test038: Simple case expression" - $(mkRelDir ".") - $(mkRelFile "test038.juvix") - [] - $ checkNatOutput [1], - mkAnomaCallTest - "Test039: Mutually recursive let expression" - $(mkRelDir ".") - $(mkRelFile "test039.juvix") - [] - $ checkOutput [[nock| false |], [nock| true |]], - mkAnomaCallTest - "Test040: Pattern matching nullary constructor" - $(mkRelDir ".") - $(mkRelFile "test040.juvix") - [] - $ checkOutput [[nock| true |]], - mkAnomaCallTest - "Test041: Use a builtin inductive in an inductive constructor" - $(mkRelDir ".") - $(mkRelFile "test041.juvix") - [] - $ checkNatOutput [6], - mkAnomaCallTest - "Test043: Builtin trace" - $(mkRelDir ".") - $(mkRelFile "test043.juvix") - [] - $ checkNatOutput [0, 1], - mkAnomaCallTest - "Test046: Polymorphic type arguments" - $(mkRelDir ".") - $(mkRelFile "test046.juvix") - [] - $ checkNatOutput [7], - mkAnomaCallTest - "Test047: Local Modules" - $(mkRelDir ".") - $(mkRelFile "test047.juvix") - [] - $ checkNatOutput [660], - mkAnomaCallTest - "Test049: Builtin Int" - $(mkRelDir ".") - $(mkRelFile "test049.juvix") - [] - $ checkOutput - [ [nock| 1 |], - [nock| 1 |], - [nock| 0 |], - [nock| 1|], - [nock| 1 |], - [nock| false |], - [nock| 1|], - [nock| 1 |], - [nock| 4 |], - [nock| true |], - [nock| false |], - [nock| false |], - [nock| true |], - [nock| true |], - [nock| true |], - [nock| 1|], - [nock| 2|] - ], - mkAnomaCallTest - "Test050: Pattern matching with integers" - $(mkRelDir ".") - $(mkRelFile "test050.juvix") - [] - $ checkNatOutput [11], - mkAnomaCallTest - "Test052: Simple lambda calculus" - $(mkRelDir ".") - $(mkRelFile "test052.juvix") - [] - $ checkOutput [[nock| [15 nil] |]], - mkAnomaCallTest - "Test053: Inlining" - $(mkRelDir ".") - $(mkRelFile "test053.juvix") - [] - $ checkNatOutput [21], - mkAnomaCallTest - "Test054: Iterators" - $(mkRelDir ".") - $(mkRelFile "test054.juvix") - [] - $ checkNatOutput [189], - mkAnomaCallTest - "Test055: Constructor printing" - $(mkRelDir ".") - $(mkRelFile "test055.juvix") - [] - $ checkOutput - [[nock| [[[[1 2] 3] [[2 3] 4] nil] [1 2] [2 3] nil] |]], - mkAnomaCallTest - "Test056: Argument specialization" - $(mkRelDir ".") - $(mkRelFile "test056.juvix") - [] - $ checkNatOutput [69], - mkAnomaCallTest - "Test057: Case folding" - $(mkRelDir ".") - $(mkRelFile "test057.juvix") - [] - $ checkNatOutput [8], - mkAnomaCallTest - "Test058: Ranges" - $(mkRelDir ".") - $(mkRelFile "test058.juvix") - [] - $ checkNatOutput [7550], - mkAnomaCallTest - "Test059: Builtin list" - $(mkRelDir ".") - $(mkRelFile "test059.juvix") - [] - $ checkNatOutput [11], - mkAnomaCallTest - "Test060: Record update" - $(mkRelDir ".") - $(mkRelFile "test060.juvix") - [] - $ checkOutput [[nock| [30 10 2] |]], - mkAnomaCallTest - "Test061: Traits" - $(mkRelDir ".") - $(mkRelFile "test061.juvix") - [] - $ checkNatOutput [1, 0, 3, 5, 1, 6, 5, 3, 1, 1, 6, 1, 3], - mkAnomaCallTest - "Test062: Overapplication" - $(mkRelDir ".") - $(mkRelFile "test062.juvix") - [] - $ checkNatOutput [1], - mkAnomaCallTest - "Test063: Coercions" - $(mkRelDir ".") - $(mkRelFile "test063.juvix") - [] - $ checkNatOutput [0, 1, 2, 300, 4, 5, 6, 7], - mkAnomaCallTest - "Test064: Constant folding" - $(mkRelDir ".") - $(mkRelFile "test064.juvix") - [] - $ checkNatOutput [37], - mkAnomaCallTest - "Test065: Arithmetic simplification" - $(mkRelDir ".") - $(mkRelFile "test065.juvix") - [] - $ checkNatOutput [42], - mkAnomaCallTest - "Test066: Import function with a function call in default argument" - $(mkRelDir "test066") - $(mkRelFile "M.juvix") - [] - $ checkNatOutput [0], - mkAnomaCallTest - "Test067: Dependent default values inserted during translation FromConcrete" - $(mkRelDir ".") - $(mkRelFile "test067.juvix") - [] - $ checkNatOutput [30], - mkAnomaCallTest - "Test068: Dependent default values inserted in the arity checker" - $(mkRelDir ".") - $(mkRelFile "test068.juvix") - [] - $ checkNatOutput [30], - mkAnomaCallTest - "Test069: Dependent default values for Ord trait" - $(mkRelDir ".") - $(mkRelFile "test069.juvix") - [] - $ checkOutput [[nock| true |]], - mkAnomaCallTest - "Test070: Nested default values and named arguments" - $(mkRelDir ".") - $(mkRelFile "test070.juvix") - [] - $ checkNatOutput [1463], - mkAnomaCallTest - "Test071: Named application (Ord instance with default cmp)" - $(mkRelDir ".") - $(mkRelFile "test071.juvix") - [] - $ checkNatOutput [1528], - mkAnomaCallTest - "Test072: Monad transformers (ReaderT + StateT + Identity)" - $(mkRelDir "test072") - $(mkRelFile "ReaderT.juvix") - [] - $ checkNatOutput [10], - mkAnomaCallTest - "Test073: Import and use a syntax alias" - $(mkRelDir "test073") - $(mkRelFile "test073.juvix") - [] - $ checkNatOutput [11], - let k1 :: Term Natural = [nock| 333 |] - v1 :: Term Natural = [nock| 222 |] - k2 :: Term Natural = [nock| [1 2 3 nil] |] - v2 :: Term Natural = [nock| [4 5 6 nil] |] - -- The keys of the storage are of the form [id key nil]. - -- The id is captured from the arguments tuple of the function. - sk1 :: Term Natural = [nock| [[333 1 2 3 nil] 333 nil] |] - sk2 :: Term Natural = [nock| [[333 1 2 3 nil] [1 2 3 nil] nil] |] - in mkAnomaCallTest' - True - ( Storage - ( HashMap.fromList - [ (StorageKey sk1, v1), - (StorageKey sk2, v2) - ] - ) - ) - "Test074: Builtin anomaGet" - $(mkRelDir ".") - $(mkRelFile "test074.juvix") - [OpQuote # k1, OpQuote # k2] - $ checkOutput [v1, v2], - mkAnomaCallTest - "Test075: Anoma encode" - $(mkRelDir ".") - $(mkRelFile "test075.juvix") - [] - $ checkNatOutput [2, 84081, 4657, 12], - mkAnomaCallTest - "Test076: Anoma decode" - $(mkRelDir ".") - $(mkRelFile "test076.juvix") - [] - $ checkOutput - [ [nock| 0 |], - [nock| [1 2 0] |], - [nock| [1 2] |], - [nock| false |] - ], - mkAnomaCallTest - "Test077: Anoma verify-detached" - $(mkRelDir ".") - $(mkRelFile "test077.juvix") - [] - $ checkOutput - [ [nock| 64 |], - [nock| true |] - ], - let toSignAndVerify :: Term Natural = [nock| [1 2 nil] |] - in mkAnomaCallTest - "Test078: Anoma sign and verify" - $(mkRelDir ".") - $(mkRelFile "test078.juvix") - [OpQuote # toSignAndVerify] - $ checkOutput - [toSignAndVerify], - let inputStr :: Term Natural = [nock| "Juvix!" |] - in mkAnomaCallTest - "Test079: Strings" - $(mkRelDir ".") - $(mkRelFile "test079.juvix") - [OpQuote # inputStr] - $ checkOutput [[nock| "Juvix! ✨ héllo world ✨" |]], - mkAnomaCallTest - "Test080: Maybe" - $(mkRelDir ".") - $(mkRelFile "test080.juvix") - [] - $ checkOutput - [ [nock| [nil 1] |], - [nock| 2 |], - [nock| 3 |], - [nock| nil |] - ], - mkAnomaCallTest - "Test081: UInt8" - $(mkRelDir ".") - $(mkRelFile "test081.juvix") - [] - $ checkOutput - [ [nock| 1 |], - [nock| 255 |], - [nock| 2 |], - [nock| true |], - [nock| true |], - [nock| false |], - [nock| 1 |], - [nock| 238 |], - [nock| 3 |], - [nock| 240 |], - [nock| [1 238 3 2 nil] |] - ], - mkAnomaCallTest - "Test082: ByteArray" - $(mkRelDir ".") - $(mkRelFile "test082.juvix") - [] - $ checkOutput - [ [nock| 0 |], - [nock| [0 0] |], - [nock| 3 |], - [nock| [3 0] |], - [nock| 4 |], - [nock| [4 1] |], - [nock| 2 |], - [nock| [2 258] |], - [nock| 1 |], - [nock| [1 0] |] - ], - mkAnomaCallTest - "Test083: Anoma ByteArray" - $(mkRelDir ".") - $(mkRelFile "test083.juvix") - [] - $ checkOutput - [ [nock| [[0 0] 0] |], - [nock| [[3 0] 0] |], - [nock| [[4 1] 1] |], - [nock| [[2 258] 258] |], - [nock| [[1 0] 0] |] - ], - mkAnomaCallTest - "Test084: Anoma Sha256" - $(mkRelDir ".") - $(mkRelFile "test084.juvix") - [] - $ checkOutput - [ [nock| 64 |], - [nock| + [ haskellNockmaTests, + anomaNodeTests + ] + where + anomaNodeTests :: TestTree + anomaNodeTests = + testGroup + "AnomaNode" + (map mkAnomaNodeTest (filter shouldRun anomaTests)) + where + shouldRun :: AnomaTest -> Bool + shouldRun a = classify a == ClassWorking + + haskellNockmaTests :: TestTree + haskellNockmaTests = + testGroup + "Anoma positive tests (Haskell evaluator)" + (map fromAnomaTest anomaTests) + + natArg :: Natural -> Term Natural + natArg = toNock + + anomaTests :: [AnomaTest] + anomaTests = + [ mkAnomaTest + 1 + "Arithmetic operators" + $(mkRelDir ".") + $(mkRelFile "test001.juvix") + [natArg 5] + (checkNatOutput [11]), + mkAnomaTest + 2 + "Arithmetic operators inside lambdas" + $(mkRelDir ".") + $(mkRelFile "test002.juvix") + [natArg 2] + (checkNatOutput [11]), + mkAnomaTest + 3 + "Integer arithmetic" + $(mkRelDir ".") + $(mkRelFile "test003.juvix") + [] + (checkNatOutput [1, 4, 2, 4, 0]), + mkAnomaTestNoDebug + 3 + "Integer arithmetic - no debug" + $(mkRelDir ".") + $(mkRelFile "test003.juvix") + [] + (checkNatOutput [1, 4, 2, 4, 0]), + mkAnomaTest + 5 + "Higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test005.juvix") + [natArg 1] + (checkNatOutput [6]), + mkAnomaTest + 6 + "If-then-else and lazy boolean operators" + $(mkRelDir ".") + $(mkRelFile "test006.juvix") + [] + (checkOutput [[nock| 2 |], [nock| true |], [nock| false |]]), + mkAnomaTest + 7 + "Pattern matching and lambda-case" + $(mkRelDir ".") + $(mkRelFile "test007.juvix") + [] + $ do + let l :: Term Natural = [nock| [1 2 nil] |] + checkOutput [[nock| false |], [nock| true |], [nock| 0 |], [nock| [1 nil] |], [nock| 1 |], l, l], + mkAnomaTest + 8 + "Recursion" + $(mkRelDir ".") + $(mkRelFile "test008.juvix") + [natArg 1000] + (eqNock [nock| 500500 |]), + mkAnomaTest + 9 + "Tail recursion" + $(mkRelDir ".") + $(mkRelFile "test009.juvix") + [natArg 1000] + $ checkNatOutput [500500, 120, 3628800, 479001600], + mkAnomaTest + 10 + "Let" + $(mkRelDir ".") + $(mkRelFile "test010.juvix") + [] + (checkNatOutput [32]), + mkAnomaTest + 11 + "Tail recursion: Fibonacci numbers in linear time" + $(mkRelDir ".") + $(mkRelFile "test011.juvix") + [] + $ do + let fib10 :: Natural = 55 + fib100 :: Natural = 354224848179261915075 + fib1000 :: Natural = 43466557686937456435688527675040625802564660517371780402481729089536555417949051890403879840079255169295922593080322634775209689623239873322471161642996440906533187938298969649928516003704476137795166849228875 + checkNatOutput [fib10, fib100, fib1000], + mkAnomaTest + 12 + "Trees" + $(mkRelDir ".") + $(mkRelFile "test012.juvix") + [natArg 1000] + $ checkNatOutput + [ 13200200200, + 21320020020013200200200, + 3213200200200132002002002132002002001320020020021320020020013200200200, + 13213200200200132002002002132002002001320020020021320020020013200200200, + 21321320020020013200200200213200200200132002002002132002002001320020020013213200200200132002002002132002002001320020020021320020020013200200200 + ], + mkAnomaTest + 13 + "Functions returning functions with variable capture" + $(mkRelDir ".") + $(mkRelFile "test013.juvix") + [] + $ checkNatOutput [1, 0, 2, 5], + mkAnomaTest + 14 + "Arithmetic" + $(mkRelDir ".") + $(mkRelFile "test014.juvix") + [] + $ checkNatOutput [7, 17, 37, 31], + mkAnomaTest + 15 + "Local functions with free variables" + $(mkRelDir ".") + $(mkRelFile "test015.juvix") + [] + $ checkNatOutput [600, 25, 30, 45, 55, 16], + mkAnomaTest + 16 + "Recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test016.juvix") + [] + $ checkNatOutput [55], + mkAnomaTest + 17 + "Tail recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test017.juvix") + [natArg 1000] + $ checkNatOutput [500500], + mkAnomaTest + 18 + "Higher-order functions and recursion" + $(mkRelDir ".") + $(mkRelFile "test018.juvix") + [] + $ checkNatOutput [11], + mkAnomaTest + 19 + "Self-application" + $(mkRelDir ".") + $(mkRelFile "test019.juvix") + [] + $ checkNatOutput [7], + mkAnomaTest + 20 + "Recursive functions: McCarthy's 91 function, subtraction by increments" + $(mkRelDir ".") + $(mkRelFile "test020.juvix") + [] + $ checkNatOutput [91, 91, 91, 91, 100, 6, 6, 400, 4000], + mkAnomaTest + 21 + "Fast exponentiation" + $(mkRelDir ".") + $(mkRelFile "test021.juvix") + [] + $ checkNatOutput [8, 2187, 48828125], + mkAnomaTest + 22 + "Lists" + $(mkRelDir ".") + $(mkRelFile "test022.juvix") + [natArg 1000] + $ checkOutput + [ [nock| [10 9 8 7 6 5 4 3 2 1 nil] |], + [nock| [1 2 3 4 5 6 7 8 9 10 nil] |], + [nock| [10 9 8 7 6 nil] |], + [nock| [0 1 2 3 4 5 6 7 8 9 nil] |], + [nock| 500500 |], + [nock| 500500 |] + ], + mkAnomaTest + 23 + "Mutual recursion" + $(mkRelDir ".") + $(mkRelFile "test023.juvix") + [] + $ checkNatOutput [32, 869, 6385109], + mkAnomaTest + 24 + "Nested binders with variable capture" + $(mkRelDir ".") + $(mkRelFile "test024.juvix") + [] + $ checkNatOutput [6688], + mkAnomaTest + 25 + "Euclid's algorithm" + $(mkRelDir ".") + $(mkRelFile "test025.juvix") + [] + $ checkNatOutput [14, 70, 1, 1, 1], + mkAnomaTest + 26 + "Functional queues" + $(mkRelDir ".") + $(mkRelFile "test026.juvix") + [] + $ checkOutput [makeList (toNock @Natural <$> [1 .. 100])], + -- TODO allow lambda branches of different number of patterns + -- mkAnomaTest + -- "Test027: Church numerals" + -- $(mkRelDir ".") + -- $(mkRelFile "test027.juvix") + -- [] + -- $ checkNatOutput [7, 10, 21], + mkAnomaTest + 28 + "Streams without memoization" + $(mkRelDir ".") + $(mkRelFile "test028.juvix") + [natArg 10, natArg 50] + $ checkNatOutput [31, 233], + mkAnomaTest + 29 + "Ackermann function" + $(mkRelDir ".") + $(mkRelFile "test029.juvix") + [] + $ checkNatOutput [8, 9, 15, 17, 29], + mkAnomaTest + 30 + "Ackermann function (higher-order definition)" + $(mkRelDir ".") + $(mkRelFile "test030.juvix") + [] + $ checkNatOutput [10, 21, 2187, 15], + mkAnomaTest + 31 + "Nested lists" + $(mkRelDir ".") + $(mkRelFile "test031.juvix") + [] + $ checkOutput [[nock| [4 3 2 1 3 2 1 2 1 1 nil ] |]], + mkAnomaTest + 32 + "Merge sort" + $(mkRelDir ".") + $(mkRelFile "test032.juvix") + [] + $ do + let l = makeList (toNock @Natural <$> [2 .. 11]) + checkOutput [l, l, l], + mkAnomaTest + 33 + "Eta-expansion of builtins and constructors" + $(mkRelDir ".") + $(mkRelFile "test033.juvix") + [] + $ checkOutput + [ [nock| 9 |], + [nock| [7 2] |], + [nock| 5 |], + [nock| [3 2] |], + [nock| [1 2] |] + ], + mkAnomaTest + 34 + "Recursive let" + $(mkRelDir ".") + $(mkRelFile "test034.juvix") + [] + $ checkNatOutput [500500, 32, 869, 41, 85], + mkAnomaTest + 35 + "Pattern matching" + $(mkRelDir ".") + $(mkRelFile "test035.juvix") + [] + $ checkOutput + [ [nock| [9 7 5 3 1 nil] |], + [nock| 300 |], + [nock| 4160 |], + [nock| 2336 |], + [nock| 1 |], + [nock| 0 |] + ], + mkAnomaTest + 36 + "Eta-expansion" + $(mkRelDir ".") + $(mkRelFile "test036.juvix") + [] + $ checkNatOutput [18], + mkAnomaTest + 37 + "Applications with lets and cases in function position" + $(mkRelDir ".") + $(mkRelFile "test037.juvix") + [] + $ checkNatOutput [9], + mkAnomaTest + 38 + "Simple case expression" + $(mkRelDir ".") + $(mkRelFile "test038.juvix") + [] + $ checkNatOutput [1], + mkAnomaTest + 39 + "Mutually recursive let expression" + $(mkRelDir ".") + $(mkRelFile "test039.juvix") + [] + $ checkOutput [[nock| false |], [nock| true |]], + mkAnomaTest + 40 + "Pattern matching nullary constructor" + $(mkRelDir ".") + $(mkRelFile "test040.juvix") + [] + $ checkOutput [[nock| true |]], + mkAnomaTest + 41 + "Use a builtin inductive in an inductive constructor" + $(mkRelDir ".") + $(mkRelFile "test041.juvix") + [] + $ checkNatOutput [6], + mkAnomaTest + 43 + "Builtin trace" + $(mkRelDir ".") + $(mkRelFile "test043.juvix") + [] + $ checkNatOutput [0, 1], + mkAnomaTest + 45 + "Implicit builtin bool" + $(mkRelDir ".") + $(mkRelFile "test045.juvix") + [] + $ checkNatOutput [4], + mkAnomaTest + 46 + "Polymorphic type arguments" + $(mkRelDir ".") + $(mkRelFile "test046.juvix") + [] + $ checkNatOutput [7], + mkAnomaTest + 47 + "Local Modules" + $(mkRelDir ".") + $(mkRelFile "test047.juvix") + [] + $ checkNatOutput [660], + mkAnomaTest + 49 + "Builtin Int" + $(mkRelDir ".") + $(mkRelFile "test049.juvix") + [] + $ checkOutput + [ [nock| 1 |], + [nock| 1 |], + [nock| 0 |], + [nock| 1|], + [nock| 1 |], + [nock| false |], + [nock| 1|], + [nock| 1 |], + [nock| 4 |], + [nock| true |], + [nock| false |], + [nock| false |], + [nock| true |], + [nock| true |], + [nock| true |], + [nock| 1|], + [nock| 2|] + ], + mkAnomaTest + 50 + "Pattern matching with integers" + $(mkRelDir ".") + $(mkRelFile "test050.juvix") + [] + $ checkNatOutput [11], + mkAnomaTest + 52 + "Simple lambda calculus" + $(mkRelDir ".") + $(mkRelFile "test052.juvix") + [] + $ checkOutput [[nock| [15 nil] |]], + mkAnomaTest + 53 + "Inlining" + $(mkRelDir ".") + $(mkRelFile "test053.juvix") + [] + $ checkNatOutput [21], + mkAnomaTest + 54 + "Iterators" + $(mkRelDir ".") + $(mkRelFile "test054.juvix") + [] + $ checkNatOutput [189], + mkAnomaTest + 55 + "Constructor printing" + $(mkRelDir ".") + $(mkRelFile "test055.juvix") + [] + $ checkOutput + [[nock| [[[[1 2] 3] [[2 3] 4] nil] [1 2] [2 3] nil] |]], + mkAnomaTest + 56 + "Argument specialization" + $(mkRelDir ".") + $(mkRelFile "test056.juvix") + [] + $ checkNatOutput [69], + mkAnomaTest + 57 + "Case folding" + $(mkRelDir ".") + $(mkRelFile "test057.juvix") + [] + $ checkNatOutput [8], + mkAnomaTest + 58 + "Ranges" + $(mkRelDir ".") + $(mkRelFile "test058.juvix") + [] + $ checkNatOutput [7550], + mkAnomaTest + 59 + "Builtin list" + $(mkRelDir ".") + $(mkRelFile "test059.juvix") + [] + $ checkNatOutput [11], + mkAnomaTest + 60 + "Record update" + $(mkRelDir ".") + $(mkRelFile "test060.juvix") + [] + $ checkOutput [[nock| [30 10 2] |]], + mkAnomaTest + 61 + "Traits" + $(mkRelDir ".") + $(mkRelFile "test061.juvix") + [] + $ checkNatOutput [1, 0, 3, 5, 1, 6, 5, 3, 1, 1, 6, 1, 3], + mkAnomaTest + 62 + "Overapplication" + $(mkRelDir ".") + $(mkRelFile "test062.juvix") + [] + $ checkNatOutput [1], + mkAnomaTest + 63 + "Coercions" + $(mkRelDir ".") + $(mkRelFile "test063.juvix") + [] + $ checkNatOutput [0, 1, 2, 300, 4, 5, 6, 7], + mkAnomaTest + 64 + "Constant folding" + $(mkRelDir ".") + $(mkRelFile "test064.juvix") + [] + $ checkNatOutput [37], + mkAnomaTest + 65 + "Arithmetic simplification" + $(mkRelDir ".") + $(mkRelFile "test065.juvix") + [] + $ checkNatOutput [42], + mkAnomaTest + 66 + "Import function with a function call in default argument" + $(mkRelDir "test066") + $(mkRelFile "M.juvix") + [] + $ checkNatOutput [0], + mkAnomaTest + 67 + "Dependent default values inserted during translation FromConcrete" + $(mkRelDir ".") + $(mkRelFile "test067.juvix") + [] + $ checkNatOutput [30], + mkAnomaTest + 68 + "Dependent default values inserted in the arity checker" + $(mkRelDir ".") + $(mkRelFile "test068.juvix") + [] + $ checkNatOutput [30], + mkAnomaTest + 69 + "Dependent default values for Ord trait" + $(mkRelDir ".") + $(mkRelFile "test069.juvix") + [] + $ checkOutput [[nock| true |]], + mkAnomaTest + 70 + "Nested default values and named arguments" + $(mkRelDir ".") + $(mkRelFile "test070.juvix") + [] + $ checkNatOutput [1463], + mkAnomaTest + 71 + "Named application (Ord instance with default cmp)" + $(mkRelDir ".") + $(mkRelFile "test071.juvix") + [] + $ checkNatOutput [1528], + mkAnomaTest + 72 + "Monad transformers (ReaderT + StateT + Identity)" + $(mkRelDir "test072") + $(mkRelFile "ReaderT.juvix") + [] + $ checkNatOutput [10], + mkAnomaTest + 73 + "Import and use a syntax alias" + $(mkRelDir "test073") + $(mkRelFile "test073.juvix") + [] + $ checkNatOutput [11], + let k1 :: Term Natural = [nock| 333 |] + v1 :: Term Natural = [nock| 222 |] + k2 :: Term Natural = [nock| [1 2 3 nil] |] + v2 :: Term Natural = [nock| [4 5 6 nil] |] + -- The keys of the storage are of the form [id key nil]. + -- The id is captured from the arguments tuple of the function. + sk1 :: Term Natural = [nock| [[333 1 2 3 nil] 333 nil] |] + sk2 :: Term Natural = [nock| [[333 1 2 3 nil] [1 2 3 nil] nil] |] + in mkAnomaTest' + True + ( Storage + ( hashMap + [ (StorageKey sk1, v1), + (StorageKey sk2, v2) + ] + ) + ) + 74 + "Builtin anomaGet" + $(mkRelDir ".") + $(mkRelFile "test074.juvix") + [k1, k2] + $ checkOutput [v1, v2], + mkAnomaTest + 75 + "Anoma encode" + $(mkRelDir ".") + $(mkRelFile "test075.juvix") + [] + $ checkNatOutput [2, 84081, 4657, 12], + mkAnomaTest + 76 + "Anoma decode" + $(mkRelDir ".") + $(mkRelFile "test076.juvix") + [] + $ checkOutput + [ [nock| 0 |], + [nock| [1 2 0] |], + [nock| [1 2] |], + [nock| false |] + ], + mkAnomaTest + 77 + "Anoma verify-detached" + $(mkRelDir ".") + $(mkRelFile "test077.juvix") + [] + $ checkOutput + [ [nock| 64 |], + [nock| true |] + ], + let toSignAndVerify :: Term Natural = [nock| [1 2 nil] |] + in mkAnomaTest + 78 + "Anoma sign and verify" + $(mkRelDir ".") + $(mkRelFile "test078.juvix") + [toSignAndVerify] + $ checkOutput + [toSignAndVerify], + let inputStr :: Term Natural = [nock| "Juvix!" |] + in mkAnomaTest + 79 + "Strings" + $(mkRelDir ".") + $(mkRelFile "test079.juvix") + [inputStr] + $ checkOutput [[nock| "Juvix! ✨ héllo world ✨" |]], + mkAnomaTest + 80 + "Maybe" + $(mkRelDir ".") + $(mkRelFile "test080.juvix") + [] + $ checkOutput + [ [nock| [nil 1] |], + [nock| 2 |], + [nock| 3 |], + [nock| nil |] + ], + mkAnomaTest + 81 + "UInt8" + $(mkRelDir ".") + $(mkRelFile "test081.juvix") + [] + $ checkOutput + [ [nock| 1 |], + [nock| 255 |], + [nock| 2 |], + [nock| true |], + [nock| true |], + [nock| false |], + [nock| 1 |], + [nock| 238 |], + [nock| 3 |], + [nock| 240 |], + [nock| [1 238 3 2 nil] |] + ], + mkAnomaTest + 82 + "ByteArray" + $(mkRelDir ".") + $(mkRelFile "test082.juvix") + [] + $ checkOutput + [ [nock| 0 |], + [nock| [0 0] |], + [nock| 3 |], + [nock| [3 0] |], + [nock| 4 |], + [nock| [4 1] |], + [nock| 2 |], + [nock| [2 258] |], + [nock| 1 |], + [nock| [1 0] |] + ], + mkAnomaTest + 83 + "Anoma ByteArray" + $(mkRelDir ".") + $(mkRelFile "test083.juvix") + [] + $ checkOutput + [ [nock| [[0 0] 0] |], + [nock| [[3 0] 0] |], + [nock| [[4 1] 1] |], + [nock| [[2 258] 258] |], + [nock| [[1 0] 0] |] + ], + mkAnomaTest + 84 + "Anoma Sha256" + $(mkRelDir ".") + $(mkRelFile "test084.juvix") + [] + $ checkOutput + [ [nock| 64 |], + [nock| [ 64 5092006196359674779938793937035252249221936503860319648757996882954518215195609232852607160812968472040491493412050369557521935588220586883008001462395444 ] |] - ], - mkAnomaCallTest - "Test085: Anoma Resource Machine builtins" - $(mkRelDir ".") - $(mkRelFile "test085.juvix") - [] - $ checkOutput - [ [nock| [[[11 22] 110] 0] |], - [nock| [10 11] |], - [nock| 478793196187462788804451 |], - [nock| 418565088612 |], - [nock| 0 |] - ], - mkAnomaCallTest - "Test086: Anoma Random" - $(mkRelDir ".") - $(mkRelFile "test086.juvix") - [] - $ checkOutput - [ [nock| [2 30764] |], - [nock| [3 10689019] |], - [nock| [2 20159] |], - [nock| [4 4187579825] |] - ] - ] + ], + mkAnomaTest + 85 + "Anoma Resource Machine builtins" + $(mkRelDir ".") + $(mkRelFile "test085.juvix") + [] + $ checkOutput + [ [nock| [[[11 22] 110] 0] |], + [nock| [10 11] |], + [nock| 478793196187462788804451 |], + [nock| 418565088612 |], + [nock| 0 |] + ], + mkAnomaTest + 86 + "Anoma Random" + $(mkRelDir ".") + $(mkRelFile "test086.juvix") + [] + $ checkOutput + [ [nock| [2 30764] |], + [nock| [3 10689019] |], + [nock| [2 20159] |], + [nock| [4 4187579825] |] + ] + ] diff --git a/test/Base.hs b/test/Base.hs index 86c315a1f0..e4515e1fc0 100644 --- a/test/Base.hs +++ b/test/Base.hs @@ -23,10 +23,10 @@ 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 (prettyString) +import Juvix.Prelude.Pretty import System.Process qualified as P import Test.Tasty -import Test.Tasty.HUnit hiding (assertFailure) +import Test.Tasty.HUnit hiding (assertFailure, testCase) import Test.Tasty.HUnit qualified as HUnit data AssertionDescr @@ -63,7 +63,7 @@ mkTest TestDescr {..} = case _testAssertion of withPrecondition :: Assertion -> IO TestTree -> IO TestTree withPrecondition assertion ifSuccess = do E.catch (assertion >> ifSuccess) $ \case - E.SomeException e -> return (testCase "Precondition failed" (assertFailure (show e))) + E.SomeException e -> return (testCase @String "Precondition failed" (assertFailure (show e))) assertEqDiffText :: String -> Text -> Text -> Assertion assertEqDiffText = assertEqDiff unpack @@ -132,6 +132,13 @@ testRunIOEitherTermination entry = 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)) => @@ -190,3 +197,17 @@ readProcessCwd' menv mcwd cmd args stdinText = 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) diff --git a/test/Nockma/Compile/Tree/Positive.hs b/test/Nockma/Compile/Tree/Positive.hs index dc72690406..f0559edac7 100644 --- a/test/Nockma/Compile/Tree/Positive.hs +++ b/test/Nockma/Compile/Tree/Positive.hs @@ -76,14 +76,8 @@ convertTest p = do go :: Base.Path Rel File -> Base.Path Rel File go = replaceExtensions' [".nockma", ".out"] - testNum :: String - testNum = take 3 (drop 4 (p ^. Tree.name)) - to3DigitString :: Int -> String - to3DigitString n - | n < 10 = "00" ++ show n - | n < 100 = "0" ++ show n - | n < 1000 = show n - | otherwise = impossible + testNum :: Text + testNum = pack (take 3 (drop 4 (p ^. Tree.name))) allTests :: TestTree allTests = diff --git a/test/Nockma/Eval/Positive.hs b/test/Nockma/Eval/Positive.hs index c1f283aeaf..d008fcecab 100644 --- a/test/Nockma/Eval/Positive.hs +++ b/test/Nockma/Eval/Positive.hs @@ -11,7 +11,12 @@ import Juvix.Compiler.Nockma.Pretty import Juvix.Compiler.Nockma.Translation.FromSource.QQ import Juvix.Compiler.Nockma.Translation.FromTree -type Check = Sem '[Reader [Term Natural], Reader (Term Natural), EmbedIO] +type Check = + Sem + '[ Reader [Term Natural], + Reader (Term Natural), + EmbedIO + ] data Test = Test { _testEvalOptions :: EvalOptions,