resolve-check step 4d: re-check forward-tainted assignments

The parser cannot type-check an assignment whose operand is a forward
reference (the type is unknown at that point), so e.g. `n := "abc"`
with a later `VAR n : INTEGER` was silently accepted.  PropNode now
returns whether a subtree was touched by a forward reference (a forward
designator node is marked Op=1; a node PropNode re-types also counts),
and an assignment statement so touched is re-checked (Assignable / class)
using the resolved AST types.

Non-forward assignments are unaffected - the parser still checks them, so
there are no duplicate diagnostics - and -noresolve keeps full checking.
New expect_fail test t_bad_fwd.mod.

Suite 193/193; fixpoint OK (3,491,608 bytes).

compiler/run_tests.sh

@@ -158,6 +158,7 @@ expect_fail t_bad_exit.mod "not supported yet"
 expect_fail t_bad_return.mod "bad RETURN"
 expect_fail t_bad_for.mod "FOR needs integer variable and bounds"
 expect_fail t_bad_mixed.mod "incompatible assignment"
+expect_fail t_bad_fwd.mod "incompatible assignment"
 expect_fail t_bad_overlong.mod "invalid UTF-8"
 expect_fail t_bad_surrogate.mod "invalid UTF-8"
 expect_fail t_bad_utf8big.mod "invalid UTF-8"

compiler/src/Check.mod

@@ -106,25 +106,48 @@ BEGIN
   RETURN t
 END EvalExpr;
 
-PROCEDURE PropNode (n: AST.Node);
+PROCEDURE CheckAssign (n: AST.Node);
+(* Re-check a designator assignment whose operand types were unknown at
+   parse time (a forward reference): the parser skipped it. *)
+  VAR lt, vt: SymTab.TypeIndex;
+BEGIN
+  IF AST.Child(n, 0) < 0 THEN RETURN END;
+  IF AST.Kind(AST.Child(n, 0)) # AST.NkDesignator THEN RETURN END;
+  lt := AST.Ty(AST.Child(n, 0));
+  vt := AST.Ty(AST.Child(n, 1));
+  IF (lt = SymTab.InvalidType) OR (vt = SymTab.InvalidType) THEN RETURN END;
+  IF NOT SymTab.Assignable(vt, lt) THEN
+    M2S.Error(210, M2S.line, M2S.col, M2S.pos)
+  ELSIF SymTab.ClassOf(lt) = SymTab.ClClass THEN
+    M2S.Error(230, M2S.line, M2S.col, M2S.pos)
+  END
+END CheckAssign;
+
+PROCEDURE PropNode (n: AST.Node): BOOLEAN;
 (* Post-order: re-type any expression node whose type is still unknown
-   (i.e. one whose operands included a forward reference). *)
-  VAR i: CARDINAL; k: INTEGER; t: SymTab.TypeIndex;
+   (i.e. one whose operands included a forward reference), and re-check an
+   assignment statement whose operands were so affected.  Returns TRUE
+   when this subtree was touched by a forward reference. *)
+  VAR i: CARDINAL; k: INTEGER; t: SymTab.TypeIndex; tn: BOOLEAN;
 BEGIN
-  IF n < 0 THEN RETURN END;
+  IF n < 0 THEN RETURN FALSE END;
   k := AST.Kind(n);
   IF (k >= AST.NkIdent) AND (k <= AST.NkCharLit) THEN
-    RETURN   (* a leaf: child 0 is a text index, not a node *)
+    RETURN FALSE   (* a leaf: child 0 is a text index, not a node *)
   END;
+  tn := (k = AST.NkDesignator) AND (AST.Op(n) = 1);
   i := 0;
   WHILE i < AST.NChild(n) DO
-    PropNode(AST.Child(n, i)); INC(i)
+    IF PropNode(AST.Child(n, i)) THEN tn := TRUE END;
+    INC(i)
   END;
   IF (k >= AST.NkBinExpr) AND (k <= AST.NkSetLit)
      AND (AST.Ty(n) = -1) THEN
     t := EvalExpr(n);
-    IF t # -1 THEN AST.SetTy(n, t) END
-  END
+    IF t # -1 THEN AST.SetTy(n, t); tn := TRUE END
+  END;
+  IF (k = AST.NkAssign) AND tn THEN CheckAssign(n) END;
+  RETURN tn
 END PropNode;
 
 PROCEDURE BeginSession (progName: ARRAY OF CHAR);
@@ -170,9 +193,10 @@ BEGIN
 END FlushForward;
 
 PROCEDURE Resolve (unit: AST.Node);
+  VAR touched: BOOLEAN;
 BEGIN
   FlushForward;
-  PropNode(unit)
+  touched := PropNode(unit)
 END Resolve;
 
 PROCEDURE EndSession;

compiler/tests/t_bad_fwd.mod

@@ -0,0 +1,12 @@
+MODULE TBadFwd;
+// A forward module-level variable assigned an incompatible value: the
+// parser cannot check it (the type is unknown when the assignment is
+// parsed), so the resolve pass must.  Expects "incompatible assignment".
+VAR ExitCode : INTEGER;
+
+PROCEDURE P;
+BEGIN n := "abc" END P;
+
+VAR n : INTEGER;
+
+BEGIN P; ExitCode := 0 END TBadFwd.