Code generation for CASE by type.

Fix code generation for pointer derefernce when passed as VAR argument.

src/ob/ContextCase.ob

@@ -1,7 +1,8 @@
 MODULE ContextCase;
 IMPORT
-    Cast, Chars, CodeGenerator, ConstValue, ContextExpression, ContextHierarchy, 
-    Errors, Expression, Record, Scope, String, Symbols, TypeId, Types, Variable;
+    Cast, Chars, CodeGenerator, ConstValue, ContextExpression, ContextHierarchy,
+    Designator, Errors, Expression, 
+    Record, Scope, String, Symbols, TypeId, Types, Variable;
 TYPE
     Type* = RECORD(ContextExpression.ExpressionHandler)
         PROCEDURE Type(parent: ContextHierarchy.PNode);
@@ -9,6 +10,7 @@ TYPE
         PROCEDURE beginCase();
         PROCEDURE handleLabelType(type: Types.PType);
 
+        mCodeGenerator: CodeGenerator.PIGenerator;
         var: STRING;
         type: Types.PType;
         guardVar: Types.PDeclaredVariable;
@@ -43,41 +45,69 @@ TYPE
 
 PROCEDURE Type.Type(parent: ContextHierarchy.PNode)
     | SUPER(parent),
-      var(SELF.root().currentScope().generateTempVar("case"));
-BEGIN
-    SELF.codeGenerator().write("var " + SELF.var + " = ");
+      mCodeGenerator(CodeGenerator.nullGenerator);
+END;
+
+PROCEDURE Type.codeGenerator(): CodeGenerator.PIGenerator;
+    RETURN SELF.mCodeGenerator;
 END;
 
 PROCEDURE Type.handleExpression(e: Expression.PType);
 VAR
     c: CHAR;
+    declVar: Types.PDeclaredVariable;
+
+    PROCEDURE infoFromExpression(): Types.PId;
+    VAR
+        result: Types.PId;
+    BEGIN
+        d <- e.designator();
+        IF d # NIL THEN
+            result := d.info();
+        END;
+        RETURN result;
+    END;
+
 BEGIN
+    normExp <- e;
     type <- e.type();
-    gen <- SELF.codeGenerator();
     IF (type IS Types.PString) & Types.stringAsChar(type^, c) THEN
-        gen.write(String.fromChar(c));
-        SELF.type := Types.basic.ch;
-    ELSIF Types.isInt(type) OR (type = Types.basic.ch) THEN
-        SELF.type := type;
-    ELSIF (type IS Record.PPointer) OR (type IS Types.PRecord) THEN
-        d <- e.designator();
-        IF d # NIL THEN
-            info <- e.designator().info();
-            IF info IS Types.PVariable THEN
-                IF ~info.isReference() & (type IS Types.PRecord) THEN
-                    Errors.raise("only records passed as VAR argument can be used to test type in CASE");
-                END;
-                IF info IS Types.PDeclaredVariable THEN
-                    SELF.guardVar := info;
-                END;
+        normExp := Expression.makeSimple(String.fromInt(ORD(c)), Types.basic.ch);
+    ELSE
+        info <- infoFromExpression();
+        IF info IS Types.PDeclaredVariable THEN
+            declVar := info;
+            IF ~info.isReference() THEN
+                SELF.var := declVar.id();
             END;
         END;
