Merge pull request #31 from vladfolts/rel_v1.0

trying to get rid of renamed rel_v1.0

src/context.js

@@ -343,8 +343,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");
+        if (this.__currentType instanceof Type.NonExportedRecord)
+            throw new Errors.Error("POINTER TO non-exported RECORD type cannot be dereferenced");
     },
     handleTypeCast: function(type){
         if (this.__currentType instanceof Type.Record){
@@ -1604,6 +1604,11 @@ exports.RecordDecl = ChainedContext.extend({
             this.parent().exportField(field.id());
     },
     setBaseType: function(type){
+        if (!(type instanceof Type.Record))
+            throw new Errors.Error(
+                "RECORD type is expected as a base type, got '"
+                + type.description()
+                + "'");
         if (isTypeRecursive(type, this.__type))
             throw new Errors.Error("recursive inheritance: '"
                 + this.__type.name() + "'");
@@ -1688,7 +1693,8 @@ function genExport(symbol){
         return "function(){return " + symbol.id() + ";}";
     if (symbol.isType()){
         var type = symbol.info().type();
-        if (!(type instanceof Type.Record || type instanceof Type.Pointer))
+        if (!(type instanceof Type.Record) 
+            && !((type instanceof Type.Pointer) && !type.baseType().name()))
             return undefined;
     }
     return symbol.id();

src/procedure.js

@@ -307,7 +307,7 @@ exports.predefined = [
                     throw new Errors.Error("POINTER variable expected, got '"
                                          + type.name() + "'");
                 this.__baseType = type.baseType();
-                if (this.__baseType === undefined)
+                if (this.__baseType instanceof Type.NonExportedRecord)
                     throw new Errors.Error("non-exported RECORD type cannot be used in NEW");
                 return new CheckArgumentResult(type, false);
             },

src/scope.js

@@ -77,12 +77,6 @@ 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);

src/type.js

@@ -20,7 +20,11 @@ var TypeId = Id.extend({
     },
     type: function(){return this._type;},
     description: function(){return 'type ' + this._type.description();},
-    strip: function(){this._type = undefined;}
+    strip: function(){
+        this._type = this._type instanceof Record 
+                   ? new NonExportedRecord(this._type.cons(), this._type.scope(), this._type.baseType())
+                   : undefined;
+    }
 });
 
 var ForwardTypeId = TypeId.extend({
@@ -107,8 +111,8 @@ exports.Pointer = BasicType.extend({
     baseType: function(){return this.__base.type();}
 });
 
-exports.Record = BasicType.extend({
-    init: function RecordType(name, cons, scope){
+var Record = BasicType.extend({
+    init: function Type$Record(name, cons, scope){
         BasicType.prototype.init.call(this, name);
         this.__cons = cons;        
         this.__scope = scope;
@@ -142,6 +146,13 @@ exports.Record = BasicType.extend({
     }
 });
 
+var NonExportedRecord = Record.extend({
+    init: function Scope$NonExportedRecord(cons, scope, base){
+        Record.prototype.init.call(this, undefined, cons, scope);
+        this.setBaseType(base);
+    }
+});
+
 var NilType = Type.extend({
     init: function NilType(){Type.prototype.init.call(this);},
     idType: function(){return "NIL";},
@@ -215,6 +226,8 @@ exports.Variable = Variable;
 exports.VariableRef = VariableRef;
 exports.ExportedVariable = ExportedVariable;
 exports.Module = Module;
+exports.NonExportedRecord = NonExportedRecord;
+exports.Record = Record;
 exports.Type = Type;
 exports.TypeId = TypeId;
 exports.ForwardTypeId = ForwardTypeId;

test/expected/modules.js

@@ -57,6 +57,11 @@ var TPA = RTL$.extend({
 	init: function TPA(){
 	}
 });
+var TPB = Base.extend({
+	init: function TPB(){
+		Base.prototype.init.call(this);
+	}
+});
 var i = 0;
 var anonymous$1 = RTL$.extend({
 	init: function anonymous$1(){
@@ -74,18 +79,25 @@ function makeTPA(){
 	result = new TPA();
 	return result;
 }
+
+function makeTPB(){
+	var result = null;
+	result = new TPB();
+	return result;
+}
 pr = new anonymous$1();
 return {
 	ci: ci,
 	Base: Base,
 	T: T,
-	TP: TP,
 	TPA: TPA,
+	TPB: TPB,
 	i: function(){return i;},
 	pr: function(){return pr;},
 	pr2: function(){return pr2;},
 	p: p,
-	makeTPA: makeTPA
+	makeTPA: makeTPA,
+	makeTPB: makeTPB
 }
 }();
 var m2 = function (m1){
@@ -113,8 +125,11 @@ var r = new m2.T();
 var a = RTL$.makeArray(3, function(){return new m2.Base();});
 var ptr = null;
 var pb = null;
+var pTPB = null;
 ptr = new m2.T();
 pb = ptr;
 RTL$.typeGuard(pb, m2.T).i = 123;
+pb = m2.makeTPB();
+pTPB = RTL$.typeGuard(pb, m2.TPB);
 m2.p();
 }(m2, m1);

test/input/modules.ob

@@ -6,6 +6,7 @@ TYPE
 	T* = RECORD(Base) END;
 	TP* = POINTER TO T;
 	TPA* = POINTER TO RECORD END;
+    TPB* = POINTER TO RECORD(Base) END;
 VAR
     i*: INTEGER;
     pr*: POINTER TO RECORD i: INTEGER END;
@@ -21,6 +22,13 @@ BEGIN
     RETURN result
 END makeTPA;
 
+PROCEDURE makeTPB*(): TPB;
+VAR result: TPB;
+BEGIN
+    NEW(result);
+    RETURN result
+END makeTPB;
+
 BEGIN
     NEW(pr);
 END m1.
@@ -60,10 +68,14 @@ VAR
     a: ARRAY 3 OF m2.Base;
     ptr: m2.TP;
     pb: POINTER TO m2.Base;
+    pTPB: m2.TPB;
 BEGIN
     NEW(ptr);
     pb := ptr;
     pb(m2.TP).i := 123;
 
+    pb := m2.makeTPB();
+    pTPB := pb(m2.TPB);
+
     m2.p();
 END m3.

test/test_unit.js

@@ -291,6 +291,15 @@ var testSuite = {
          ["T = RECORD r: RECORD (T) END END", "recursive field definition: 'r'"]
          )
     ),
+"record extension": testWithContext(
+    context(Grammar.typeDeclaration,
+            "TYPE B = RECORD END;"),
+    pass("T = RECORD(B) END"
+         ),
+    fail(["T = RECORD(INTEGER) END", "RECORD type is expected as a base type, got 'INTEGER'"],
+         ["T = RECORD(INTEGER) m: INTEGER END", "RECORD type is expected as a base type, got 'INTEGER'"]
+         )
+    ),
 "array declaration": testWithContext(
     context(Grammar.typeDeclaration,
             "CONST c1 = 5; VAR v1: INTEGER; p: POINTER TO RECORD END;"),
@@ -363,11 +372,20 @@ var testSuite = {
     ),
 "POINTER assignment": testWithContext(
     context(Grammar.statement,
-            "TYPE Base = RECORD END; Derived = RECORD (Base) END;"
-            + "VAR p1, p2: POINTER TO RECORD END; pBase: POINTER TO Base; pDerived: POINTER TO Derived;"),
+            "TYPE Base = RECORD END;"
+                + "Derived = RECORD (Base) END;"
+                + "PDerivedAnonymous = POINTER TO RECORD(Base) END;"
+            + "VAR p1, p2: POINTER TO RECORD END;"
+                + "pBase: POINTER TO Base; pDerived: POINTER TO Derived;"
+                + "pDerivedAnonymous: PDerivedAnonymous;"
+                + "pDerivedAnonymous2: POINTER TO RECORD(Base) END;"
+                ),
     pass("p1 := NIL",
          "p1 := p2",
-         "pBase := pDerived"),
+         "pBase := pDerived",
+         "pBase := pDerivedAnonymous",
+         "pBase := pDerivedAnonymous2"
+         ),
     fail(["p1 := pBase",
           "type mismatch: 'p1' is 'POINTER TO anonymous RECORD' and cannot be assigned to 'POINTER TO Base' expression"],
           ["pDerived := pBase",
@@ -1311,8 +1329,17 @@ var testSuite = {
         )
     ),
 "import pointer type": testWithModule(
-    "MODULE test; TYPE TP* = POINTER TO RECORD END; END test.",
-    pass("MODULE m; IMPORT test; VAR p: test.TP; END m.")
+    "MODULE test;"
+    + "TYPE TPAnonymous1* = POINTER TO RECORD END; TPAnonymous2* = POINTER TO RECORD END;"
+        + "Base* = RECORD END; TPDerived* = POINTER TO RECORD(Base) END;"
+    + "END test.",
+    pass("MODULE m; IMPORT test; VAR p1: test.TPAnonymous1; p2: test.TPAnonymous2; END m.",
+         "MODULE m; IMPORT test;"
+            + "VAR pb: POINTER TO test.Base; pd: test.TPDerived;"
+            + "BEGIN pb := pd; END m."),
+    fail(["MODULE m; IMPORT test; VAR p1: test.TPAnonymous1; p2: test.TPAnonymous2; BEGIN p1 := p2; END m.",
+          "type mismatch: 'p1' is 'TPAnonymous1' and cannot be assigned to 'TPAnonymous2' expression"]
+         )
     ),
 "import array type": testWithModule(
     "MODULE test; TYPE TA* = ARRAY 3 OF INTEGER; END test.",
@@ -1332,11 +1359,24 @@ var testSuite = {
          ["MODULE m; IMPORT test; VAR p: test.TP; BEGIN NEW(p) END m.",
           "non-exported RECORD type cannot be used in NEW"])
     ),
+"imported pointer type cannot be dereferenced if base type is not exported (even if base of base type is exported)": testWithModule(
+    "MODULE test;"
+    + "TYPE B* = RECORD i: INTEGER END; T = RECORD(B) END; TP* = POINTER TO T;"
+    + "TPAnonymous* = POINTER TO RECORD(B) END;"
+    + "PROCEDURE makeTP*(): TP; VAR result: TP; BEGIN NEW(result); RETURN result END makeTP;"
+    + "PROCEDURE makeTPA*(): TPAnonymous; VAR result: TPAnonymous; BEGIN NEW(result); RETURN result END makeTPA;"
+    + "END test.",
+    pass(),
+    fail(["MODULE m; IMPORT test; VAR p: test.TPAnonymous; BEGIN p := test.makeTPA(); p.i := 123; END m.",
+          "POINTER TO non-exported RECORD type cannot be dereferenced"],
+         ["MODULE m; IMPORT test; VAR p: test.TP; BEGIN p := test.makeTP(); p.i := 123; END m.",
+          "POINTER TO non-exported RECORD type cannot be dereferenced"])
+    ),
 "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"])
+          "POINTER TO non-exported RECORD type cannot be dereferenced"])
     ),
 "syntax errors": testWithGrammar(
     Grammar.module,