Original oberon report refinement:

Non-exported record types cannot be allocated (NEW) in other modules (using exported pointer type).
Support opaque data types.

src/context.js

@@ -30,10 +30,14 @@ function getSymbol(context, id){
     return getSymbolAndScope(context, id).symbol();
 }
 
-function unwrapType(type){
+function unwrapTypeId(type){
     if (!(type instanceof Type.TypeId))
         throw new Errors.Error("type name expected");
-    return type.type();
+    return type;
+}
+
+function unwrapType(type){
+    return unwrapTypeId(type).type();
 }
 
 function getTypeSymbol(context, id){
@@ -340,6 +344,8 @@ exports.Designator = ChainedContext.extend({
             throw new Errors.Error("POINTER TO type expected, got '"
                                  + this.__currentType.description() + "'");
         this.__currentType = this.__currentType.baseType();
+        if (!this.__currentType)
+            throw new Errors.Error("non-exported RECORD type cannot be dereferenced");
     },
     handleTypeCast: function(type){
         if (this.__currentType instanceof Type.Record){
@@ -395,18 +401,29 @@ exports.Designator = ChainedContext.extend({
 });
 
 exports.Type = ChainedContext.extend({
-    init: function TypeContext(context){
+    init: function Context$Type(context){
         ChainedContext.prototype.init.call(this, context);
     },
-    handleSymbol: function(s){this.setType(unwrapType(s.symbol().info()));}
+    handleSymbol: function(s){
+        this.parent().handleSymbol(s);
+    }
 });
 
-exports.FormalType = exports.Type.extend({
+var HandleSymbolAsType = ChainedContext.extend({
+    init: function Context$HandleSymbolAsType(context){
+        ChainedContext.prototype.init.call(this, context);
+    },
+    handleSymbol: function(s){
+        this.setType(unwrapType(s.symbol().info()));
+    }
+});
+
+exports.FormalType = HandleSymbolAsType.extend({
     init: function FormalType(context){
-        exports.Type.prototype.init.call(this, context);
+        HandleSymbolAsType.prototype.init.call(this, context);
         this.__arrayDimension = 0;
     },
-    setType: function(type){
+    setType: function(type){           
         for(var i = 0; i < this.__arrayDimension; ++i)
             type = new Type.Array("ARRAY OF " + type.name()
                                , undefined
@@ -556,9 +573,9 @@ exports.Return = ChainedContext.extend({
     }
 });
 
-exports.ProcParams = ChainedContext.extend({
-    init: function ProcParamsContext(context){
-        ChainedContext.prototype.init.call(this, context);
+exports.ProcParams = HandleSymbolAsType.extend({
+    init: function Context$ProcParams(context){
+        HandleSymbolAsType.prototype.init.call(this, context);
         this.__isVar = false;
         this.__argNamesForType = [];
     },
@@ -579,21 +596,33 @@ exports.ProcParams = ChainedContext.extend({
 });
 
 exports.PointerDecl = ChainedContext.extend({
-    init: function PointerDecl(context){
+    init: function Context$PointerDecl(context){
         ChainedContext.prototype.init.call(this, context);
     },
-    setType: function(type){
-        if (!(type instanceof Type.ForwardRecord) && !(type instanceof Type.Record))
-            throw new Errors.Error(
-                "RECORD is expected as a POINTER base type, got '" + type.description() + "'");
+    handleSymbol: function(s){
+        var typeId = unwrapTypeId(s.symbol().info());
+        this.__setTypeId(typeId);
+    },
+    __setTypeId: function(typeId){
+        if (!(typeId instanceof Type.ForwardTypeId)){
+            var type = typeId.type();
+            if (!(type instanceof Type.Record))
+                throw new Errors.Error(
+                    "RECORD is expected as a POINTER base type, got '" + type.description() + "'");
+        }
 
         var parent = this.parent();
         var name = parent.isAnonymousDeclaration() 
             ? undefined
             : parent.genTypeName();
-        var pointerType = new Type.Pointer(name, type);
+        var pointerType = new Type.Pointer(name, typeId);
         parent.setType(pointerType);
     },
+    setType: function(type){
+        var typeId = new Type.TypeId(type);
+        this.currentScope().addType(typeId);
+        this.__setTypeId(typeId);
+    },
     findSymbol: function(id){
         var parent = this.parent();
         var existing = parent.findSymbol(id);
@@ -604,9 +633,8 @@ exports.PointerDecl = ChainedContext.extend({
         scope.addUnresolved(id);
         var resolve = function(){return getSymbol(parent, id).info().type();};
 
-        var type = new Type.ForwardRecord(resolve);
         return new Symbol.Found(
-            new Symbol.Symbol(id, new Type.TypeId(type)),
+            new Symbol.Symbol(id, new Type.ForwardTypeId(resolve)),
             scope
             );
     },
@@ -614,9 +642,9 @@ exports.PointerDecl = ChainedContext.extend({
     exportField: function(field){this.parent().exportField(field);}
 });
 
-exports.ArrayDecl = ChainedContext.extend({
-    init: function ArrayDeclContext(context){
-        ChainedContext.prototype.init.call(this, context);
+exports.ArrayDecl = HandleSymbolAsType.extend({
+    init: function Context$ArrayDecl(context){
+        HandleSymbolAsType.prototype.init.call(this, context);
         this.__dimensions = undefined;
     },
     handleDimensions: function(dimensions){this.__dimensions = dimensions;},
@@ -1394,9 +1422,9 @@ function checkIfFieldCanBeExported(name, idents, hint){
     }
 }
 
-exports.VariableDeclaration = ChainedContext.extend({
-    init: function VariableDeclarationContext(context){
-        ChainedContext.prototype.init.call(this, context);
+exports.VariableDeclaration = HandleSymbolAsType.extend({
+    init: function Context$VariableDeclaration(context){
+        HandleSymbolAsType.prototype.init.call(this, context);
         this.__idents = [];
         this.__type = undefined;
     },
@@ -1427,9 +1455,9 @@ exports.VariableDeclaration = ChainedContext.extend({
     }
 });
 
-exports.FieldListDeclaration = ChainedContext.extend({
-    init: function FieldListDeclarationContext(context){
-        ChainedContext.prototype.init.call(this, context);
+exports.FieldListDeclaration = HandleSymbolAsType.extend({
+    init: function Context$FieldListDeclaration(context){
+        HandleSymbolAsType.prototype.init.call(this, context);
         this.__idents = [];
         this.__type = undefined;
     },
@@ -1593,17 +1621,16 @@ exports.TypeDeclaration = ChainedContext.extend({
     init: function TypeDeclarationContext(context){
         ChainedContext.prototype.init.call(this, context);
         this.__id = undefined;
-        this.__typeId = undefined;
         this.__symbol = undefined;
     },
     handleIdentef: function(id){
+        var typeId = new Type.LazyTypeId();
+        var symbol = this.currentScope().addType(typeId, id);
         this.__id = id;
-        this.__typeId = new Type.LazyTypeId();
-        this.__symbol = new Symbol.Symbol(this.__id.id(), this.__typeId);
-        this.currentScope().addSymbol(this.__symbol, this.__id.exported());
+        this.__symbol = symbol;
     },
     setType: function(type){
-        this.__typeId.define(type);
+        this.__symbol.info().define(type);
         this.currentScope().resolve(this.__symbol);
     },
     typeName: function(){return this.__id.id();},
@@ -1687,6 +1714,7 @@ exports.ModuleDeclaration = ChainedContext.extend({
         }
         else if (id === this.__name){
             var scope = this.parent().currentScope();
+            scope.strip();
             var exports = scope.exports();
             scope.module().info().defineExports(exports);
             var gen = this.codeGenerator();

src/procedure.js

@@ -307,6 +307,8 @@ exports.predefined = [
                     throw new Errors.Error("POINTER variable expected, got '"
                                          + type.name() + "'");
                 this.__baseType = type.baseType();
+                if (this.__baseType === undefined)
+                    throw new Errors.Error("non-exported RECORD type cannot be used in NEW");
                 return new CheckArgumentResult(type, false);
             },
             epilog: function(){
@@ -320,7 +322,7 @@ exports.predefined = [
         var name = "NEW";
         var args = [new Arg(undefined, true)];
         var type = new Std(
-            "NEW",
+            name,
             args,
             undefined,
             function(context, id, type){

src/scope.js

@@ -37,6 +37,14 @@ var Scope = Class.extend({
             throw new Errors.Error( "'" + id + "' already declared");
         this.__symbols[id] = symbol;
     },
+    addType: function(type, id){
+        if (!id)
+            return undefined;
+
+        var symbol = new Symbol.Symbol(id.id(), type);
+        this.addSymbol(symbol, id.exported());
+        return symbol;
+    },
     resolve: function(symbol){
         var id = symbol.id();
         var i = this.__unresolved.indexOf(id);
@@ -69,6 +77,12 @@ var ProcedureScope = Scope.extend({
     }
 });
 
+var TypeRef = Class.extend({
+    init: function(type){this.__type = type;},
+    get: function(){return this.__type;},
+    reset: function(){this.__type = undefined;}
+});
+
 var CompiledModule = Type.Module.extend({
     init: function Scope$CompiledModule(id){
         Type.Module.prototype.init.call(this, id);
@@ -97,6 +111,7 @@ var Module = Scope.extend({
         Scope.prototype.init.call(this, "module");
         this.__name = name;
         this.__exports = {};
+        this.__stripTypes = [];
         this.__symbol = new Symbol.Symbol(name, new CompiledModule(name));
         this.addSymbol(this.__symbol);
     },
@@ -106,7 +121,17 @@ var Module = Scope.extend({
         if (exported)
             this.__exports[symbol.id()] = symbol;
     },
-    exports: function(){return this.__exports;}
+    addType: function(type, id){
+        var result = Scope.prototype.addType.call(this, type, id);
+        if (!id || !id.exported())
+            this.__stripTypes.push(type);
+        return result;
+    },
+    exports: function(){return this.__exports;},
+    strip: function(){
+        for(var i = 0; i < this.__stripTypes.length; ++i)
+            this.__stripTypes[i].strip();
+    }
 });
 
 exports.Procedure = ProcedureScope;

src/type.js

@@ -19,7 +19,20 @@ var TypeId = Id.extend({
         this._type = type;
     },
     type: function(){return this._type;},
-    description: function(){return 'type ' + this._type.description();}
+    description: function(){return 'type ' + this._type.description();},
+    strip: function(){this._type = undefined;}
+});
+
+var ForwardTypeId = TypeId.extend({
+    init: function Type$ForwardTypeId(resolve){
+        TypeId.prototype.init.call(this);
+        this.__resolve = resolve;
+    },
+    type: function(){
+        if (!this._type)
+            this._type = this.__resolve();
+        return this._type;
+    }
 });
 
 var LazyTypeId = TypeId.extend({
@@ -91,19 +104,7 @@ exports.Pointer = BasicType.extend({
     description: function(){
         return this.name() || "POINTER TO " + this.baseType().description();
     },
-    baseType: function(){
-        if (this.__base instanceof exports.ForwardRecord)
-            this.__base = this.__base.resolve();
-        return this.__base;
-    }
-});
-
-exports.ForwardRecord = Type.extend({
-    init: function ForwardRecord(resolve){
-        Type.prototype.init.call(this);
-        this.__resolve = resolve;
-    },
-    resolve: function(){return this.__resolve();}
+    baseType: function(){return this.__base.type();}
 });
 
 exports.Record = BasicType.extend({
@@ -216,4 +217,5 @@ exports.ExportedVariable = ExportedVariable;
 exports.Module = Module;
 exports.Type = Type;
 exports.TypeId = TypeId;
+exports.ForwardTypeId = ForwardTypeId;
 exports.LazyTypeId = LazyTypeId;

test/expected/modules.js

@@ -64,9 +64,16 @@ var anonymous$1 = RTL$.extend({
 	}
 });
 var pr = null;
+var pr2 = null;
 
 function p(){
 }
+
+function makeTPA(){
+	var result = null;
+	result = new TPA();
+	return result;
+}
 pr = new anonymous$1();
 return {
 	ci: ci,
@@ -76,7 +83,9 @@ return {
 	TPA: TPA,
 	i: function(){return i;},
 	pr: function(){return pr;},
-	p: p
+	pr2: function(){return pr2;},
+	p: p,
+	makeTPA: makeTPA
 }
 }();
 var m2 = function (m1){
@@ -93,11 +102,11 @@ function ref(i/*VAR INTEGER*/){
 ptr = new m1.T();
 pb = ptr;
 RTL$.typeGuard(pb, m1.T).i = 123;
-ptrA = new m1.TPA();
+ptrA = m1.makeTPA();
 m1.p();
 p(m1.i());
 p(m1.ci);
-ref(RTL$.makeRef(m1.pr(), "i"));
+ref(RTL$.makeRef(m1.pr2(), "i"));
 }(m1);
 var m3 = function (m1, m2){
 var r = new m2.T();

test/input/modules.ob

@@ -9,10 +9,18 @@ TYPE
 VAR
     i*: INTEGER;
     pr*: POINTER TO RECORD i: INTEGER END;
+    pr2*: POINTER TO T;
 
 PROCEDURE p*();
 END p;
 
+PROCEDURE makeTPA*(): TPA;
+VAR result: TPA;
+BEGIN
+    NEW(result);
+    RETURN result
+END makeTPA;
+
 BEGIN
     NEW(pr);
 END m1.
@@ -37,12 +45,12 @@ BEGIN
 	pb := ptr;
 	pb(m1.TP).i := 123;
 
-	NEW(ptrA);
+	ptrA := m1.makeTPA();
 
 	m1.p();
     p(m1.i);
     p(m1.ci);
-    ref(m1.pr.i);
+    ref(m1.pr2.i);
 END m2.
 
 MODULE m3;

test/test_unit.js

@@ -1299,6 +1299,22 @@ var testSuite = {
 "import procedure type": testWithModule(
     "MODULE test; TYPE TProc* = PROCEDURE; END test.",
     pass("MODULE m; IMPORT test; VAR proc: test.TProc; END m.")
+    ),
+"imported pointer type cannot be used in NEW if base type is not exported": testWithModule(
+    "MODULE test;"
+    + "TYPE T = RECORD END; TP* = POINTER TO T;"
+    + "TPAnonymous* = POINTER TO RECORD END; END test.",
+    pass(),
+    fail(["MODULE m; IMPORT test; VAR p: test.TPAnonymous; BEGIN NEW(p) END m.",
+          "non-exported RECORD type cannot be used in NEW"],
+         ["MODULE m; IMPORT test; VAR p: test.TP; BEGIN NEW(p) END m.",
+          "non-exported RECORD type cannot be used in NEW"])
+    ),
+"imported pointer variable: anonymous record field cannot be used": testWithModule(
+    "MODULE test; VAR p*: POINTER TO RECORD i: INTEGER END; END test.",
+    pass(),
+    fail(["MODULE m; IMPORT test; BEGIN ASSERT(test.p.i = 0) END m.",
+          "non-exported RECORD type cannot be dereferenced"])
     )
 };