Fix issue #47: type promotion in module scope.

src/eberon/eberon_context.js

@@ -553,6 +553,13 @@ var RecordDecl = Context.RecordDecl.extend({
     }
 });
 
+function resetTypePromotionMadeInSeparateStatement(msg){
+    if (!(msg instanceof TransferPromotedTypesMsg))
+        return false;
+    resetPromotedTypes(msg.types);
+    return true;
+}
+
 var ProcOrMethodDecl = Context.ProcDecl.extend({
     init: function EberonContext$ProcOrMethodDecl(parent, stdSymbols){
         Context.ProcDecl.prototype.init.call(this, parent, stdSymbols);
@@ -588,11 +595,8 @@ var ProcOrMethodDecl = Context.ProcDecl.extend({
             return undefined;
         }
 
-        // reset type promotion made in separate statement
-        if (msg instanceof TransferPromotedTypesMsg){
-            resetPromotedTypes(msg.types);
+        if (resetTypePromotionMadeInSeparateStatement(msg))
             return;
-        }
 
         return Context.ProcDecl.prototype.handleMessage.call(this, msg);
     },
@@ -997,6 +1001,18 @@ var For = Context.For.extend({
     }
 });
 
+var ModuleDeclaration = Context.ModuleDeclaration.extend({
+    init: function EberonContext$ModuleDeclaration(context){
+        Context.ModuleDeclaration.prototype.init.call(this, context);
+    },
+    handleMessage: function(msg){
+        if (resetTypePromotionMadeInSeparateStatement(msg))
+            return;
+
+        return Context.ModuleDeclaration.prototype.handleMessage.call(this, msg);
+    }
+});
+
 exports.AddOperator = AddOperator;
 exports.CaseLabel = CaseLabel;
 exports.ConstDecl = ConstDecl;
@@ -1007,6 +1023,7 @@ exports.For = For;
 exports.Identdef = Identdef;
 exports.If = If;
 exports.MethodHeading = MethodHeading;
+exports.ModuleDeclaration = ModuleDeclaration;
 exports.MulOperator = MulOperator;
 exports.AssignmentOrProcedureCall = AssignmentOrProcedureCall;
 exports.Factor = Factor;
@@ -1019,4 +1036,4 @@ exports.TemplValueInit = TemplValueInit;
 exports.Term = Term;
 exports.TypeDeclaration = TypeDeclaration;
 exports.VariableDeclaration = VariableDeclaration;
-exports.While = While;
+exports.While = While;

src/eberon/eberon_grammar.js

@@ -87,7 +87,8 @@ exports.language = {
             While:              EbContext.While,
             If:                 EbContext.If,
             CaseLabel:          EbContext.CaseLabel,
-            Repeat:             EbContext.Repeat
+            Repeat:             EbContext.Repeat,
+            ModuleDeclaration:  EbContext.ModuleDeclaration
         },
         Grammar.reservedWords + " SELF SUPER"
         ),

src/grammar.js

@@ -36,12 +36,6 @@ var ident = function(stream, context){
     return Lexer.ident(stream, context, reservedWords);
 };
 
-var ModuleDeclContext = Context.ModuleDeclaration.extend({
-    init: function Grammar$ModuleDeclContext(context){
-        Context.ModuleDeclaration.prototype.init.call(this, context);
-    }
-});
-
 var qualident = context(and(optional(and(ident, ".")), ident),
                         Context.QualifiedIdentificator);
 var identdef = makeIdentdef(ident);
@@ -222,7 +216,7 @@ result.module
                   result.declarationSequence,
                   optional(and("BEGIN", statementSequence)),
                   required("END", "END expected (MODULE)"), ident, point),
-              ModuleDeclContext);
+              contexts.ModuleDeclaration);
 return result;
 }
 

src/oberon/oberon_grammar.js

@@ -74,7 +74,8 @@ exports.language = {
             While:              Context.While,
             If:                 Context.If,
             CaseLabel:          Context.CaseLabel,
-            Repeat:             Context.Repeat
+            Repeat:             Context.Repeat,
+            ModuleDeclaration:  Context.ModuleDeclaration
         },
         Grammar.reservedWords
         ),

test/expected/eberon/in_place_variables.js

