fix gibbon tests

iu-parfunc · Nov 19, 2024 · 010ea44 · 010ea44
1 parent 54ea148
commit 010ea44
Show file tree

Hide file tree

Showing 5 changed files with 70 additions and 70 deletions.
diff --git a/gibbon-compiler/tests/InferEffects.hs b/gibbon-compiler/tests/InferEffects.hs
@@ -28,19 +28,19 @@ assertInferEffects prg fnName expected = expected @=? eff
 -- | Add1 function has a traversal effect [Traverse "lin2"]
 --
 case_add1 :: Assertion
-case_add1 = assertInferEffects add1Prog "add1" (S.singleton $ Traverse "lin2")
+case_add1 = assertInferEffects add1Prog "add1" (S.singleton $ Traverse (singleLocVar "lin2"))
 
 -- | Identity fn doesn't have any traversal effect
 case_id1 :: Assertion
 case_id1 = assertInferEffects id1Prog "id1" S.empty
 
 -- | Copying has a traversal effect
 case_copyTree :: Assertion
-case_copyTree =  assertInferEffects copyTreeProg "copyTree" (S.singleton $ Traverse "lin23")
+case_copyTree =  assertInferEffects copyTreeProg "copyTree" (S.singleton $ Traverse (singleLocVar "lin23"))
 
 -- | Call copy on the body of id1
 case_call_copy_on_id1 :: Assertion
-case_call_copy_on_id1 = assertInferEffects copyOnId1Prog "id1WithCopy" (S.singleton $ Traverse "lin19")
+case_call_copy_on_id1 = assertInferEffects copyOnId1Prog "id1WithCopy" (S.singleton $ Traverse (singleLocVar "lin19"))
 
 case_id2 :: Assertion
 case_id2 = assertInferEffects id2Prog "id2" S.empty
@@ -52,7 +52,7 @@ case_int_add :: Assertion
 case_int_add = assertInferEffects intAddProg "intAdd" S.empty
 
 case_packed_tuple :: Assertion
-case_packed_tuple = assertInferEffects testProdProg "testprod" (S.singleton $ Traverse "lin131")
+case_packed_tuple = assertInferEffects testProdProg "testprod" (S.singleton $ Traverse (singleLocVar "lin131"))
 
 inferEffects2Tests :: TestTree
 inferEffects2Tests = $(testGroupGenerator)
diff --git a/gibbon-compiler/tests/InferLocations.hs b/gibbon-compiler/tests/InferLocations.hs
@@ -26,8 +26,8 @@ import Control.Monad.Trans (lift)
 -- some basic tests of unification, some should succeed and others should fail
 utest1 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
     where m = do
-            u1 <- fixLoc "a"
-            u2 <- fixLoc "b"
+            u1 <- fixLoc (singleLocVar "a")
+            u2 <- fixLoc (singleLocVar "b")
             l1 <- fresh
             l2 <- fresh
             assocLoc l1 u1
@@ -36,8 +36,8 @@ utest1 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
 
 utest2 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
     where m = do
-            u1 <- fixLoc "a"
-            u2 <- fixLoc "b"
+            u1 <- fixLoc (singleLocVar "a")
+            u2 <- fixLoc (singleLocVar "b")
             l1 <- fresh
             l2 <- fresh
             assocLoc l1 u1
@@ -46,8 +46,8 @@ utest2 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
 
 utest3 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
     where m = do
-            u1 <- fixLoc "a"
-            u2 <- fixLoc "b"
+            u1 <- fixLoc (singleLocVar "a")
+            u2 <- fixLoc (singleLocVar "b")
             u3 <- freshUnifyLoc
             l1 <- fresh
             l2 <- fresh
@@ -59,8 +59,8 @@ utest3 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
 
 utest4 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
     where m = do
-            u1 <- fixLoc "a"
-            u2 <- fixLoc "b"
+            u1 <- fixLoc (singleLocVar "a")
+            u2 <- fixLoc (singleLocVar "b")
             u3 <- freshUnifyLoc
             l1 <- fresh
             l2 <- fresh
@@ -85,8 +85,8 @@ case_unify4 = (Right True) @=? (fst $ fst utest4)
 
 etest1 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
     where m = do
-            u1 <- fixLoc "a"
-            u2 <- fixLoc "b"
+            u1 <- fixLoc (singleLocVar "a")
+            u2 <- fixLoc (singleLocVar "b")
             l1 <- fresh
             l2 <- fresh
             assocLoc l1 u1
@@ -95,7 +95,7 @@ etest1 = defaultPackedRunPassM $ St.runStateT (runExceptT m) M.empty
             finishExp $ DataConE l1 "Node" [VarE "x",VarE "y"]
 
 case_etest1 :: Assertion
