Add tests for list-like constructor allocation and case

anoma · Jan 24, 2024 · 526c4ca · 526c4ca
1 parent 54bf503
commit 526c4ca
Showing 1 changed file with 33 additions and 0 deletions.
diff --git a/test/Nockma/Compile/Positive.hs b/test/Nockma/Compile/Positive.hs
@@ -565,6 +565,39 @@ tests =
             (builtinFalse, pop >> pushNat 5),
             (builtinFalse, crash)
           ],
+    defTest
+      "cmdCase: case on listy nil"
+      (eqStack ValueStack [nock| [5 nil] |])
+      $ do
+        allocConstr (constructorTag ConstructorListNil)
+        caseCmd
+          (Just (pushNat 0))
+          [ (constructorTag ConstructorListCons, pushNat 0),
+            (constructorTag ConstructorListNil, pop >> pushNat 5),
+            (constructorTag ConstructorListCons, crash)
+          ],
+    defTest
+      "cmdCase: case on listy cons and field accessor"
+      (eqStack ValueStack [nock| [[60 30 nil] nil] |])
+      $ do
+        let tagCons = constructorTag ConstructorListCons
+            tagNil = constructorTag ConstructorListNil
+        allocConstr tagNil
+        pushNat 30
+        allocConstr tagCons
+        caseCmd
+          Nothing
+          [ ( tagCons,
+              do
+                copyTopFromTo ValueStack TempStack
+                pushConstructorFieldOnto ValueStack tagCons (Asm.mkTempRef' 1 0) 0
+                pushConstructorFieldOnto ValueStack tagCons (Asm.mkTempRef' 1 0) 0
+                add
+                allocConstr tagCons
+            ),
+            (tagNil, pop >> pushNat 5),
+            (tagCons, crash)
+          ],
     defTest
       "push constructor field"
       (eqStack AuxStack [nock| [30 nil] |])