@@ -77,14 +77,26 @@ var RTL$ = {
         var result = new Uint16Array(length);
         result.charCodeAt = function(i){return this[i];};
         return result;
+    },
+    assert: function (condition){
+        if (!condition)
+            throw new Error("assertion failed");
     }
 };
 var m = function (){
-var T = RTL$.extend({
-	init: function T(){
+var Base = RTL$.extend({
+	init: function Base(){
+	}
+});
+var Derived = Base.extend({
+	init: function Derived(){
+		Base.prototype.init.call(this);
+		this.derivedField = 0;
 	}
 });
-var r = new T();
+var r = new Derived();
+var pbVar = null;
+var pdVar = null;
 var i = 0;
 var a = RTL$.makeArray(10, 0);
 
@@ -95,13 +107,13 @@ function p(){
 function void$(){
 }
 
-function valueArgs(r/*T*/, i/*INTEGER*/, a/*ARRAY 10 OF INTEGER*/){
+function valueArgs(r/*Derived*/, i/*INTEGER*/, a/*ARRAY 10 OF INTEGER*/){
 	var v1 = RTL$.clone(r);
 	var v2 = i;
 	var v3 = RTL$.clone(a);
 }
 
-function varArgs(r/*VAR T*/, i/*VAR INTEGER*/, a/*ARRAY 10 OF INTEGER*/){
+function varArgs(r/*VAR Derived*/, i/*VAR INTEGER*/, a/*ARRAY 10 OF INTEGER*/){
 	var v1 = RTL$.clone(r);
 	var v2 = i.get();
 	var v3 = RTL$.clone(a);
@@ -117,4 +129,11 @@ var v8 = void$;
 var do$ = 0;
 var tempRecord = RTL$.clone(r);
 var tempArray = RTL$.clone(a);
+pdVar = new Derived();
+pbVar = pdVar;
+var pb = pbVar;
+if (pb instanceof Derived){
+	pb.derivedField = 123;
+}
+RTL$.assert(!(pb instanceof Derived) || pb.derivedField == 123);
 }();

test/input/eberon/in_place_variables.ob

@@ -1,12 +1,17 @@
 MODULE m;
 
 TYPE
-    T = RECORD
-    END;
+    Base = RECORD END;
+    PBase = POINTER TO Base;
+    Derived = RECORD (Base) derivedField: INTEGER END;
+    PDerived = POINTER TO Derived;
+
     A = ARRAY 10 OF INTEGER;
 
 VAR 
-    r: T;
+    r: Derived;
+    pbVar: PBase;
+    pdVar: PDerived;
     i: INTEGER;
     a: A;
 
@@ -17,14 +22,14 @@ END p;
 PROCEDURE void();
 END void;
 
-PROCEDURE valueArgs(r: T; i: INTEGER; a: A);
+PROCEDURE valueArgs(r: Derived; i: INTEGER; a: A);
 BEGIN
     v1 <- r;
     v2 <- i;
     v3 <- a;
 END valueArgs;
 
-PROCEDURE varArgs(VAR r: T; VAR i: INTEGER; a: A);
+PROCEDURE varArgs(VAR r: Derived; VAR i: INTEGER; a: A);
 BEGIN
     v1 <- r;
     v2 <- i;
@@ -44,4 +49,14 @@ BEGIN
 
     tempRecord <- r;
     tempArray <- a;
+
+    NEW(pdVar);
+    pbVar := pdVar;
+    pb <- pbVar;
+    IF pb IS PDerived THEN
+        pb.derivedField := 123;
+    END;
+
+    ASSERT(~(pb IS PDerived) OR (pb.derivedField = 123));
+
 END m.

test/test_unit_eberon.js

@@ -430,6 +430,7 @@ exports.suite = {
     "type promotion in expression": testWithContext(
         temporaryValues.context,
         temporaryValues.passExpressions(
+             "b IS PDerived",
              "(b IS PDerived) & b.flag",
              "(b IS PDerived) & bVar & b.flag",
              "(b IS PDerived) & (bVar OR b.flag)",
@@ -576,8 +577,12 @@ exports.suite = {
           fail(["PROCEDURE p(a: ARRAY OF INTEGER); BEGIN v <- a; END p;",
                 "cannot initialize variable 'v' with open array"]
               )
-      )/*
-      /*
+      )    /*
+,
+    "FOR variable": testWithContext(
+          context(grammar.statement, ""),
+          pass("FOR i <- 0 TO 10 DO END")
+          ),
     "as references": testWithContext(
           context(grammar.declarationSequence,
                 "TYPE Base = RECORD pBase: POINTER TO Base END; Derived = RECORD (Base) END;"