more stackification

test/Gyehoek/Test/CPS/Stackify.hs

@@ -8,6 +8,7 @@ import Data.List (List)
 import Gyehoek.CPS.Syntax (cps)
 import Gyehoek.GenSym (runGenSym)
 import Effectful
+import Test.Tasty.ExpectedFailure (expectFail)
 
 
 root :: IO TestTree
@@ -15,6 +16,8 @@ root = pure . testGroup "stackify" $
   [ trivialReturn
   , tailCall
   , prim
+  , condition
+  , procedure
   ]
 
 evalsTo :: List Obj -> Sut.Exp -> Assertion
@@ -52,3 +55,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"
+  [ expectFail $ 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,35 +10,76 @@ 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"
+  ]
+
+brokenStackifyTests :: List String
+brokenStackifyTests =
+  [ "apply-twice"
+  , "adder"
+  , "apply2"
+  , "let-fn"
   ]
 
 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
+maybeBroken name broken = applyWhen (name `elem` broken) expectFail
+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 goldenVsAction
+    in maybeBroken testname brokenWasmTests $
+      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 =
+          catches (do rs <- Driver.eval_e2e scmfile
+                      pure ( ExitSuccess
+                           , T.unwords . fmap writeObj $ rs
+                           , "" ))
+            [ Handler \(ErrorCall s) ->
+                pure (ExitFailure 1, "", T.pack s)
+            ]
+    in maybeBroken testname brokenStackifyTests $
+     goldenVsAction
        testname
        resultfile
        action

test/Gyehoek/Test/Stack/VM.hs

@@ -75,7 +75,7 @@ procedure = testGroup "procedure"
                 ]
                 [ Push (ValReg "n")
                 , Prim "x1" $ PrimSub (ValReg "n") (ValImm (ImmInt 1))
-                , PushCont "fac-k0"
+                , PushCont (ValLabel "fac-k0")
                 , Call (ValLabel "fac") [ValReg "x1"]
                 ]
               ]

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