-        SELF.typeTest := e;
-    ELSE
-        Errors.raise("'RECORD' or 'POINTER' or "
-                     + Types.intsDescription() + " or 'CHAR' expected as CASE expression");
+
+        IF (type IS Types.PRecord) OR (type IS Record.PPointer) THEN
+            isReference <- (info IS Types.PVariable) & info.isReference();
+            IF (type IS Types.PRecord) & ~isReference THEN
+                Errors.raise("only records passed as VAR argument can be used to test type in CASE");
+            ELSIF ~(type IS Record.PPointer) OR ~isReference THEN
+                SELF.guardVar := declVar;
+            END;
+
+            SELF.typeTest := e;
+        ELSIF ~Types.isInt(type) & (type # Types.basic.ch) THEN
+            Errors.raise("'RECORD' or 'POINTER' or "
+                         + Types.intsDescription() + " or 'CHAR' expected as CASE expression");
+        END;
+    END;
+
+    SELF.type := normExp.type();
+
+    SELF.mCodeGenerator := SELF.parent().codeGenerator();
+    IF LEN(SELF.var) = 0 THEN
+        SELF.var := SELF.root().currentScope().generateTempVar("case");
+        SELF.mCodeGenerator.write("var " + SELF.var + " = " + Expression.deref(normExp).code() + ";" + Chars.ln);
+        
+        IF SELF.typeTest # NIL THEN
+            SELF.typeTest := Expression.makeSimple(SELF.var, type);
+        END;
     END;
-    gen.write(";" + Chars.ln);
 END;
 
 PROCEDURE Type.beginCase();
@@ -106,12 +136,14 @@ BEGIN
         parent.caseLabelBegin();
     END;
 
-    v <- parent.parent()^(Type).var;
-    IF to = NIL THEN
-        cond := v + " === " + String.fromInt(from.value);
-    ELSE
-        cond := "(" + v + " >= " + String.fromInt(from.value)
-              + " && " + v + " <= " + String.fromInt(to.value) + ")";
+    IF from # NIL THEN
+        v <- parent.parent()^(Type).var;
+        IF to = NIL THEN
+            cond := v + " === " + String.fromInt(from.value);
+        ELSE
+            cond := "(" + v + " >= " + String.fromInt(from.value)
+                  + " && " + v + " <= " + String.fromInt(to.value) + ")";
+        END;
     END;
 
     SELF.codeGenerator().write(SELF.glue + cond);
@@ -143,6 +175,7 @@ END;
 
 PROCEDURE Label.handleTypeGuard(e: Expression.PType; info: TypeId.PType);
 BEGIN
+    SELF.caseLabelBegin();
     guardVar <- contextFromLabel(SELF).guardVar;
     IF guardVar # NIL THEN
         root <- SELF.root();

src/ob/ContextDesignator.ob

@@ -122,6 +122,11 @@ BEGIN
             Errors.raise("POINTER TO non-exported RECORD type cannot be dereferenced");
         END;
         designator.currentType := base;
+
+        info <- designator.info;
+        IF (info IS Types.PVariable) & info.isReference() THEN
+            designator.code := Expression.derefCode(designator.code);
+        END;
     ELSE
         Errors.raise("POINTER TO type expected, got '"
                      + designator.currentType.description() + "'");

src/ob/ContextExpression.ob

@@ -291,7 +291,7 @@ BEGIN
     END;
 
     IF ~pointerExpected THEN
-        IF ~fromInfo.isReference() THEN
+        IF (fromInfo # NIL) & ~fromInfo.isReference() THEN
             Errors.raise(
                 prefix + ": a value variable cannot be used");
         ELSIF ~(toType IS Record.PType) THEN

src/ob/Expression.ob

@@ -89,6 +89,10 @@ PROCEDURE makeSimple*(code: STRING; type: Types.PType): PType;
     RETURN make(code, type, NIL, NIL)
 END;
 
+PROCEDURE derefCode*(code: STRING): STRING;
+    RETURN code + ".get()";
+END;
+
 PROCEDURE deref*(e: PType): PType;
 BEGIN
     result <- e;
@@ -99,7 +103,7 @@ BEGIN
         
         info <- designator.info();
         IF ((info IS Types.PVariable) & info.isReference()) THEN
-            result := makeSimple(e.code() + ".get()", type);
+            result := makeSimple(derefCode(e.code()), type);
         END;
     END;
     RETURN result

test/expected/case.js

@@ -1,74 +1,143 @@
+<rtl code>
 var m = function (){
 var ch1 = "a";
 var constI = 12;
+function Base(){
+}
+function Derived(){
+	Base.call(this);
+	this.i = 0;
+}
+RTL$.extend(Derived, Base);
+function Derived2(){
+	Base.call(this);
+	this.i2 = 0;
+}
+RTL$.extend(Derived2, Base);
+function T(){
+	this.b = null;
+}
 var i = 0;
 var b1 = false;
 var i1 = 0;
 var byte = 0;
 var c = 0;
-var $case1 = i1;
-var $case2 = i1;
-var $case3 = i1;
-if ($case3 === 1){
+
+function caseIntByVar(i/*VAR INTEGER*/){
+	var $case1 = i.get();
+	if ($case1 === 1){
+		i.set(1);
+	}
+}
+
+function casePointer(p/*PBase*/){
+	if (p instanceof Derived){
+	}
+	if (p instanceof Derived){
+		p.i = 0;
+	}
+	if (p instanceof Derived){
+		p.i = 0;
+	}
+	else if (p instanceof Derived2){
+		p.i2 = 0;
+	}
+}
+
+function caseExpression(r/*T*/){
+	var $case1 = r.b;
+	if ($case1 instanceof Derived){
+	}
+	else if ($case1 instanceof Derived2){
+	}
+}
+
+function casePointerDereference(p/*PBase*/){
+	var $case1 = p;
+	if ($case1 instanceof Derived){
+	}
+	else if ($case1 instanceof Derived2){
+	}
+}
+
+function casePointerByVar(p/*VAR PBase*/){
+	var $case1 = p.get();
+	if ($case1 instanceof Derived){
+	}
+	else if ($case1 instanceof Derived2){
+	}
+}
+if (i1 === 1){
 	b1 = false;
 }
-var $case4 = 123;
-if ($case4 === 1){
+var $case1 = 123;
+if ($case1 === 1){
 	b1 = true;
 }
-var $case5 = i1;
-if ($case5 === 1){
+if (i1 === 1){
 	i = 2;
 }
-else if ($case5 === 2){
+else if (i1 === 2){
 	i = 3;
 	b1 = false;
 }
-var $case6 = i1;
-if ($case6 === 1){
+if (i1 === 1){
 	i = 2;
 }
-else if ($case6 === 2){
+else if (i1 === 2){
 	i = 3;
 	b1 = false;
 }
-var $case7 = i1;
-if ($case7 === 1 || $case7 === 2 || $case7 === 3){
+if (i1 === 1 || i1 === 2 || i1 === 3){
 	i = 4;
 }
-else if ($case7 === 12){
+else if (i1 === 12){
 	i = constI;
 }
-else if (($case7 >= 4 && $case7 <= 5)){
+else if ((i1 >= 4 && i1 <= 5)){
 	i = 5;
 }
-else if ($case7 === 6 || ($case7 >= 7 && $case7 <= 10)){
+else if (i1 === 6 || (i1 >= 7 && i1 <= 10)){
 	b1 = true;
 }
-var $case8 = byte;
-if ($case8 === 1){
+if (byte === 1){
 	i = 2;
 }
-else if ($case8 === 257){
+else if (byte === 257){
 	i = 3;
 }
-else if (($case8 >= 4 && $case8 <= 12)){
+else if ((byte >= 4 && byte <= 12)){
 	i = 5;
 }
-var $case9 = c;
-if ($case9 === 65){
+if (c === 65){
 	i = 1;
 }
-else if ($case9 === 97){
+else if (c === 97){
 	i = 2;
 }
-else if ($case9 === 66 || $case9 === 67){
+else if (c === 66 || c === 67){
 	i = 2;
 }
-else if (($case9 >= 68 && $case9 <= 70) || $case9 === 73 || $case9 === 74){
+else if ((c >= 68 && c <= 70) || c === 73 || c === 74){
 	i = 3;
 }
-else if (($case9 >= 75 && $case9 <= 90)){
+else if ((c >= 75 && c <= 90)){
 	b1 = true;
 }
+var $case2 = 97;
+if ($case2 === 65){
+	i = 1;
+}
+var $case3 = 65;
+if ($case3 === 97){
+	i = 1;
+}
+var $case4 = constI;
+if ($case4 === 1){
+	i = 1;
+}
+var $case5 = 123;
+if ($case5 === 1){
+	i = 1;
+}
 }();

test/expected/pointer.js

@@ -1,3 +1,4 @@
+<rtl code>
 var m = function (){
 function T(){
 	this.p = null;
@@ -8,12 +9,19 @@ function T2(){
 }
 function Forward(){
 }
+var p = null;
 var r = new T();
 var r2 = null;
 var pf = null;
 function anonymous$1(){
 }
 var pAnonymous = null;
+
+function passByRef(p/*VAR PT*/){
+	p.get().i = 0;
+	passByRef(p);
+	passByRef(RTL$.makeRef(p.get(), "p"));
+}
 r.p = new T();
 r.p.p = new T();
 r.p.i = 123;
@@ -21,4 +29,5 @@ r2 = new T2();
 r2.p = new T();
 pf = new Forward();
 pAnonymous = new anonymous$1();
+passByRef({set: function($v){p = $v;}, get: function(){return p;}});
 }();

test/input/case.ob

@@ -4,12 +4,88 @@ CONST
 	ch1 = "a";
 	constI = 12;
 
+TYPE
+	Base = RECORD
+	END;
+	PBase = POINTER TO Base;
+
+	Derived = RECORD(Base)
+		i: INTEGER
+	END;
+	PDerived = POINTER TO Derived;
+
+	Derived2 = RECORD(Base)
+		i2: INTEGER
+	END;
+	PDerived2 = POINTER TO Derived2;
+
+	T = RECORD
+		b: PBase
+	END;
+
 VAR i: INTEGER;
 	b1: BOOLEAN;
 	i1: INTEGER;
 	byte: BYTE;
 	c: CHAR;
 
+PROCEDURE caseIntByVar(VAR i: INTEGER);
+BEGIN
+	CASE i OF
+		| 1:
+		i := 1;
+	END;
+END caseIntByVar;
+
+PROCEDURE casePointer(p: PBase);
+BEGIN
+	CASE p OF END;
+
+	CASE p OF
+		|
+	END;
+
+	CASE p OF
+		| PDerived:
+	END;
+
+	CASE p OF
+		| PDerived:
+			p.i := 0;
+	END;
+
+	CASE p OF
+		| PDerived:
+			p.i := 0;
+		| PDerived2:
+			p.i2 := 0;
+	END;
+END casePointer;
+
+PROCEDURE caseExpression(r: T);
+BEGIN
+	CASE r.b OF
+		| PDerived:
+		| PDerived2:
+	END;
+END caseExpression;
+
+PROCEDURE casePointerDereference(p: PBase);
+BEGIN
+	CASE p^ OF
+		| Derived:
+		| Derived2:
+	END;
+END casePointerDereference;
+
+PROCEDURE casePointerByVar(VAR p: PBase);
+BEGIN
+	CASE p OF
+		| PDerived:
+		| PDerived2:
+	END;
+END casePointerByVar;
+
 BEGIN    
 	CASE i1 OF END;
 
@@ -52,6 +128,22 @@ BEGIN
 		| "B", "C": i := 2
 		| "D".."F", "I", "J": i:=3
 		| "K".."Z": b1:= TRUE
+	END;
+
+	CASE ch1 OF
+		  "A": i := 1
+	END;
+
+	CASE "A" OF
+		  ch1: i := 1
+	END;
+
+	CASE constI OF
+		  1: i := 1
+	END;
+
+	CASE 123 OF
+		  1: i := 1
 	END
 
 END m.

test/input/pointer.ob

@@ -1,16 +1,26 @@
 MODULE m;
 TYPE
 	T = RECORD p: POINTER TO T; i: INTEGER END;
+	PT = POINTER TO T;
+
 	T2 = POINTER TO RECORD p: POINTER TO T END;
 
     PForward = POINTER TO Forward;
     Forward = RECORD END;
 VAR
+	p: POINTER TO T;
 	r: T;
 	r2: T2;
 	pf: PForward;
 	pAnonymous: POINTER TO RECORD END;
 
+PROCEDURE passByRef(VAR p: PT);
+BEGIN
+	p.i := 0;
+	passByRef(p);
+	passByRef(p.p);
+END passByRef;
+
 BEGIN
 	NEW(r.p);
     NEW(r.p.p);
@@ -22,4 +32,6 @@ BEGIN
 	NEW(pf);
 
 	NEW(pAnonymous);
+
+	passByRef(p);
 END m.

test/test_unit.js

@@ -700,11 +700,14 @@ return {
     ),
 "CASE statement with type guard for VAR argument": testWithContext(
     context(grammar.declarationSequence,
-              "TYPE Base = RECORD END; Derived = RECORD (Base) i: INTEGER END; PDerived = POINTER TO Derived;"),
+              "TYPE Base = RECORD END; Derived = RECORD (Base) i: INTEGER END; PBase = POINTER TO Base; PDerived = POINTER TO Derived;"),
     pass("PROCEDURE p(VAR b: Base); BEGIN CASE b OF END END p;",
+         "PROCEDURE p(VAR b: Base); BEGIN CASE b OF Derived: END END p;",
+         "PROCEDURE p(VAR b: PBase); BEGIN CASE b OF PDerived: END END p;",
          "PROCEDURE p(VAR b: Base); BEGIN CASE b OF Derived: b.i := 0 END END p;"
         ),
-    fail(["PROCEDURE p(b: Base); BEGIN CASE b OF END END p;", "only records passed as VAR argument can be used to test type in CASE"])
+    fail(["PROCEDURE p(b: Base); BEGIN CASE b OF END END p;", "only records passed as VAR argument can be used to test type in CASE"],
+         ["PROCEDURE p(VAR b: PBase); BEGIN CASE b OF PDerived: b.i := 0 END END p;", "type 'Base' has no 'i' field"])
     ),
 "CASE statement with type guard scope": testWithContext(
     context(grammar.declarationSequence,