-case_etest1 = (Right (DataConE "a" "Node" [VarE "x", VarE "y"])) @=? (fst $ fst etest1)
+case_etest1 = (Right (DataConE (singleLocVar "a") "Node" [VarE "x", VarE "y"])) @=? (fst $ fst etest1)
 
 tester1 :: L1.Exp1 -> Exp2
 tester1 e = case fst $ fst $ defaultPackedRunPassM $ St.runStateT (runExceptT (inferExp emptyEnv e NoDest)) M.empty of

diff --git a/gibbon-compiler/tests/InferRegionScope.hs b/gibbon-compiler/tests/InferRegionScope.hs
@@ -26,16 +26,16 @@ case_t1 = expected @=? actual
 
     test1 :: L2.Exp2
     test1 = Ext $ LetRegionE (VarR "r1") Undefined Nothing $
-            Ext $ LetLocE "l1" (StartOfRegionLE (VarR "r1")) $
-            LetE ("x1",[],PackedTy "A" "l1",
-                     DataConE "l1" "A" [LitE 1]) $
+            Ext $ LetLocE (singleLocVar "l1") (StartOfRegionLE (VarR "r1")) $
+            LetE ("x1",[],PackedTy "A" (singleLocVar "l1"),
+                     DataConE (singleLocVar "l1") "A" [LitE 1]) $
             VarE "x1"
 
     expected :: L2.Exp2
     expected = Ext $ LetRegionE (GlobR "r1" Infinite) Undefined Nothing $
-               Ext $ LetLocE "l1" (StartOfRegionLE (GlobR "r1" Infinite)) $
-               LetE ("x1",[],PackedTy "A" "l1",
-                        DataConE "l1" "A" [LitE 1]) $
+               Ext $ LetLocE (singleLocVar "l1") (StartOfRegionLE (GlobR "r1" Infinite)) $
+               LetE ("x1",[],PackedTy "A" (singleLocVar "l1"),
+                        DataConE (singleLocVar "l1") "A" [LitE 1]) $
                VarE "x1"
 
 
@@ -48,16 +48,16 @@ case_t2 = expected @=? actual
 
     test1 :: L2.Exp2
     test1 = Ext $ LetRegionE (VarR "r1") Undefined Nothing $
-            Ext $ LetLocE "l1" (StartOfRegionLE (VarR "r1")) $
-            LetE ("x1",[],PackedTy "A" "l1",
-                     DataConE "l1" "A" [LitE 1]) $
+            Ext $ LetLocE (singleLocVar "l1") (StartOfRegionLE (VarR "r1")) $
+            LetE ("x1",[],PackedTy "A" (singleLocVar "l1"),
+                     DataConE (singleLocVar "l1") "A" [LitE 1]) $
             LitE 1
 
     expected :: L2.Exp2
     expected = Ext $ LetRegionE (GlobR "r1" Infinite) Undefined Nothing $
-               Ext $ LetLocE "l1" (StartOfRegionLE (GlobR "r1" Infinite)) $
-               LetE ("x1",[],PackedTy "A" "l1",
-                        DataConE "l1" "A" [LitE 1]) $
+               Ext $ LetLocE (singleLocVar "l1") (StartOfRegionLE (GlobR "r1" Infinite)) $
+               LetE ("x1",[],PackedTy "A" (singleLocVar "l1"),
+                        DataConE (singleLocVar "l1") "A" [LitE 1]) $
                LitE 1
 
 inferRegScopeTests :: TestTree

diff --git a/gibbon-compiler/tests/L2/Typecheck.hs b/gibbon-compiler/tests/L2/Typecheck.hs
@@ -69,91 +69,91 @@ case_test2 =  assertValue exp (IntTy,LocationTypeState {tsmap = M.fromList []})
 case_test3 :: Assertion
 case_test3 =  assertValue exp (IntTy,LocationTypeState {tsmap = M.fromList []})
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-                              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
+                              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
                               LitE 1
 
 
 case_test4 :: Assertion
 case_test4 =  assertValue exp (IntTy,LocationTypeState {tsmap = M.fromList []})
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-                              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
+                              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
                               LetE ("throwaway", [],
-                                              PackedTy "Tree" "l",
-                                              DataConE "l" "Leaf" [LitE 1]) $
+                                              PackedTy "Tree" (singleLocVar "l"),
+                                              DataConE (singleLocVar "l") "Leaf" [LitE 1]) $
                               LitE 2
 
 
 case_test4_error1 :: Assertion
 case_test4_error1 =  assertError exp expected
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r1")) $
-              LetE ("throwaway", [], PackedTy "Tree" "l",
-                              DataConE "l" "Leaf" [LitE 1]) $
+              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r1")) $
+              LetE ("throwaway", [], PackedTy "Tree" (singleLocVar "l"),
+                              DataConE (singleLocVar "l") "Leaf" [LitE 1]) $
                LitE 2
 
