export constructors

src/context.js

@@ -1736,7 +1736,7 @@ exports.RecordDecl = ChainedContext.extend({
             throw new Errors.Error("recursive inheritance: '"
                 + Type.typeName(this.__type) + "'");
 
-        Type.setRecordBase(this.__type, type);
+        this.__type.setBase(type);
     },
     endParse: function(){
         var gen = this.codeGenerator();
@@ -1807,6 +1807,7 @@ exports.TypeDeclaration = ChainedContext.extend({
         Scope.resolve(this.currentScope(), this.__symbol);
     },
     typeName: function(){return this.__id.id();},
+    id: function(){return this.__id;},
     genTypeName: function(){return this.__id.id();},
     isAnonymousDeclaration: function(){return false;},
     type: function(){return this.parent().type();},

src/eberon/EberonConstructor.ob

@@ -106,7 +106,13 @@ BEGIN
     NEW(call);
     resultType <- typeId.type();
     recordType <- resultType(EberonRecord.PRecord); 
-    EberonRecord.ensureCanBeInstantiated(recordType, forNew);
+    
+    instType <- EberonRecord.instantiateForVar;
+    IF forNew THEN
+        instType := EberonRecord.instantiateForNew;
+    END;
+    
+    EberonRecord.ensureCanBeInstantiated(cx^, recordType, instType);
     IF forNew THEN
         resultType := Types.makePointer("", typeId);
     END;

src/eberon/EberonRecord.ob

@@ -1,9 +1,13 @@
 MODULE EberonRecord;
 IMPORT 
-    Cast, Context, EberonContext, EberonTypes, Errors, JS, JsMap, ScopeBase, Object, Stream, String, Types;
+    Cast, Context, EberonContext, EberonTypes, Errors, JS, JsMap, Scope, ScopeBase, Object, Stream, String, Types;
+CONST
+    instantiateForVar* = 0;    
+    instantiateForNew* = 1;    
+    instantiateForCopy* = 2;    
 TYPE
     Record* = RECORD(Types.Record)
-        PROCEDURE declareConstructor(type: Types.PDefinedProcedure);
+        PROCEDURE declareConstructor(type: Types.PDefinedProcedure; exported: BOOLEAN);
         PROCEDURE addMethod(methodId: Context.PIdentdefInfo; type: Types.PProcedure);
         PROCEDURE defineConstructor(type: Types.PDefinedProcedure);
         PROCEDURE defineMethod(methodId: Context.PIdentdefInfo; type: EberonTypes.PMethodType);
@@ -13,6 +17,7 @@ TYPE
         PROCEDURE setRecordInitializationCode(baseConstructorCallCode, inheritanceCode: STRING);
 
         customConstructor-: Types.PDefinedProcedure;
+        customConstructorExported: BOOLEAN;
         customConstructorDefined: BOOLEAN;
         customInitedfields-: ARRAY * OF STRING;
         finalized: BOOLEAN;
@@ -232,32 +237,49 @@ BEGIN
     RETURN (c # NIL) & (LEN(c.args()) # 0);
 END;
 
-PROCEDURE Record.initializer(cx: Context.Type): STRING;
+PROCEDURE canBeCreatedInAnotherModule(r: Record): BOOLEAN;
+    RETURN (r.customConstructor = NIL) OR r.customConstructorExported;
+END;
+
+PROCEDURE canBeCreatedInContext(cx: Context.Type; r: Record): BOOLEAN;
+    RETURN (LEN(cx.qualifyScope(r.scope)) = 0)
+        OR canBeCreatedInAnotherModule(r);
+END;
+
+PROCEDURE Record.setBase(type: Types.PRecord);
 BEGIN
-    IF SELF.finalized THEN
-        ensureNonAbstract(SELF(POINTER));
-    ELSE
-        SELF.instantiated := TRUE;
+    IF (type.scope # SELF.scope) & (SELF.scope^ IS Scope.Module) 
+        & ~canBeCreatedInAnotherModule(type(PRecord)^) THEN
+        Errors.raise("cannot extend '" + type.name + "' - its constructor was not exported")
     END;
-
-    RETURN SUPER(cx);
+    SUPER(type);
 END;
 
-PROCEDURE ensureCanBeInstantiated*(r: PRecord; forNew: BOOLEAN);
+PROCEDURE ensureCanBeInstantiated*(cx: Context.Type; r: PRecord; type: INTEGER);
 BEGIN
     IF r.finalized THEN
         ensureNonAbstract(r);
-        IF ~forNew THEN
+        IF (type # instantiateForCopy) & ~canBeCreatedInContext(cx, r^) THEN
+            Errors.raise("cannot instantiate '" + r.name + "' - its constructor was not exported");
+        END;
+
+        IF type # instantiateForNew THEN
             ensureVariableCanBeDeclared(r);
         END;
     ELSE
         r.instantiated := TRUE;
-        IF ~forNew THEN
+        IF type # instantiateForNew THEN
             r.declaredAsVariable := TRUE;
         END;
     END;
 END;
 
+PROCEDURE Record.initializer(cx: Context.Type): STRING;
+BEGIN
+    ensureCanBeInstantiated(cx, SELF(POINTER), instantiateForNew);
+    RETURN SUPER(cx);
+END;
+
 PROCEDURE Record.findSymbol(id: STRING): Types.PField;
 BEGIN
     result <- findMethodDeclaration(SELF(POINTER), id);
@@ -367,7 +389,7 @@ BEGIN
     SELF.inheritanceCode := inheritanceCode;
 END;
 
-PROCEDURE Record.declareConstructor(type: Types.PDefinedProcedure);
+PROCEDURE Record.declareConstructor(type: Types.PDefinedProcedure; exported: BOOLEAN);
 BEGIN
     IF SELF.customConstructor # NIL THEN
         Errors.raise("constructor '" + SELF.name + "' already declared");
@@ -377,6 +399,7 @@ BEGIN
     END;
 
     SELF.customConstructor := type;
+    SELF.customConstructorExported := exported;
 END;
 
 PROCEDURE Record.defineConstructor(type: Types.PDefinedProcedure);

src/eberon/eberon_context.js

@@ -324,7 +324,7 @@ var InPlaceVariableInit = Context.Chained.extend({
                          : new TypeNarrowVariable(type, false, false);
         this._symbol = Symbol.makeSymbol(this.__id, v);
         if (type instanceof Type.Record){
-            EberonRecord.ensureCanBeInstantiated(type, false);
+            EberonRecord.ensureCanBeInstantiated(this, type, EberonRecord.instantiateForCopy);
             if (e.designator())
                 this._code += this.language().rtl.cloneRecord(e.code());
             else // do not clone if it is temporary, e.g. constructor call
@@ -445,7 +445,7 @@ var VariableDeclaration = Context.VariableDeclaration.extend({
     _initCode: function(){
         var type = this.type();
         if (type instanceof EberonRecord.Record)
-            EberonRecord.ensureCanBeInstantiated(type, false);
+            EberonRecord.ensureCanBeInstantiated(this, type, EberonRecord.instantiateForVar);
         return Context.VariableDeclaration.prototype._initCode.call(this);
     }
 });
@@ -469,8 +469,14 @@ var RecordDecl = Context.RecordDecl.extend({
             var methodType = msg.type;
             var boundType = this.type();
             var id = msg.id.id();
-            if (Type.typeName(boundType) == id)
-                boundType.declareConstructor(methodType);
+            if (Type.typeName(boundType) == id){
+                if (msg.id.exported()){
+                    var typeId = this.parent().id();
+                    if (!typeId.exported())
+                        throw new Errors.Error("constructor '" + id + "' cannot be exported because record itslef is not exported");
+                }
+                boundType.declareConstructor(methodType, msg.id.exported());
+            }
             else
                 boundType.addMethod(msg.id,
                                     EberonTypes.makeMethodType(id, methodType, Procedure.makeProcCallGenerator));

src/ob/Types.ob

@@ -157,6 +157,7 @@ TYPE
     PBasicType* = POINTER TO BasicType;
 
     Record* = RECORD(NamedType)
+        PROCEDURE setBase*(type: PRecord);
         PROCEDURE addField*(f: PField);
         PROCEDURE findSymbol*(id: STRING): PField;
         PROCEDURE finalize*();
@@ -457,10 +458,10 @@ PROCEDURE recordBase*(r: Record): PRecord;
     RETURN r.base
 END recordBase;
 
-PROCEDURE setRecordBase*(VAR r: Record; type: PRecord);
+PROCEDURE Record.setBase(type: PRecord);
 BEGIN
-    r.base := type;
-END setRecordBase;
+    SELF.base := type;
+END;
 
 PROCEDURE recordScope*(r: Record): ScopeBase.PType;
     RETURN r.scope

test/test_unit_eberon.js

@@ -1249,6 +1249,35 @@ exports.suite = {
         fail(["TYPE T = ARRAY 3 OF WithParams;", "cannot use 'WithParams' as an element of static array because it has constructor with parameters"],
              ["VAR a: ARRAY 3 OF WithParams;", "cannot use 'WithParams' as an element of static array because it has constructor with parameters"]
             )
+        ),
+    "export": testWithModule(
+          "MODULE test;"
+        + "TYPE Exported* = RECORD PROCEDURE Exported*(); END;"
+        + "NotExported* = RECORD PROCEDURE NotExported(); END;"
+        + "DerivedNotExportedWithoutConstructor* = RECORD (NotExported) END;"
+        + "NoConstructor* = RECORD END;"
+        + "PROCEDURE Exported.Exported(); END;"
+        + "PROCEDURE NotExported.NotExported(); END;"
+        + "END test.",
+        pass("MODULE m; IMPORT test; VAR r: test.Exported; p: POINTER TO test.Exported; BEGIN p := NEW test.Exported(); NEW(p); END m.",
+             "MODULE m; IMPORT test; TYPE T = RECORD(test.Exported) END; END m.",
+             "MODULE m; IMPORT test; TYPE T = RECORD(test.NoConstructor) END; END m.",
+             "MODULE m; IMPORT test; TYPE T = RECORD(test.DerivedNotExportedWithoutConstructor) END; END m.",
+             "MODULE m; IMPORT test; PROCEDURE p(r: test.NotExported); BEGIN copy <- r; END; END m."
+            ),
+        fail(["MODULE m; TYPE T = RECORD PROCEDURE T*(); END; END m.",
+              "constructor 'T' cannot be exported because record itslef is not exported"],
+             ["MODULE m; IMPORT test; TYPE T = RECORD(test.NotExported) END; END m.",
+              "cannot extend 'NotExported' - its constructor was not exported"],
+             ["MODULE m; IMPORT test; VAR r: test.NotExported; END m.",
+              "cannot instantiate 'NotExported' - its constructor was not exported"],
+             ["MODULE m; IMPORT test; VAR p: POINTER TO test.NotExported; BEGIN NEW(p); END m.",
+              "cannot instantiate 'NotExported' - its constructor was not exported"],
+             ["MODULE m; IMPORT test; VAR p: POINTER TO test.NotExported; BEGIN p := NEW test.NotExported(); END m.",
+              "cannot instantiate 'NotExported' - its constructor was not exported"],
+             ["MODULE m; IMPORT test; VAR a: ARRAY 3 OF test.NotExported; END m.",
+              "cannot instantiate 'NotExported' - its constructor was not exported"]
+            )
         )
     },
 "operator NEW": testWithContext(