Diagnose incorect "IS" for non-VAR parameter.

src/context.js

@@ -83,18 +83,41 @@ function promoteExpressionType(context, left, right){
     checkImplicitCast(context.language().types, rightType, leftType);
 }
 
-function checkTypeCast(from, to, msg){
-    if (from instanceof Type.Pointer)
-        from = Type.pointerBase(from);
-    if (to instanceof Type.Pointer)
-        to = Type.pointerBase(to);
-
-    var t = Type.recordBase(to);
-    while (t && t != from)
+function checkTypeCast(fromInfo, fromType, toType, msg){
+    var prefix = "invalid " + msg;
+
+    var pointerExpected = fromType instanceof Type.Pointer;
+    if (!pointerExpected && !(fromType instanceof Type.Record))
+        throw new Errors.Error(
+            prefix + ": POINTER to type or RECORD expected, got '"
+            + fromType.description() + "'");
+
+    if (fromType instanceof Type.Record){
+        if (!(fromInfo instanceof Type.VariableRef))
+            throw new Errors.Error(
+                prefix + ": a value variable cannot be used");
+        if (!(toType instanceof Type.Record))
+            throw new Errors.Error(
+                prefix + ": RECORD type expected as an argument of RECORD " + msg + ", got '"
+              + toType.description() + "'");
+    }
+    else if (fromType instanceof Type.Pointer)
+        if (!(toType instanceof Type.Pointer))
+            throw new Errors.Error(
+                prefix + ": POINTER type expected as an argument of POINTER " + msg + ", got '"
+              + toType.description() + "'");
+
+    if (fromType instanceof Type.Pointer)
+        fromType = Type.pointerBase(fromType);
+    if (toType instanceof Type.Pointer)
+        toType = Type.pointerBase(toType);
+
+    var t = Type.recordBase(toType);
+    while (t && t != fromType)
         t = Type.recordBase(t);
     if (!t)
-        throw new Errors.Error(msg + ": '" + to.description()
-                             + "' is not an extension of '" + from.description() + "'");
+        throw new Errors.Error(prefix + ": '" + toType.description()
+                             + "' is not an extension of '" + fromType.description() + "'");
 }
 
 var ChainedContext = Class.extend({
@@ -384,22 +407,7 @@ exports.Designator = ChainedContext.extend({
             throw new Errors.Error("POINTER TO non-exported RECORD type cannot be dereferenced");
     },
     handleTypeCast: function(type){
-        if (this.__currentType instanceof Type.Record){
-            if (!(this.__info instanceof Type.VariableRef))
-                throw new Errors.Error(
-                    "invalid type cast: a value variable cannot be used in typeguard");
-            if (!(type instanceof Type.Record))
-                throw new Errors.Error(
-                    "invalid type cast: RECORD type expected as an argument of RECORD type guard, got '"
-                  + type.description() + "'");
-        }
-        else if (this.__currentType instanceof Type.Pointer)
-            if (!(type instanceof Type.Pointer))
-                throw new Errors.Error(
-                    "invalid type cast: POINTER type expected as an argument of POINTER type guard, got '"
-                  + type.description() + "'");
-
-        checkTypeCast(this.__currentType, type, "invalid type cast");
+        checkTypeCast(this.__info, this.__currentType, type, "type cast");
 
         var code = this.language().rtl.typeGuard(this.__code, castCode(type, this));
         this.__code = code;
@@ -1209,17 +1217,9 @@ exports.Expression = ChainedContext.extend({
             code = "1 << " + leftCode + " & " + rightCode;
         }
         else if (this.__relation == "IS"){
-            var pointerExpected = leftType instanceof Type.Pointer;
-            if (!pointerExpected && !(leftType instanceof Type.Record))
-                throw new Errors.Error("POINTER to type or RECORD expected before 'IS'");
-
             rightType = unwrapType(rightType);
-            if (!pointerExpected && !(rightType instanceof Type.Record))
-                throw new Errors.Error("RECORD type expected after 'IS'");
-            if (pointerExpected && !(rightType instanceof Type.Pointer))
-                throw new Errors.Error("POINTER to type expected after 'IS'");
-
-            checkTypeCast(leftType, rightType, "invalid type test");
+            var d = leftExpression.designator();
+            checkTypeCast(d ? d.info() : undefined, leftType, rightType, "type test");
             //rightExpression = , rightType);
             resultExpression = op.is(leftExpression, Code.makeExpression(castCode(rightType, this)));
             code = resultExpression.code();

test/test_unit.js

@@ -243,13 +243,13 @@ return {
          ["p1(PBase)", 
           "invalid type cast: 'Base' is not an extension of 'anonymous RECORD'"],
          ["p1(INTEGER)", 
-          "invalid type cast: POINTER type expected as an argument of POINTER type guard, got 'INTEGER'"],
+          "invalid type cast: POINTER type expected as an argument of POINTER type cast, got 'INTEGER'"],
          ["i(Derived)",
-          "invalid type cast: 'Derived' is not an extension of 'INTEGER'"],
+          "invalid type cast: POINTER to type or RECORD expected, got 'INTEGER'"],
          ["vb(Derived)",
-          "invalid type cast: a value variable cannot be used in typeguard"],
+          "invalid type cast: a value variable cannot be used"],
          ["vb(PDerived)",
-          "invalid type cast: a value variable cannot be used in typeguard"])
+          "invalid type cast: a value variable cannot be used"])
     ),
 "NIL": testWithContext(
     context(grammar.expression,
@@ -283,8 +283,10 @@ return {
     fail(["pBase IS pDerived", "type name expected"],
          ["pBase IS TRUE", "type name expected"],
          ["pBase IS vDerived", "type name expected"],
-         ["Derived IS Derived", "POINTER to type or RECORD expected before 'IS'"],
-         ["i IS Derived", "POINTER to type or RECORD expected before 'IS'"],
+         ["Derived IS Derived", 
+          "invalid type test: POINTER to type or RECORD expected, got 'type Derived'"],
+         ["i IS Derived", 
+          "invalid type test: POINTER to type or RECORD expected, got 'INTEGER'"],
          ["p^ IS Derived", 
           "invalid type test: 'Derived' is not an extension of 'anonymous RECORD'"],
          ["p IS PDerived", 
@@ -295,11 +297,26 @@ return {
          "invalid type test: 'Derived' is not an extension of 'Derived'"],
          ["pDerived^ IS Base", 
           "invalid type test: 'Base' is not an extension of 'Derived'"],
-         ["pDerived IS INTEGER", "POINTER to type expected after 'IS'"],
-         ["pBase IS Derived", "POINTER to type expected after 'IS'"],
-         ["pBase^ IS PDerived", "RECORD type expected after 'IS'"]
+         ["pDerived IS INTEGER", 
+          "invalid type test: POINTER type expected as an argument of POINTER type test, got 'INTEGER'"],
+         ["pBase IS Derived", 
+          "invalid type test: POINTER type expected as an argument of POINTER type test, got 'Derived'"],
+         ["pBase^ IS PDerived", 
+          "invalid type test: RECORD type expected as an argument of RECORD type test, got 'PDerived'"]
          )
     ),
+"IS for VAR argument": testWithContext(
+    context(grammar.procedureDeclaration,
+            "TYPE Base = RECORD END; Derived = RECORD (Base) i: INTEGER END;"
+            + "T = RECORD END; TD = RECORD(T) b: Base END;"),
+    pass("PROCEDURE proc(VAR p: Base): BOOLEAN; RETURN p IS Derived END proc"),
+    fail(["PROCEDURE proc(p: Base): BOOLEAN; RETURN p IS Derived END proc",
+          "invalid type test: a value variable cannot be used"],
+         ["PROCEDURE proc(p: TD): BOOLEAN; RETURN p.b IS Derived END proc",
+          "invalid type test: a value variable cannot be used"],
+         ["PROCEDURE proc(VAR p: T):BOOLEAN; RETURN p(TD).b IS Derived END proc",
+          "invalid type test: a value variable cannot be used"])
+    ),
 "BYTE": testWithContext(
     context(grammar.statement,
               "VAR b1, b2: BYTE; i: INTEGER; set: SET; a: ARRAY 3 OF BYTE; ai: ARRAY 3 OF INTEGER;"
@@ -1063,11 +1080,11 @@ return {
             + "T = RECORD END; TD = RECORD(T) b: Base END;"),
     pass("PROCEDURE proc(VAR p: Base); BEGIN p(Derived).i := 1; END proc"),
     fail(["PROCEDURE proc(p: Base); BEGIN p(Derived).i := 1; END proc",
-          "invalid type cast: a value variable cannot be used in typeguard"],
+          "invalid type cast: a value variable cannot be used"],
          ["PROCEDURE proc(p: TD); BEGIN p.b(Derived).i := 1; END proc",
-          "invalid type cast: a value variable cannot be used in typeguard"],
+          "invalid type cast: a value variable cannot be used"],
          ["PROCEDURE proc(VAR p: T); BEGIN p(TD).b(Derived).i := 1; END proc",
-          "invalid type cast: a value variable cannot be used in typeguard"])
+          "invalid type cast: a value variable cannot be used"])
     ),
 "NEW for read only array element fails": testWithContext(
     context(grammar.procedureDeclaration,