more stackification

test/Gyehoek/Test/CPS/Stackify.hs

@@ -15,6 +15,8 @@ root = pure . testGroup "stackify" $
   [ trivialReturn
   , tailCall
   , prim
+  , condition
+  , procedure
   ]
 
 evalsTo :: List Obj -> Sut.Exp -> Assertion
@@ -52,3 +54,28 @@ prim = testGroup "prim"
         [cps|(prim (+ 4 5)
                (κ (x) (continue halt x)))|]
   ]
+
+condition = testCase "if" do
+  evalsTo [ObjImm (ImmInt 123)]
+    [cps|(if #t (continue halt 123) (continue halt 456))|]
+  evalsTo [ObjImm (ImmInt 456)]
+    [cps|(if #f (continue halt 123) (continue halt 456))|]
+
+procedure = testGroup "procedure"
+  [ testCase "factorial" do
+      evalsTo [ObjImm (ImmInt 720)]
+        [cps|(letrec ((fac (λ (n ktail)
+                             (prim (zero? n)
+                               (κ (x0)
+                                 (if x0
+                                   (continue ktail 1)
+                                   (prim (- n 1)
+                                     (κ (x1)
+                                       (letrec ((fac-k0
+                                                  (κ (x2)
+                                                    (prim (* n x2)
+                                                      (κ (x3)
+                                                        (continue ktail x3))))))
+                                         (fac x1 fac-k0))))))))))
+               (fac 6 halt))|]
+  ]

test/Gyehoek/Test/Golden.hs

@@ -10,34 +10,62 @@ import System.Directory
 import Data.Function
 import System.Environment.Blank (getEnvDefault)
 import qualified System.Process.Text as PT
+import Control.Exception (catches, ErrorCall(..), Handler(..))
+import Gyehoek.Stack.VM (writeObj)
+import Data.Text qualified as T
+import System.Exit (ExitCode(..))
+import Test.Tasty.ExpectedFailure (expectFail)
 
 
-disabled :: List String
-disabled =
-  [
+brokenWasmTests :: List String
+brokenWasmTests =
+  [ "adder"
+  , "apply-twice"
+  , "square"
+  , "fn-of-fn"
+  , "let-fn"
+  , "apply2"
   ]
 
 root :: IO TestTree
 root = do
   all_cases <- listDirectory "golden"
   let tests = all_cases
-            & filter (`notElem` disabled)
             & fmap ("golden"</>)
   testGroup "golden" <$> sequenceA
-    [ executionTests tests
+    [ wasmTests tests
+    , stackifyTests tests
     ]
 
-executionTests :: List FilePath -> IO TestTree
-executionTests files = do
+wasmTests :: List FilePath -> IO TestTree
+wasmTests files = do
   cmd <- getEnvDefault "GYEHOEK_RUNTIME"
     "runtime/target/debug/gyehoek-runtime"
-  pure $ testGroup "execution" $ files <&> \test ->
+  pure $ testGroup "wasm execution" $ files <&> \test ->
     let testname = takeFileName test
         scmfile = test </> "source.scm"
         resultfile = test </> "exec"
         action = do
           t <- Driver.lower_e2e scmfile
           PT.readProcessWithExitCode cmd ["-"] t
+    in applyWhen (testname `elem` brokenWasmTests) expectFail $
+      goldenVsAction
+       testname
+       resultfile
+       action
+       printProcResult
+
+stackifyTests :: List FilePath -> IO TestTree
+stackifyTests files = do
+  pure $ testGroup "stackified execution" $ files <&> \test ->
+    let testname = takeFileName test
+        scmfile = test </> "source.scm"
+        resultfile = test </> "exec"
+        action = do
+          rs <- Driver.eval_e2e scmfile
+          pure ( ExitSuccess
+               , T.unwords . fmap writeObj $ rs
+               , "" )
     in goldenVsAction
        testname
        resultfile

test/Main.hs

@@ -14,8 +14,8 @@ main = defaultMain =<< root
 
 root :: IO TestTree
 root = testGroup "test" <$> sequenceA
-  [ {- Gyehoek.Test.Golden.root
-  ,-} Gyehoek.Test.Sexp.root
+  [ Gyehoek.Test.Golden.root
+  , Gyehoek.Test.Sexp.root
   , Gyehoek.Test.CPS.Syntax.root
   , Gyehoek.Test.Stack.VM.root
   , Gyehoek.Test.CPS.Stackify.root