-        expected = GenericTC "Region VarR (Var \"r1\") not in scope" (Ext (LetLocE (Var "l") (StartOfRegionLE (VarR (Var "r1"))) (LetE (Var "throwaway",[],PackedTy "Tree" (Var "l"), DataConE (Var "l") "Leaf" [LitE 1]) (LitE 2))))
+        expected = GenericTC "Region VarR (Var \"r1\") not in scope" (Ext (LetLocE (singleLocVar "l") (StartOfRegionLE (VarR (Var "r1"))) (LetE (Var "throwaway",[],PackedTy "Tree" (singleLocVar "l"), DataConE (singleLocVar "l") "Leaf" [LitE 1]) (LitE 2))))
 
 
 case_test4_error2 :: Assertion
 case_test4_error2 =  assertError exp expected
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
-              LetE ("throwaway", [], PackedTy "Tree" "l1",
-                              DataConE "l1" "Leaf" [LitE 1]) $
+              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
+              LetE ("throwaway", [], PackedTy "Tree" (singleLocVar "l1"),
+                              DataConE (singleLocVar "l1") "Leaf" [LitE 1]) $
               LitE 2
 
-        expected = GenericTC "Unknown location Var \"l1\"" (DataConE (Var "l1") "Leaf" [LitE 1])
+        expected = GenericTC "Unknown location Var \"l1\"" (DataConE (singleLocVar "l1") "Leaf" [LitE 1])
 
 
 case_test5 :: Assertion
 case_test5 =  assertValue exp (IntTy,LocationTypeState {tsmap = M.fromList []})
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
-              Ext $ LetLocE "l1" (AfterConstantLE 1 "l") $
-              LetE ("x", [], PackedTy "Tree" "l1", DataConE "l1" "Leaf" [LitE 1]) $
-              Ext $ LetLocE "l2" (AfterVariableLE "x" "l1" False) $
-              LetE ("y", [], PackedTy "Tree" "l2", DataConE "l2" "Leaf" [LitE 2]) $
-              LetE ("z", [], PackedTy "Tree" "l", DataConE "l" "Node" [VarE "x", VarE "y"]) $
+              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
+              Ext $ LetLocE (singleLocVar "l1") (AfterConstantLE 1 (singleLocVar "l")) $
+              LetE ("x", [], PackedTy "Tree" (singleLocVar "l1"), DataConE (singleLocVar "l1") "Leaf" [LitE 1]) $
+              Ext $ LetLocE (singleLocVar "l2") (AfterVariableLE "x" (singleLocVar "l1") False) $
+              LetE ("y", [], PackedTy "Tree" (singleLocVar "l2"), DataConE (singleLocVar "l2") "Leaf" [LitE 2]) $
+              LetE ("z", [], PackedTy "Tree" (singleLocVar "l"), DataConE (singleLocVar "l") "Node" [VarE "x", VarE "y"]) $
               LitE 1
 
 case_test5_error1 :: Assertion
 case_test5_error1 =  assertError exp expected
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
-              Ext $ LetLocE "l1" (AfterConstantLE 1 "l") $
-              LetE ("x", [], PackedTy "Tree" "l1",
-                              DataConE "l1" "Leaf" [LitE 1]) $
-              Ext $ LetLocE "l2" (AfterVariableLE "x" "l1" False) $
-              LetE ("y", [], PackedTy "Tree" "l2",
-                              DataConE "l2" "Leaf" [LitE 2]) $
-              LetE ("z", [], PackedTy "Tree" "l",
-                              DataConE "l" "Node"
+              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
+              Ext $ LetLocE (singleLocVar "l1") (AfterConstantLE 1 (singleLocVar "l")) $
+              LetE ("x", [], PackedTy "Tree" (singleLocVar "l1"),
+                              DataConE (singleLocVar "l1") "Leaf" [LitE 1]) $
+              Ext $ LetLocE (singleLocVar "l2") (AfterVariableLE "x" (singleLocVar "l1") False) $
+              LetE ("y", [], PackedTy "Tree" (singleLocVar "l2"),
+                              DataConE (singleLocVar "l2") "Leaf" [LitE 2]) $
+              LetE ("z", [], PackedTy "Tree" (singleLocVar "l"),
+                              DataConE (singleLocVar "l") "Node"
                               [VarE "y", VarE "x"]) $
               LitE 1
 
-        expected = LocationTC "Expected after relationship" (DataConE (Var "l") "Node" [VarE (Var "y"),VarE (Var "x")]) (Var "l") (Var "l2")
+        expected = LocationTC "Expected after relationship" (DataConE (singleLocVar "l") "Node" [VarE (Var "y"),VarE (Var "x")]) (singleLocVar "l") (singleLocVar "l2")
 
 case_test6 :: Assertion
 case_test6 =  assertValue exp (IntTy,LocationTypeState {tsmap = M.fromList []})
   where exp = Ext $ LetRegionE (VarR "r") Undefined Nothing $
-              Ext $ LetLocE "l" (StartOfRegionLE (VarR "r")) $
-              Ext $ LetLocE "l1" (AfterConstantLE 1 "l") $
-              LetE ("x", [], PackedTy "Tree" "l1",
-                              DataConE "l1" "Leaf" [LitE 1]) $
-              Ext $ LetLocE "l2" (AfterVariableLE "x" "l1" False) $
-              LetE ("y", [], PackedTy "Tree" "l2",
-                              DataConE "l2" "Leaf" [LitE 2]) $
-              LetE ("z", [], PackedTy "Tree" "l",
-                              DataConE "l" "Node" [VarE "x",
+              Ext $ LetLocE (singleLocVar "l") (StartOfRegionLE (VarR "r")) $
+              Ext $ LetLocE (singleLocVar "l1") (AfterConstantLE 1 (singleLocVar "l")) $
+              LetE ("x", [], PackedTy "Tree" (singleLocVar "l1"),
+                              DataConE (singleLocVar "l1") "Leaf" [LitE 1]) $
+              Ext $ LetLocE (singleLocVar "l2") (AfterVariableLE "x" (singleLocVar "l1") False) $
+              LetE ("y", [], PackedTy "Tree" (singleLocVar "l2"),
+                              DataConE (singleLocVar "l2") "Leaf" [LitE 2]) $
+              LetE ("z", [], PackedTy "Tree" (singleLocVar "l"),
+                              DataConE (singleLocVar "l") "Node" [VarE "x",
                                                              VarE "y"]) $
               CaseE (VarE "z")
-              [ ("Leaf",[("num","lnum")], VarE "num")
-              , ("Node",[("x","lnodex"),("y","lnodey")],
+              [ ("Leaf",[("num",(singleLocVar "lnum"))], VarE "num")
+              , ("Node",[("x",(singleLocVar "lnodex")),("y",(singleLocVar "lnodey"))],
                  LitE 0)]
 
 -- | Return type of a function is updated with locVars at the call-site
 case_copy_on_add1 :: Assertion
-case_copy_on_add1 = PackedTy "Tree" (Var "lout21") @=? (arrOut funTy)
+case_copy_on_add1 = PackedTy "Tree" (singleLocVar "lout21") @=? (arrOut funTy)
   where Prog{fundefs} = fst $ defaultPackedRunPassM $ tcProg copyOnId1Prog
         FunDef{funTy} = fundefs ! "id1WithCopy"
 

diff --git a/gibbon-compiler/tests/RouteEnds.hs b/gibbon-compiler/tests/RouteEnds.hs
@@ -64,7 +64,7 @@ assertRouteEnds prg fnName expected = expected @=? lRets
 
 -- | add1 reaches the end of its input
 case_add1_test2 :: Assertion
-case_add1_test2  = assertRouteEnds add1Prog "add1" [EndOf $ LRM "lin2" (VarR "r3") Input]
+case_add1_test2  = assertRouteEnds add1Prog "add1" [EndOf $ LRM (singleLocVar "lin2") (VarR "r3") Input]
 
 {-
 
@@ -85,13 +85,13 @@ case_id2 = assertRouteEnds id2Prog "id2" []
 
 -- | copyTree does
 case_copyTree :: Assertion
-case_copyTree = assertRouteEnds copyTreeProg "copyTree" [EndOf $ LRM "lin23" (VarR "r24") Input]
+case_copyTree = assertRouteEnds copyTreeProg "copyTree" [EndOf $ LRM (singleLocVar "lin23") (VarR "r24") Input]
 
 case_id3 :: Assertion
 case_id3 = assertRouteEnds id3Prog "id3" []
 
 case_copy_on_id1 :: Assertion
-case_copy_on_id1 = assertRouteEnds copyOnId1Prog "id1WithCopy" [EndOf $ LRM "lin19" (VarR "r20") Input]
+case_copy_on_id1 = assertRouteEnds copyOnId1Prog "id1WithCopy" [EndOf $ LRM (singleLocVar "lin19") (VarR "r20") Input]
 
 -- |
 routeEnds2Tests :: TestTree