From 38fb0baa4eeec8325d85f4c77f416f345d8d8e43 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Thu, 4 Oct 2007 12:40:13 +0000
Subject: [PATCH] Added a test for genAssign in the C and C++ backends, and
 tweaked its implementation to pass the tests

---
 backends/GenerateC.hs     | 35 ++++++++++++++++++++---------------
 backends/GenerateCTest.hs | 26 ++++++++++++++++++++++++++
 2 files changed, 46 insertions(+), 15 deletions(-)

diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs
index 1f7ddf6..4bbd9c0 100644
--- a/backends/GenerateC.hs
+++ b/backends/GenerateC.hs
@@ -64,7 +64,9 @@ instance Die CGen where
 data GenOps = GenOps {
     -- | Declares the C array of sizes for an occam array.
     declareArraySizes :: GenOps -> [A.Dimension] -> A.Name -> CGen (),
+    -- | Generates code when a variable goes out of scope (e.g. deallocating memory).
     declareFree :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
+    -- | Generates code when a variable comes into scope (e.g. allocating memory, initialising variables).
     declareInit :: GenOps -> Meta -> A.Type -> A.Variable -> Maybe (CGen ()),
     declareType :: GenOps -> A.Type -> CGen (),
     -- | Generates an individual parameter to a function\/proc.
@@ -83,6 +85,7 @@ data GenOps = GenOps {
     -- | Generates an array subscript for the given variable (with error checking if the Bool is True), using the given expression list as subscripts
     genArraySubscript :: GenOps -> Bool -> A.Variable -> [A.Expression] -> CGen (),
     genAssert :: GenOps -> Meta -> A.Expression -> CGen (),
+    -- | Generates an assignment statement with a single destination and single source.
     genAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen (),
     genBytesIn :: GenOps -> A.Type -> Maybe A.Variable -> CGen (),
     genBytesIn' :: GenOps -> A.Type -> Maybe A.Variable -> CGen (Maybe Int),
@@ -1480,22 +1483,24 @@ cgenProcess ops p = case p of
 
 --{{{  assignment
 cgenAssign :: GenOps -> Meta -> [A.Variable] -> A.ExpressionList -> CGen ()
-cgenAssign ops m [v] el
-    = case el of
-        A.FunctionCallList _ _ _ -> call genMissing ops "function call"
-        A.ExpressionList _ [e] ->
-          do t <- typeOfVariable v
-             doAssign t v e
+cgenAssign ops m [v] (A.ExpressionList _ [e])
+    = do t <- typeOfVariable v
+         case call getScalarType ops t of
+           Just _ -> doAssign v e
+           Nothing -> case t of
+             -- Assignment of channel-ends, but not channels, is possible (at least in Rain):
+             A.Chan A.DirInput _ _ -> doAssign v e
+             A.Chan A.DirOutput _ _ -> doAssign v e
+             _ -> call genMissingC ops $ formatCode "assignment of type %" t
   where
-    doAssign :: A.Type -> A.Variable -> A.Expression -> CGen ()
-    doAssign t v e
-        = case call getScalarType ops t of
-            Just _ ->
-              do call genVariable ops v
-                 tell [" = "]
-                 call genExpression ops e
-                 tell [";\n"]
-            Nothing -> call genMissingC ops $ formatCode "assignment of type %" t
+    doAssign :: A.Variable -> A.Expression -> CGen ()
+    doAssign v e
+        = do call genVariable ops v
+             tell ["="]
+             call genExpression ops e
+             tell [";"]
+cgenAssign ops m _ _ = call genMissing ops "Cannot perform assignment with multiple destinations or multiple sources"
+
 --}}}
 --{{{  input
 cgenInput :: GenOps -> A.Variable -> A.InputMode -> CGen ()
diff --git a/backends/GenerateCTest.hs b/backends/GenerateCTest.hs
index 607ec11..fe508da 100644
--- a/backends/GenerateCTest.hs
+++ b/backends/GenerateCTest.hs
@@ -498,6 +498,31 @@ testGenVariable = TestList
    testSameA2 :: Int -> (String,String) -> (A.Variable -> A.Variable) -> A.Type -> Test
    testSameA2 n (eO,eA) sub t = TestList [testSame n eO sub A.Original t,testSame (n+1) eA sub A.Abbrev t]
 
+testAssign :: Test
+testAssign = TestList
+ [
+  testBothSameS "testAssign 0" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over) (state A.Int)
+  ,testBothSameS "testAssign 1" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over) (state A.Time)
+  ,testBothSameS "testAssign 2" "@=$;" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
+    (state $ A.Chan A.DirInput (A.ChanAttributes False False) A.Int)
+
+  -- Fail because genAssign only handles one destination and one source:
+  ,testBothFail "testAssign 100" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo,A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e]))
+  ,testBothFail "testAssign 101" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e,e]))
+  ,testBothFail "testAssign 102" (tcall3 genAssign emptyMeta [A.Variable emptyMeta foo,A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e, e]))
+  
+  -- Fail because assignment can't be done with these types (should have already been transformed away):
+  ,testBothFailS "testAssign 200" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
+    (state $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Int)
+  ,testBothFailS "testAssign 201" ((tcall3 genAssign emptyMeta [A.Variable emptyMeta foo] (A.ExpressionList emptyMeta [e])) . over)
+    (state $ A.Record bar)
+ ]
+ where
+   --The expression won't be examined so we can use what we like:
+   e = A.True emptyMeta
+   state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t
+   over ops = ops {genVariable = override1 at, genExpression = override1 dollar}
+
 ---Returns the list of tests:
 tests :: Test
 tests = TestList
@@ -505,6 +530,7 @@ tests = TestList
    testActuals
    ,testArraySizes
    ,testArraySubscript
+   ,testAssign
    ,testDeclaration
    ,testDeclareInitFree
    ,testGenType