MAP's scalar element cannot be passed as VAR.

Imporove diagnostic in case of compiler internal error.

src/context.js

@@ -288,6 +288,15 @@ function castCode(type, context){
     return Type.recordConstructor(context, baseType);
 }
 
+function makeContext(context){
+    var l = context.language();
+    return {
+        types: l.types, 
+        rtl: l.rtl, 
+        qualifyScope: context.qualifyScope.bind(context)
+        };
+    }
+
 exports.Designator = ChainedContext.extend({
     init: function Context$Designator(context){
         ChainedContext.prototype.init.call(this, context);
@@ -333,17 +342,19 @@ exports.Designator = ChainedContext.extend({
         }
         var field = t.denote(id, isReadOnly);
         var currentType = field.type();
-        var fieldCode = field.designatorCode(this.__code, this.language());
+        var language = this.language();
+        var cx = makeContext(this);
+        var fieldCode = field.designatorCode(this.__code, cx);
         this.__derefCode = fieldCode.derefCode;
         this.__propCode = fieldCode.propCode;
-        this._advance(currentType, field.asVar(isReadOnly, this), fieldCode.code, undefined, true);
+        this._advance(currentType, field.asVar(this.__code, isReadOnly, cx), fieldCode.code, undefined, true);
         this.__scope = undefined;
     },
     _currentType: function(){return this.__currentType;},
     _currentInfo: function(){return this.__info;},
     _discardCode: function(){this.__code = "";},
-    _makeDerefVar: function(){
-        return Type.makeVariableRef(this.__currentType, false);
+    _makeDerefVar: function(info){
+        return new Type.DerefVariable(this.__currentType, this.__code);
     },
     handleExpression: function(e){this.__indexExpression = e;},
     __handleIndexExpression: function(){
@@ -391,6 +402,7 @@ exports.Designator = ChainedContext.extend({
             throw new Errors.Error("cannot index empty string" );
         var indexType = isArray ? Type.arrayElementsType(type) : basicTypes.ch;
 
+        var leadCode = code;
         code = code + "[" + indexCode + "]";
         var lval;
         if (indexType == basicTypes.ch){
@@ -400,7 +412,7 @@ exports.Designator = ChainedContext.extend({
 
         return { length: length,
                  type: indexType,
-                 info: Type.makeVariable(indexType, info instanceof Type.Const || info.isReadOnly()),
+                 info: new Type.PropertyVariable(indexType, leadCode, indexCode, info instanceof Type.Const || info.isReadOnly(), this.language().rtl),
                  code: code,
                  lval: lval,
                  asProperty: indexCode
@@ -443,18 +455,8 @@ exports.Designator = ChainedContext.extend({
     },
     endParse: function(){
         var code = this.__code;
-        var self = this;
-        var refCode = function(code){return self.__makeRefCode(code);};
         this.parent().setDesignator(
-            new Code.Designator(code, this.__lval ? this.__lval : code, refCode, this.__currentType, this.__info, this.__scope));
-    },
-    __makeRefCode: function(code){
-        if (   !this.__currentType.isScalar()
-            || this.__info.isReference())
-            return code;
-        if (this.__derefCode)
-            return this.language().rtl.makeRef(this.__derefCode, this.__propCode);
-        return "{set: function($v){" + code + " = $v;}, get: function(){return " + code + ";}}";
+            new Code.Designator(code, this.__lval ? this.__lval : code, this.__currentType, this.__info, this.__scope));
     }
 });
 
@@ -601,7 +603,7 @@ exports.ProcDecl = ChainedContext.extend({
     __addArgument: function(name, arg){
         if (name == this.__id.id())
             throw new Errors.Error("argument '" + name + "' has the same name as procedure");
-        var v = this._makeArgumentVariable(arg);
+        var v = this._makeArgumentVariable(arg, name);
         var s = new Symbol.Symbol(name, v);
         this.currentScope().addSymbol(s);
 
@@ -612,11 +614,8 @@ exports.ProcDecl = ChainedContext.extend({
             this.__firstArgument = false;
         code.write(name + "/*" + arg.description() + "*/");
     },
-    _makeArgumentVariable: function(arg){
-        var readOnly = !arg.isVar 
-                    && (arg.type instanceof Type.Array || arg.type instanceof Type.Record);
-        return arg.isVar ? Type.makeVariableRef(arg.type)
-                         : Type.makeVariable(arg.type, readOnly);
+    _makeArgumentVariable: function(arg, name){
+        return new Type.ArgumentVariable(name, arg.type, arg.isVar);
     },
     handleMessage: function(msg){
         if (msg == endParametersMsg){
@@ -1640,7 +1639,6 @@ exports.VariableDeclaration = HandleSymbolAsType.extend({
         return this.__type.initializer(this);
     },
     endParse: function(){
-        var v = Type.makeVariable(this.__type, false);
         var idents = this.__idents;
         var gen = this.codeGenerator();
         for(var i = 0; i < idents.length; ++i){
@@ -1648,6 +1646,8 @@ exports.VariableDeclaration = HandleSymbolAsType.extend({
             var varName = id.id();
             if (id.exported())
                 this.checkExport(varName);
+
+            var v = new Type.DeclaredVariable(varName, this.__type);
             this.currentScope().addSymbol(new Symbol.Symbol(varName, v), id.exported());
             gen.write("var " + varName + " = " + this._initCode() + ";");
         }
@@ -2051,4 +2051,5 @@ exports.getQIdSymbolAndScope = getQIdSymbolAndScope;
 exports.makeProcCall = makeProcCall;
 exports.unwrapType = unwrapType;
 exports.RelationOps = RelationOps;
-exports.HandleSymbolAsType = HandleSymbolAsType;
+exports.HandleSymbolAsType = HandleSymbolAsType;
+exports.makeContext = makeContext;

src/eberon/EberonRecord.ob

@@ -193,7 +193,7 @@ BEGIN
     END;
 END;
 
-PROCEDURE RecordFieldAsMethod.asVar(isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
+PROCEDURE RecordFieldAsMethod.asVar(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
     RETURN NEW EberonTypes.MethodVariable(SELF.type()); 
 END;
 
@@ -478,13 +478,13 @@ BEGIN
     SUPER();
 END;
 
-PROCEDURE RecordField.asVar(isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
+PROCEDURE RecordField.asVar(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
 BEGIN
     actualReadOnly <- isReadOnly;
     IF ~actualReadOnly & (LEN(cx.qualifyScope(Types.recordScope(SELF.record^))) # 0) THEN
         actualReadOnly := SELF.identdef()(EberonContext.PIdentdefInfo).isReadOnly();
     END;
-    RETURN SUPER(actualReadOnly, cx); 
+    RETURN SUPER(leadCode, actualReadOnly, cx); 
 END;
 
 PROCEDURE Record.Record(name: STRING; cons: STRING; scope: ScopeBase.PType)

src/eberon/EberonString.ob

@@ -8,19 +8,24 @@ VAR
 
 PROCEDURE ElementVariable.idType(): STRING;
     RETURN "string element"
-END ElementVariable.idType;
+END;
 
 PROCEDURE ElementVariable.isReadOnly(): BOOLEAN;
     RETURN TRUE
-END ElementVariable.isReadOnly;
+END;
 
-PROCEDURE ElementVariable.type(): Types.PType;
+PROCEDURE ElementVariable.type(): Types.PStorageType;
     RETURN Types.basic.ch
-END ElementVariable.type;
+END;
 
 PROCEDURE ElementVariable.isReference(): BOOLEAN;
     RETURN FALSE
-END ElementVariable.isReference;
+END;
+
+PROCEDURE ElementVariable.referenceCode(): STRING;
+BEGIN
+    RETURN "";
+END;
 
 PROCEDURE makeElementVariable*(): Types.PVariable;
     RETURN NEW ElementVariable();

src/eberon/EberonTypes.ob

@@ -68,7 +68,7 @@ PROCEDURE MethodField.type(): Types.PType;
     RETURN SELF.method
 END;
 
-PROCEDURE MethodField.asVar(isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
+PROCEDURE MethodField.asVar(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
     RETURN NEW MethodVariable(SELF.method)
 END;
 

src/eberon/eberon_context.js

@@ -104,10 +104,11 @@ var TypeNarrowVariableBase = Class.extend.call(Type.Variable, {
 });
 
 var TypeNarrowVariable = TypeNarrowVariableBase.extend({
-    init: function TypeNarrowVariable(type, isRef, isReadOnly){
+    init: function TypeNarrowVariable(type, isRef, isReadOnly, code){
         this.__type = type;
         this.__isRef = isRef;
         this.__isReadOnly = isReadOnly;
+        this.__code = code;
     },
     type: function(){
         return this.__type;
@@ -115,6 +116,12 @@ var TypeNarrowVariable = TypeNarrowVariableBase.extend({
     isReference: function(){
         return this.__isRef;
     },
+    code: function(){
+        return this.__code;
+    },
+    referenceCode: function(){
+        return this.__code;
+    },
     isReadOnly: function(){
         return this.__isReadOnly;
     },
@@ -142,6 +149,9 @@ var DereferencedTypeNarrowVariable = TypeNarrowVariableBase.extend({
     },
     setType: function(type){
         this.__v.setType(type);
+    },
+    referenceCode: function(){
+        return this.__v.code();
     }
 });
 
@@ -174,17 +184,8 @@ var Identdef = Context.Identdef.extend({
     }
 });
 
-function makeContext(context){
-    var l = context.language();
-    return {
-        types: l.types, 
-        rtl: l.rtl, 
-        qualifyScope: context.qualifyScope.bind(context)
-        };
-    }
-
 function makeContextCall(context, call){
-    return call(makeContext(context));
+    return call(Context.makeContext(context));
     }
 
 function OperatorNewMsg(e){
@@ -196,6 +197,34 @@ function checkMapKeyType(type){
         throw new Errors.Error("invalid MAP key type: STRING or string literal or ARRAY OF CHAR expected, got '" + type.description() + "'");            
 }
 
+var MapElementVariable = Class.extend.call(Type.Variable, {
+    init: function(type, readOnly, code){
+        this.__type = type;
+        this.__isReadOnly = readOnly;
+        this.__code = code;
+    },
+    type: function(){return this.__type;},
+    isReadOnly: function(){return this.__isReadOnly;},
+    isReference: function(){return false;},
+    referenceCode: function(){
+        if (this.__type.isScalar())
+            throw new Errors.Error("cannot reference map element of type '" 
+                                 + this.__type.description() + "'");
+        return this.__code;        
+    },
+    idType: function(){
+        return (this.__isReadOnly ? "read-only " : "") + "MAP's element";
+    }
+});
+
+var SelfAsPointer = Class.extend.call(Type.Id, {
+    init: function(){
+    },
+    idType: function(){
+        return "SELF(POINTER)";
+    }
+});
+
 var Designator = Context.Designator.extend({
     init: function EberonContext$Designator(parent){
         Context.Designator.prototype.init.call(this, parent);
@@ -219,10 +248,11 @@ var Designator = Context.Designator.extend({
 
         if (currentType instanceof EberonMap.Type){
             var indexType = currentType.valueType;
+            var rval = this.language().rtl.getMappedValue(code, indexCode);
             return { length: undefined, 
                      type: indexType,
-                     info: Type.makeVariable(indexType, info.isReadOnly()),
-                     code: this.language().rtl.getMappedValue(code, indexCode),
+                     info: new MapElementVariable(indexType, info.isReadOnly(), rval),
+                     code: rval,
                      lval: code + "[" + indexCode + "]"
                    };
         }
@@ -232,7 +262,7 @@ var Designator = Context.Designator.extend({
     _makeDerefVar: function(info){
         if (info instanceof TypeNarrowVariable)
             return new DereferencedTypeNarrowVariable(info);
-        return Context.Designator.prototype._makeDerefVar(info);
+        return Context.Designator.prototype._makeDerefVar.call(this, info);
     },
     handleMessage: function(msg){
         if (msg == Context.beginCallMsg)
@@ -260,12 +290,13 @@ var Designator = Context.Designator.extend({
     handleLiteral: function(s){
         if (s == "SELF"){
             var type = this.handleMessage(getMethodSelf);
-            this._advance(type, type, "this");
+            var info = new Type.DeclaredVariable("this", type);
+            this._advance(type, info, "this");
         } 
         else if (s == "POINTER"){
             var typeId = new Type.TypeId(this.handleMessage(getSelfAsPointerMsg));
             var pointerType = new Type.Pointer("", typeId);
-            var info = Type.makeVariable(pointerType, true);
+            var info = new SelfAsPointer();
             this._advance(pointerType, info, "");
         }
         else if (s == "SUPER"){
@@ -355,7 +386,7 @@ var InPlaceVariableInit = Context.Chained.extend({
         if (!isString && !(type instanceof Type.StorageType))
             throw new Errors.Error("cannot use " + type.description() + " to initialize variable");
         var v = isString ? new InPlaceStringLiteral(type) 
-                         : new TypeNarrowVariable(type, false, false);
+                         : new TypeNarrowVariable(type, false, false, this.__id);
         this._symbol = new Symbol.Symbol(this.__id, v);
         if (type instanceof Type.Record){
             EberonRecord.ensureCanBeInstantiated(this, type, EberonRecord.instantiateForCopy);
@@ -433,7 +464,7 @@ var AssignmentOrProcedureCall = Context.Chained.extend({
         var code;
         if (this.__right){
             var left = Code.makeExpression(d.code(), type, d);
-            code = op.assign(left, this.__right, makeContext(this));
+            code = op.assign(left, this.__right, Context.makeContext(this));
         }
         else if (!(d.info() instanceof ResultVariable)){
             var procCall = Context.makeProcCall(this, type, d.info());
@@ -689,14 +720,14 @@ var ProcOrMethodDecl = Context.ProcDecl.extend({
                 this.__boundType.baseConstructorCallCode
               + EberonRecord.fieldsInitializationCode(this.__boundType, this));
     },
-    _makeArgumentVariable: function(arg){
+    _makeArgumentVariable: function(arg, name){
         if (!arg.isVar)
-            return new TypeNarrowVariable(arg.type, false, true);
+            return new TypeNarrowVariable(arg.type, false, true, name);
 
         if (arg.type instanceof Type.Record)
-            return new TypeNarrowVariable(arg.type, true, false);
+            return new TypeNarrowVariable(arg.type, true, false, name);
 
-        return Context.ProcDecl.prototype._makeArgumentVariable.call(this, arg);
+        return Context.ProcDecl.prototype._makeArgumentVariable.call(this, arg, name);
     },
     setType: function(type){
         if (this.__methodId){

src/ob/Code.ob

@@ -11,21 +11,17 @@ IMPORT
     Types;
 
 TYPE
-    RefCodeProc = PROCEDURE(s: STRING): STRING;
-
     Designator* = RECORD
-        PROCEDURE Designator*(code: STRING; lval: STRING; refCode: RefCodeProc; type: Types.PType; info: Types.PId; scope: ScopeBase.PType);
+        PROCEDURE Designator*(code: STRING; lval: STRING; type: Types.PType; info: Types.PId; scope: ScopeBase.PType);
 
         PROCEDURE code(): STRING;
         PROCEDURE lval(): STRING;
-        PROCEDURE refCode(): RefCodeProc;
         PROCEDURE type(): Types.PType;
         PROCEDURE info*(): Types.PId;
         PROCEDURE scope(): ScopeBase.PType;
 
         mCode: STRING;
         mLval: STRING;
-        mRefCode: RefCodeProc;
         mType: Types.PType;
         mInfo: Types.PId;
         mScope: ScopeBase.PType
@@ -193,10 +189,6 @@ PROCEDURE Designator.lval(): STRING;
     RETURN SELF.mLval
 END Designator.lval;
 
-PROCEDURE Designator.refCode(): RefCodeProc;
-    RETURN SELF.mRefCode
-END Designator.refCode;
-
 PROCEDURE Designator.type(): Types.PType;
     RETURN SELF.mType
 END Designator.type;
@@ -209,10 +201,9 @@ PROCEDURE Designator.scope(): ScopeBase.PType;
     RETURN SELF.mScope
 END Designator.scope;
 
-PROCEDURE Designator.Designator(code: STRING; lval: STRING; refCode: RefCodeProc; type: Types.PType; info: Types.PId; scope: ScopeBase.PType)
+PROCEDURE Designator.Designator(code: STRING; lval: STRING; type: Types.PType; info: Types.PId; scope: ScopeBase.PType)
   | mCode(code),
     mLval(lval),
-    mRefCode(refCode),
     mType(type),
     mInfo(info),
     mScope(scope);
@@ -233,21 +224,6 @@ BEGIN
     RETURN result
 END derefExpression;
 
-PROCEDURE refExpression*(e: PExpression): PExpression;
-VAR
-    result: PExpression;
-BEGIN
-    IF     (e.mDesignator = NIL) 
-        OR ((e.mDesignator.mInfo IS Types.PVariable) 
-            & e.mDesignator.mInfo(Types.PVariable).isReference()) THEN
-        result := e;
-    ELSE
-        result := makeSimpleExpression(e.mDesignator.mRefCode(e.mDesignator.mCode),
-                                       e.mType);
-    END;
-    RETURN result
-END refExpression;
-
 PROCEDURE adjustPrecedence*(e: PExpression; precedence: INTEGER): STRING;
 VAR
     result: STRING;

src/ob/Module.ob

@@ -74,7 +74,7 @@ PROCEDURE AnyField.type(): Types.PType;
     RETURN any
 END AnyField.type;
 
-PROCEDURE AnyField.asVar(isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
+PROCEDURE AnyField.asVar(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): Types.PId;
     RETURN any.asVar
 END AnyField.asVar;
 

src/ob/OberonRtl.ob

@@ -7,7 +7,8 @@ TYPE
         assignArrayFromString*: PROCEDURE(s1, s2: STRING): STRING;
         setInclL*: PROCEDURE(l, r: STRING): STRING;
         setInclR*: PROCEDURE(l, r: STRING): STRING;
-        assertId*: PROCEDURE(): STRING
+        assertId*: PROCEDURE(): STRING;
+        makeRef*: PROCEDURE(derefCode, propCode: STRING): STRING;
     END;
     PType* = POINTER TO Type;
 END OberonRtl.

src/ob/Operator.ob

@@ -447,7 +447,6 @@ END;
 PROCEDURE assign*(left, right: Code.PExpression; cx: LanguageContext.PType): STRING;
 VAR
     designator: Code.PDesignator;
-    info: Types.PId;
     leftCode, rightCode: STRING;
     isArray: BOOLEAN;
     castOperation: LanguageContext.PCastOp;
@@ -468,9 +467,8 @@ VAR
     END assignArrayFromString;
 BEGIN
     designator := left.designator();
-    info := designator.info();
-    IF ~(info IS Types.PVariable) 
-        OR info(Types.PVariable).isReadOnly() THEN
+    info <- designator.info();
+    IF ~(info IS Types.PVariable) OR info.isReadOnly() THEN
         Errors.raise("cannot assign to " + info.idType());
     END; 
 

src/ob/Procedure.ob

@@ -85,7 +85,6 @@ PROCEDURE checkArgument*(
 VAR
     actualType, expectType: Types.PType;
     designator: Code.PDesignator;
-    info: Types.PId;
     result: LanguageContext.PCastOp;
     castErr: INTEGER;
 BEGIN
@@ -108,13 +107,9 @@ BEGIN
         IF designator = NIL THEN
             Errors.raise("expression cannot be used as VAR parameter");
         END;
-        info := designator.info();
-        IF info IS Types.PConst THEN
-            Errors.raise("constant cannot be used as VAR parameter");
-        END;
-        IF (info IS Types.PVariable) 
-         & info(Types.PVariable).isReadOnly() THEN
-            Errors.raise(info.idType() + " cannot be used as VAR parameter");
+        info <- designator.info();
+        IF ~(info IS Types.PVariable) OR info.isReadOnly() THEN
+            Errors.raise(info.idType() + " cannot be passed as VAR actual parameter");
         END;
     END;
     IF code # NIL THEN
@@ -189,7 +184,8 @@ VAR
     coercedArg: Code.PExpression;
 BEGIN
     IF (expected # NIL) & expected.isVar THEN
-        coercedArg := Code.refExpression(actual);
+        referenceCode <- actual.designator().info()(Types.PVariable).referenceCode();
+        coercedArg := Code.makeSimpleExpression(referenceCode, actual.type());
     ELSE
         coercedArg := Code.derefExpression(actual);
     END;
@@ -306,24 +302,23 @@ PROCEDURE makeNew(): Symbols.PSymbol;
 
     PROCEDURE CallImpl.make(args: ARRAY OF Code.PExpression; cx: LanguageContext.PType): Code.PExpression;
     VAR
-        arg: Code.PExpression;
-        argType: Types.PType;
-        baseType: Types.PRecord;
+        result: Code.PExpression;
     BEGIN
-        arg := checkSingleArgument(args, SELF, cx.types, NIL);
-        argType := arg.type();
+        arg <- checkSingleArgument(args, SELF, cx.types, NIL);
+        argType <- arg.type();
         IF ~(argType IS Types.PPointer) THEN
             Errors.raise("POINTER variable expected, got '" 
                          + argType.description() + "'");
+        ELSE
+            baseType <- Types.pointerBase(argType^);
+            IF baseType IS Types.PNonExportedRecord THEN
+                Errors.raise("non-exported RECORD type cannot be used in NEW");
+            END;
+            right <- Code.makeSimpleExpression(baseType.codeForNew(cx^), argType);
+            result := Code.makeSimpleExpression(Operator.assign(arg, right, cx), NIL);
         END;
-        baseType := Types.pointerBase(argType(Types.PPointer)^);
-        IF baseType IS Types.PNonExportedRecord THEN
-            Errors.raise("non-exported RECORD type cannot be used in NEW");
-        END;
-        RETURN Code.makeSimpleExpression(
-                arg.code() + " = " + baseType.codeForNew(cx^),
-                NIL)
-    END CallImpl.make;
+        RETURN result;
+    END;
 BEGIN
     call <- NEW CallImpl();
     hasVarArgumnetWithCustomType(call);

src/ob/Stream.ob

@@ -88,4 +88,19 @@ BEGIN
     RETURN line + 1
 END lineNumber;
 
+PROCEDURE currentLine*(self: Type): STRING;
+BEGIN
+    from <- String.lastIndexOfFrom(self.s, kCR, self.pos);
+    IF from = -1 THEN
+        from := 0
+    ELSE
+        from := from + 1;
+    END;
+    to <- String.indexOfFrom(self.s, kCR, self.pos);
+    IF to = -1 THEN
+        to := LEN(self.s);
+    END;
+    RETURN String.substr(self.s, from, to - from);
+END;
+
 END Stream.

src/ob/String.ob

@@ -33,6 +33,14 @@ BEGIN
     RETURN result
 END indexOfFrom;
 
+PROCEDURE lastIndexOfFrom*(self: STRING; c: CHAR; pos: INTEGER): INTEGER;
+VAR 
+    result: INTEGER;
+BEGIN
+    JS.do("result = self.lastIndexOf(JS.String.fromCharCode(c), pos)")
+    RETURN result
+END;
+
 PROCEDURE substr*(self: STRING; pos: INTEGER; len: INTEGER): STRING;
 VAR 
     result: STRING;

src/ob/Types.ob

@@ -1,6 +1,6 @@
 MODULE Types;
 IMPORT
-    Context, Errors, JS, Object, ScopeBase, Str := String;
+    Context, Errors, JS, OberonRtl, Object, ScopeBase, Str := String;
 TYPE
     Id* = RECORD(Object.Type)
         PROCEDURE idType*(): STRING
@@ -49,27 +49,61 @@ TYPE
 
     PConst* = POINTER TO Const;
 
+    PStorageType* = POINTER TO StorageType;
+
     Variable* = RECORD(Id)
-        PROCEDURE type*(): PType;
+        PROCEDURE type*(): PStorageType;
         PROCEDURE isReadOnly*(): BOOLEAN;
-        PROCEDURE isReference*(): BOOLEAN
+        PROCEDURE isReference*(): BOOLEAN;
+        PROCEDURE referenceCode*(): STRING;
     END;
 
     PVariable* = POINTER TO Variable;
 
-    VariableImpl = RECORD(Variable)
-        PROCEDURE VariableImpl(type: PType; ref: BOOLEAN);
+    TypedVariable = RECORD(Variable)
+        PROCEDURE TypedVariable(type: PStorageType);
+
+        mType: PStorageType;
+    END;
+
+    DeclaredVariable* = RECORD(TypedVariable)
+        PROCEDURE DeclaredVariable(id: STRING; type: PStorageType);
+
+        id: STRING;
+    END;
+
+    ArgumentVariable* = RECORD(DeclaredVariable)
+        PROCEDURE ArgumentVariable(id: STRING; type: PStorageType; var: BOOLEAN);
 
-        mType: PType;
-        mRef: BOOLEAN
+        var: BOOLEAN;
     END;
-    PVariableImpl = POINTER TO VariableImpl;
 
-    ReadOnlyVariable = RECORD(VariableImpl)
-        PROCEDURE ReadOnlyVariable(type: PType);
+    PRecordField* = POINTER TO RecordField;
+
+    FieldVariable* = RECORD(Variable)
+        PROCEDURE FieldVariable(f: PRecordField; leadCode: STRING; isReadOnly: BOOLEAN; rtl: OberonRtl.PType);
+
+        field: PRecordField;
+        leadCode: STRING;
+        readOnly: BOOLEAN;
+        rtl: OberonRtl.PType;
+    END;
+
+    PropertyVariable* = RECORD(TypedVariable)
+        PROCEDURE PropertyVariable(type: PStorageType; leadCode, propCode: STRING; isReadOnly: BOOLEAN; rtl: OberonRtl.PType);
+
+        leadCode, propCode: STRING;
+        readOnly: BOOLEAN;
+        rtl: OberonRtl.PType;
+    END;
+
+    DerefVariable* = RECORD(TypedVariable)
+        PROCEDURE DerefVariable(type: PStorageType; code: STRING);
+
+        code: STRING;
     END;
 
-    ExportedVariable = RECORD(ReadOnlyVariable)
+    ExportedVariable = RECORD(TypedVariable)
     END;
 
     PExportedVariable = POINTER TO ExportedVariable;
@@ -101,13 +135,11 @@ TYPE
         PROCEDURE id*(): STRING;
         PROCEDURE exported*(): BOOLEAN;
         PROCEDURE type*(): PType;
-        PROCEDURE asVar*(isReadOnly: BOOLEAN; cx: Context.Type): PId;
+        PROCEDURE asVar*(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): PId;
         PROCEDURE designatorCode*(leadCode: STRING; cx: Context.Type): PFieldCode;
     END;
     PField* = POINTER TO Field;
 
-    PStorageType* = POINTER TO StorageType;
-
     RecordField* = RECORD(Field)
         PROCEDURE RecordField*(identdef: Context.PIdentdefInfo; type: PStorageType);
 
@@ -116,7 +148,6 @@ TYPE
         mIdentdef: Context.PIdentdefInfo;
         mType: PStorageType;
     END;
-    PRecordField* = POINTER TO RecordField;
 
     StorageType* = RECORD(Type)    
         PROCEDURE initializer*(cx: Context.Type): STRING;
@@ -374,38 +405,174 @@ PROCEDURE Variable.idType(): STRING;
     RETURN "variable"
 END Variable.idType;
 
-PROCEDURE ReadOnlyVariable.ReadOnlyVariable(type: PType)
-    | SUPER(type, FALSE);
+PROCEDURE TypedVariable.type(): PStorageType;
+    RETURN SELF.mType
 END;
 
-PROCEDURE ReadOnlyVariable.idType(): STRING;
-    RETURN "read-only variable"
-END ReadOnlyVariable.idType;
+PROCEDURE DeclaredVariable.referenceCode(): STRING;
+BEGIN
+    result <- SELF.id;
+    IF SELF.mType.isScalar() THEN
+        result := "{set: function($v){" + result + " = $v;}, get: function(){return " + result + ";}}";
+    END;
+    RETURN result;
+END;
 
-PROCEDURE VariableImpl.type(): PType;
-    RETURN SELF.mType
-END VariableImpl.type;
+PROCEDURE DeclaredVariable.isReference(): BOOLEAN;
+    RETURN FALSE;
+END;
+
+PROCEDURE DeclaredVariable.isReadOnly(): BOOLEAN;
+    RETURN FALSE;
+END;
+
+PROCEDURE ArgumentVariable.idType(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    result := "formal parameter";
+    IF ~SELF.var THEN
+        result := "non-VAR " + result;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE ArgumentVariable.isReference(): BOOLEAN;
+    RETURN SELF.var;
+END;
+
+PROCEDURE ArgumentVariable.isReadOnly(): BOOLEAN;
+    RETURN ~SELF.var 
+        & ((SELF.mType IS PArray) OR (SELF.mType IS PRecord));
+END;
+
+PROCEDURE ArgumentVariable.referenceCode(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    IF SELF.var THEN
+        result := SELF.id;
+    ELSE
+        result := SUPER();
+    END;
+    RETURN result;
+END;
+
+PROCEDURE mangleJSProperty*(id: STRING): STRING;
+BEGIN
+    result <- id;
+    IF (id = "constructor") OR (id = "prototype") THEN
+        result := result + "$";
+    END;
+    RETURN result;
+END;
+
+PROCEDURE mangleField*(id: STRING): STRING;
+    RETURN mangleJSProperty(id);
+END;
+
+PROCEDURE FieldVariable.idType(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    result := "record's field";
+    IF SELF.readOnly THEN
+        result := "read-only " + result; 
+    END;
+    RETURN result;
+END;
+
+PROCEDURE FieldVariable.type(): PStorageType;
+    RETURN SELF.field.mType;
+END;
+
+PROCEDURE FieldVariable.referenceCode(): STRING;
+CONST
+    kQuote = 22X;
+VAR
+    result: STRING;
+BEGIN
+    codeId <- mangleField(SELF.field.mIdentdef.id());
+    IF SELF.type().isScalar() THEN
+        result := SELF.rtl.makeRef(SELF.leadCode, kQuote + codeId + kQuote);
+    ELSE
+        result := SELF.leadCode + "." + codeId;
+    END;
+    RETURN result;
+END;
+
+PROCEDURE FieldVariable.isReference(): BOOLEAN;
+    RETURN FALSE;
+END;
+
+PROCEDURE FieldVariable.isReadOnly(): BOOLEAN;
+    RETURN SELF.readOnly;
+END;
+
+PROCEDURE PropertyVariable.idType(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    result := "array's element";
+    IF SELF.readOnly THEN
+        result := "read-only " + result; 
+    END;
+    RETURN result;
+END;
+
+PROCEDURE PropertyVariable.referenceCode(): STRING;
+VAR
+    result: STRING;
+BEGIN
+    IF SELF.type().isScalar() THEN
+        result := SELF.rtl.makeRef(SELF.leadCode, SELF.propCode);
+    ELSE
+        result := SELF.leadCode + "[" + SELF.propCode + "]";
+    END;
+    RETURN result;
+END;
+
+PROCEDURE PropertyVariable.isReference(): BOOLEAN;
+    RETURN FALSE;
+END;
+
+PROCEDURE PropertyVariable.isReadOnly(): BOOLEAN;
+    RETURN SELF.readOnly;
+END;
+
+PROCEDURE DerefVariable.referenceCode(): STRING;
+    RETURN SELF.code;
+END;
+
+PROCEDURE DerefVariable.isReference(): BOOLEAN;
+    RETURN TRUE;
+END;
 
-PROCEDURE VariableImpl.isReference(): BOOLEAN;
-    RETURN SELF.mRef
-END VariableImpl.isReference;
+PROCEDURE DerefVariable.isReadOnly(): BOOLEAN;
+    RETURN FALSE;
+END;
 
 PROCEDURE procedureType*(p: ProcedureId): PType;
     RETURN p.type
 END procedureType;
 
-PROCEDURE Variable.isReadOnly(): BOOLEAN;
-    RETURN FALSE
-END Variable.isReadOnly;
-
-PROCEDURE ReadOnlyVariable.isReadOnly(): BOOLEAN;
-    RETURN TRUE
-END ReadOnlyVariable.isReadOnly;
-
 PROCEDURE ExportedVariable.idType(): STRING;
     RETURN "imported variable"
 END ExportedVariable.idType;
 
+PROCEDURE ExportedVariable.isReference(): BOOLEAN;
+    RETURN FALSE;
+END;
+
+PROCEDURE ExportedVariable.isReadOnly(): BOOLEAN;
+    RETURN TRUE;
+END;
+
+PROCEDURE ExportedVariable.referenceCode(): STRING;
+BEGIN
+    RETURN "";
+END;
+
 PROCEDURE TypeId.idType(): STRING;
     RETURN "type"
 END TypeId.idType;
@@ -714,27 +881,40 @@ PROCEDURE Const.Const(type: PType; value: JS.var)
       value(value);
 END;
 
-PROCEDURE VariableImpl.VariableImpl(type: PType; ref: BOOLEAN)
-    | mType(type),
-      mRef(ref);
+PROCEDURE TypedVariable.TypedVariable(type: PStorageType)
+    | mType(type);
 END;
 
-PROCEDURE makeVariable*(type: PType; readOnly: BOOLEAN): PVariable;
-VAR
-    result: PVariableImpl;
-BEGIN
-    IF readOnly THEN
-        result := NEW ReadOnlyVariable(type);
-    ELSE
-        result := NEW VariableImpl(type, FALSE);
-    END;
-    RETURN result
-END makeVariable;
+PROCEDURE DeclaredVariable.DeclaredVariable(id: STRING; type: PStorageType)
+    | SUPER(type),
+      id(id);
+END;
+
+PROCEDURE ArgumentVariable.ArgumentVariable(id: STRING; type: PStorageType; var: BOOLEAN)
+    | SUPER(id, type),
+      var(var);
+END;
+
+PROCEDURE FieldVariable.FieldVariable(f: PRecordField; leadCode: STRING; isReadOnly: BOOLEAN; rtl: OberonRtl.PType)
+    | field(f),
+      leadCode(leadCode),
+      readOnly(isReadOnly),
+      rtl(rtl);
+END;
 
-PROCEDURE makeVariableRef*(type: PType): PVariable;
-    RETURN NEW VariableImpl(type, TRUE);
+PROCEDURE PropertyVariable.PropertyVariable(type: PStorageType; leadCode, propCode: STRING; isReadOnly: BOOLEAN; rtl: OberonRtl.PType)
+    | SUPER(type),
+      leadCode(leadCode),
+      propCode(propCode),
+      readOnly(isReadOnly),
+      rtl(rtl);
 END;
 
+PROCEDURE DerefVariable.DerefVariable(type: PStorageType; code: STRING)
+    | SUPER(type),
+      code(code);
+      END;
+
 PROCEDURE makeExportedVariable*(v: Variable): PVariable;
     RETURN NEW ExportedVariable(v.type());
 END;
@@ -751,19 +931,6 @@ PROCEDURE FieldCode.FieldCode(code, derefCode, propCode: STRING)
     | code(code), derefCode(derefCode), propCode(propCode);
 END;
 
-PROCEDURE mangleJSProperty*(id: STRING): STRING;
-BEGIN
-    result <- id;
-    IF (id = "constructor") OR (id = "prototype") THEN
-        result := result + "$";
-    END;
-    RETURN result;
-END;
-
-PROCEDURE mangleField*(id: STRING): STRING;
-    RETURN mangleJSProperty(id);
-END;
-
 PROCEDURE RecordField.id(): STRING;
     RETURN SELF.mIdentdef.id();
 END;
@@ -788,8 +955,8 @@ PROCEDURE RecordField.type(): PType;
     RETURN SELF.mType;
 END;
 
-PROCEDURE RecordField.asVar(isReadOnly: BOOLEAN; cx: Context.Type): PId;
-    RETURN makeVariable(SELF.mType, isReadOnly);
+PROCEDURE RecordField.asVar(leadCode: STRING; isReadOnly: BOOLEAN; cx: Context.Type): PId;
+    RETURN NEW FieldVariable(SELF(POINTER), leadCode, isReadOnly, cx.rtl);
 END;
 
 PROCEDURE RecordField.RecordField(identdef: Context.PIdentdefInfo; type: PStorageType)

src/oc.js

@@ -28,12 +28,13 @@ function compileModule(grammar, stream, context, handleErrors){
     }
     catch (x) {
         if (x instanceof Errors.Error) {
-            //console.log(context.getResult());
             if (handleErrors){
                 handleErrors("line " + Stream.lineNumber(stream) + ": " + x);
                 return undefined;
             }
         }
+        if (x.message)
+            x.message = "internal compiler error while parsing line " + Stream.lineNumber(stream) + ": " + Stream.currentLine(stream) + "\n" + x.message;
         throw x;
     }
     var scope = context.currentScope();

test/expected/eberon/map.js

@@ -1,6 +1,11 @@
 <rtl code>
 var test = function (){
+function T(){
+}
 var m = {};
+var mr = {};
+var mm = {};
+var ma = {};
 function anonymous$1(){
 	this.m = {};
 }
@@ -160,6 +165,15 @@ function passByRef(m/*VAR MAP OF INTEGER*/){
 	m["abc"] = 123;
 	RTL$.assert(Object.prototype.hasOwnProperty.call(m, "abc"));
 }
+
+function passMapRecordElementByRef(r/*VAR T*/){
+}
+
+function passMapMapElementByRef(m/*VAR MAP OF INTEGER*/){
+}
+
+function passMapArrayElementByRef(a/*VAR ARRAY * OF INTEGER*/){
+}
 var $map1 = m;
 for(var k in $map1){
 	var v = $map1[k];
@@ -171,4 +185,7 @@ for(var k in $map1){
 passByRef(m);
 passByRef(r.m);
 passByRef(a[0]);
+passMapRecordElementByRef(RTL$.getMappedValue(mr, "a"));
+passMapMapElementByRef(RTL$.getMappedValue(mm, "a"));
+passMapArrayElementByRef(RTL$.getMappedValue(ma, "a"));
 }();

test/expected/eberon/method.js

@@ -20,16 +20,20 @@ T.prototype.methodDefinedWithoutEndingIdent = function(){
 function acceptPointer(p/*PT*/){
 }
 
-function acceptReferenace(p/*VAR T*/){
+function acceptReference(p/*VAR T*/){
 }
 
 function acceptConstReferenace(p/*T*/){
 }
+T.prototype.useSelfAsVar = function(){
+	acceptReference(this);
+	acceptConstReferenace(this);
+}
 T.prototype.useSelfAsPointer = function(){
 	var pVar = null;
 	pVar = this;
 	acceptPointer(this);
-	acceptReferenace(this);
+	acceptReference(this);
 	acceptConstReferenace(this);
 }
 D.prototype.p = function(){

test/expected/oberon/formal_parameters_can_be_modified.js

@@ -0,0 +1,9 @@
+var m = function (){
+
+function testPassNonVarArgumentAsVarToAnotherProcedure(i/*INTEGER*/){
+	
+	function test(i/*VAR INTEGER*/){
+	}
+	test({set: function($v){i = $v;}, get: function(){return i;}});
+}
+}();

test/expected/var_parameter.js

@@ -56,5 +56,16 @@ function p3(i/*VAR INTEGER*/, byte/*VAR BYTE*/, b/*VAR BOOLEAN*/){
 	j = array(ai);
 	j = array(r.a);
 }
+
+function testPointerDereferenceAndPassAsVAR(p/*PR*/){
+	
+	function innerVAR(r/*VAR R*/){
+	}
+	
+	function innerConstVAR(r/*R*/){
+	}
+	innerVAR(p);
+	innerConstVAR(p);
+}
 p3({set: function($v){i = $v;}, get: function(){return i;}}, {set: function($v){byte = $v;}, get: function(){return byte;}}, {set: function($v){b = $v;}, get: function(){return b;}});
 }();

test/input/eberon/map.ob

@@ -7,8 +7,13 @@ TYPE
 
         m: MapOfInteger;
     END;
+
+    T = RECORD END;
 VAR
     m: MapOfInteger;
+    mr: MAP OF T;
+    mm: MAP OF MapOfInteger;
+    ma: MAP OF ARRAY * OF INTEGER;
     r: RECORD m: MapOfInteger; END;
     a: ARRAY 1 OF MapOfInteger;
 
@@ -181,6 +186,15 @@ BEGIN
     ASSERT("abc" IN m);
 END;
 
+PROCEDURE passMapRecordElementByRef(VAR r: T);
+END;
+
+PROCEDURE passMapMapElementByRef(VAR m: MapOfInteger);
+END;
+
+PROCEDURE passMapArrayElementByRef(VAR a: ARRAY * OF INTEGER);
+END;
+
 BEGIN
     FOREACH v, k IN m DO
         FOREACH v2, k2 IN m DO
@@ -190,4 +204,7 @@ BEGIN
     passByRef(m);
     passByRef(r.m);
     passByRef(a[0]);
+    passMapRecordElementByRef(mr["a"]);
+    passMapMapElementByRef(mm["a"]);
+    passMapArrayElementByRef(ma["a"]);
 END test.

test/input/eberon/method.ob

@@ -3,6 +3,7 @@ TYPE
     T = RECORD
         PROCEDURE p();
         PROCEDURE p2(i: INTEGER): INTEGER;
+        PROCEDURE useSelfAsVar();
         PROCEDURE useSelfAsPointer();
         PROCEDURE methodDefinedWithoutEndingIdent();
 		i: INTEGER
@@ -27,19 +28,25 @@ END;
 PROCEDURE acceptPointer(p: PT);
 END acceptPointer;
 
-PROCEDURE acceptReferenace(VAR p: T);
-END acceptReferenace;
+PROCEDURE acceptReference(VAR p: T);
+END;
 
 PROCEDURE acceptConstReferenace(p: T);
 END acceptConstReferenace;
 
+PROCEDURE T.useSelfAsVar();
+BEGIN
+    acceptReference(SELF);
+    acceptConstReferenace(SELF);
+END;
+
 PROCEDURE T.useSelfAsPointer();
 VAR
     pVar: PT;
 BEGIN
     pVar := SELF(POINTER);
     acceptPointer(SELF(POINTER));
-    acceptReferenace(SELF(POINTER)^);
+    acceptReference(SELF(POINTER)^);
     acceptConstReferenace(SELF(POINTER)^);
 END T.useSelfAsPointer;
 

test/input/oberon/formal_parameters_can_be_modified.ob

@@ -0,0 +1,10 @@
+MODULE m;
+
+PROCEDURE testPassNonVarArgumentAsVarToAnotherProcedure(i: INTEGER);
+    PROCEDURE test(VAR i: INTEGER);
+    END test;
+BEGIN
+    test(i);
+END testPassNonVarArgumentAsVarToAnotherProcedure;
+
+END m.

test/input/var_parameter.ob

@@ -1,6 +1,8 @@
 MODULE m;
 
-TYPE R = RECORD i: INTEGER; byte: BYTE; a: ARRAY 3 OF INTEGER; p: POINTER TO R END;
+TYPE
+	PR = POINTER TO R;
+	R = RECORD i: INTEGER; byte: BYTE; a: ARRAY 3 OF INTEGER; p: POINTER TO R END;
 
 VAR 
 	i: INTEGER;
@@ -59,6 +61,16 @@ BEGIN
 	j := array(r.a);
 END p3;
 
+PROCEDURE testPointerDereferenceAndPassAsVAR(p: PR);
+	PROCEDURE innerVAR(VAR r: R);
+	END innerVAR;
+	PROCEDURE innerConstVAR(r: R);
+	END innerConstVAR;
+BEGIN
+	innerVAR(p^);
+	innerConstVAR(p^);
+END testPointerDereferenceAndPassAsVAR;
+
 BEGIN
     p3(i, byte, b)
 

test/test_compile.js

@@ -158,6 +158,7 @@ function main(){
     var errDirs = makeTestDirs("errors");
     var runDirs = makeTestDirs("run");
     var nodejsDirs = makeTestDirs("nodejs");
+    var oberonDirs = makeTestDirs("oberon");
     var eberonDirs = makeTestDirs("eberon");
     var eberonRunDirs = makeTestDirs("eberon/run");
     var eberonErrDirs = makeTestDirs("eberon/errors");
@@ -175,6 +176,7 @@ function main(){
         Test.run({"common": {"oberon": makeCommonTests(oberon, "oberon"),
                              "eberon": makeCommonTests(eberon, "eberon")
                             },
+                  "oberon": {"expect OK": makeTests(expectOk, oberonDirs, oberon)},
                   "eberon": {"expect OK": makeTests(expectOk, eberonDirs, eberon),
                              "run": makeTests(run, eberonRunDirs, eberon),
                              "expect compile error": makeTests(expectError, eberonErrDirs, eberon)

test/test_unit.js

@@ -88,7 +88,7 @@ return {
     fail(["\"", "unexpected end of string"],
          ["\"abc", "unexpected end of string"],
          ["FFX", "undeclared identifier: 'FFX'"],
-         ["charByRef(cs[1])", "read-only variable cannot be used as VAR parameter"]
+         ["charByRef(cs[1])", "read-only array's element cannot be passed as VAR actual parameter"]
         )
     ),
 "parentheses": testWithGrammar(
@@ -797,11 +797,12 @@ return {
             + "PROCEDURE p1(VAR i: INTEGER); END p1;"
             + "PROCEDURE p2(VAR b: BOOLEAN); END p2;"
             + "PROCEDURE procBasePointer(VAR p: PBase); END procBasePointer;"
+            + "PROCEDURE int(): INTEGER; RETURN 0 END int;"
             ),
     pass("p1(i1)",
          "p1(a1[0])",
          "p1(r1.f1)"),
-    fail(["p1(c)", "constant cannot be used as VAR parameter"],
+    fail(["p1(c)", "constant cannot be passed as VAR actual parameter"],
          ["p1(123)", "expression cannot be used as VAR parameter"],
          ["p2(TRUE)", "expression cannot be used as VAR parameter"],
          ["procBasePointer(NIL)", "expression cannot be used as VAR parameter"],
@@ -810,6 +811,7 @@ return {
          ["p1(+i1)", "expression cannot be used as VAR parameter"],
          ["p1(-i1)", "expression cannot be used as VAR parameter"],
          ["p2(~b1)", "expression cannot be used as VAR parameter"],
+         ["p1(int())", "expression cannot be used as VAR parameter"],
          ["procBasePointer(pDerived)", 
           "type mismatch for argument 1: cannot pass 'PDerived' as VAR parameter of type 'PBase'"]
          )
@@ -987,7 +989,7 @@ return {
     fail(["MODULE m; IMPORT test; BEGIN test.i := 123; END m.",
           "cannot assign to imported variable"],
          ["MODULE m; IMPORT test; PROCEDURE p(VAR i: INTEGER); END p; BEGIN p(test.i); END m.",
-          "imported variable cannot be used as VAR parameter"]
+          "imported variable cannot be passed as VAR actual parameter"]
         )
     ),
 "import pointer type": testWithModule(
@@ -1106,7 +1108,7 @@ return {
             "TYPE P = POINTER TO RECORD END;"),
     pass(),
     fail(["PROCEDURE readOnlyPointers(a: ARRAY OF P); BEGIN NEW(a[0]) END readOnlyPointers",
-          "read-only variable cannot be used as VAR parameter"])
+          "read-only array's element cannot be passed as VAR actual parameter"])
     ),
 "LEN": testWithGrammar(
     grammar.procedureDeclaration,
@@ -1254,11 +1256,11 @@ return {
          "PROCEDURE p(a: ARRAY OF INTEGER); BEGIN p2(a) END p",
          "PROCEDURE p(a: ARRAY OF T); BEGIN varInteger(a[0].p.i) END p"),
     fail(["PROCEDURE p(a: ARRAY OF INTEGER); BEGIN a[0] := 0 END p",
-          "cannot assign to read-only variable"],
+          "cannot assign to read-only array's element"],
          ["PROCEDURE p(a: ARRAY OF T); BEGIN a[0].i := 0 END p",
-          "cannot assign to read-only variable"],
+          "cannot assign to read-only record's field"],
          ["PROCEDURE p(a: ARRAY OF T); BEGIN varInteger(a[0].i) END p",
-          "read-only variable cannot be used as VAR parameter"])
+          "read-only record's field cannot be passed as VAR actual parameter"])
     ),
 "RECORD parameter": testWithContext(
     context(grammar.procedureDeclaration,
@@ -1273,9 +1275,9 @@ return {
          "PROCEDURE p(r: T); BEGIN intValue(r.i); recordValue(r); END p"
         ),
     fail(["PROCEDURE p(r: T); BEGIN r.i := 0 END p",
-          "cannot assign to read-only variable"],
+          "cannot assign to read-only record's field"],
          ["PROCEDURE p(r: T); BEGIN intVar(r.i); END p",
-          "read-only variable cannot be used as VAR parameter"]
+          "read-only record's field cannot be passed as VAR actual parameter"]
         )
     ),
 "local procedure": testWithContext(

test/test_unit_eberon.js

@@ -202,22 +202,32 @@ exports.suite = {
     fail(["PROCEDURE p(); BEGIN SELF.i := 0; END p;",
           "SELF can be used only in methods"])
     ),
+"SELF as VAR parameter": testWithContext(
+    context(grammar.declarationSequence, 
+            "TYPE T = RECORD PROCEDURE method() END;"
+            + "PROCEDURE refProc(VAR r: T); END;"
+            ),
+    pass("PROCEDURE T.method(); BEGIN refProc(SELF); END;")
+    ),
 "SELF as pointer": testWithContext(
     context(grammar.declarationSequence, 
             "TYPE T = RECORD PROCEDURE method() END;"
             + "PT = POINTER TO T;"
             + "VAR pVar: PT;"
-            + "PROCEDURE refProc(VAR p: PT); END refProc;"
+            + "PROCEDURE refProc(VAR r: T); END;"
+            + "PROCEDURE refPointerProc(VAR p: PT); END;"
             ),
     pass("PROCEDURE T.method(); BEGIN pVar := SELF(POINTER) END T.method;",
          "PROCEDURE p();"
           + "TYPE Derived = RECORD(T) END; VAR pd: POINTER TO Derived;"
           + "PROCEDURE Derived.method(); VAR pVar: PT; BEGIN NEW(pd); pVar := SELF(POINTER); END Derived.method;"
-          + "END p;"),
-    fail(["PROCEDURE T.method(); BEGIN refProc(SELF(POINTER)) END T.method;", 
-          "read-only variable cannot be used as VAR parameter"],
+          + "END p;",
+          "PROCEDURE T.method(); BEGIN refProc(SELF(POINTER)^) END;"
+          ),
+    fail(["PROCEDURE T.method(); BEGIN refPointerProc(SELF(POINTER)) END T.method;", 
+          "SELF(POINTER) cannot be passed as VAR actual parameter"],
          ["PROCEDURE T.method(); BEGIN SELF(POINTER) := pVar; END T.method;", 
-          "cannot assign to read-only variable"],
+          "cannot assign to SELF(POINTER)"],
          ["PROCEDURE p();"
           + "TYPE Derived = RECORD(T) END; VAR d: Derived;"
           + "PROCEDURE Derived.method(); VAR pVar: PT; BEGIN pVar := SELF(POINTER); END Derived.method;"
@@ -363,9 +373,9 @@ exports.suite = {
     "MODULE test; TYPE T* = RECORD f-: INTEGER END; END test.",
     pass(),
     fail(["MODULE m; IMPORT test; VAR r: test.T; BEGIN r.f := 123; END m.",
-          "cannot assign to read-only variable"],
+          "cannot assign to read-only record's field"],
          ["MODULE m; IMPORT test; TYPE D = RECORD(test.T) END; VAR r: D; BEGIN r.f := 123; END m.",
-          "cannot assign to read-only variable"]
+          "cannot assign to read-only record's field"]
         )),
 "STRING variable": testWithGrammar(
     grammar.variableDeclaration,
@@ -471,7 +481,7 @@ exports.suite = {
             + "PROCEDURE pCharByVar(VAR c: CHAR): CHAR; RETURN c END pCharByVar;"),
     pass("s[0]"),
     fail(["s[-1]", "index is negative: -1"],
-         ["pCharByVar(s[0])", "string element cannot be used as VAR parameter"]
+         ["pCharByVar(s[0])", "string element cannot be passed as VAR actual parameter"]
          )
     ),
 "designate call result in expression": testWithContext(
@@ -649,7 +659,7 @@ exports.suite = {
         context(grammar.declarationSequence, ""),
         pass(),
         fail(["PROCEDURE p(); BEGIN s <- \"abc\"; s := \"def\"; END p;", "cannot assign to string literal"],
-             ["PROCEDURE p(); BEGIN s <- \"abc\"; s[0] := \"d\"; END p;", "cannot assign to read-only variable"])
+             ["PROCEDURE p(); BEGIN s <- \"abc\"; s[0] := \"d\"; END p;", "cannot assign to read-only array's element"])
         ),
     "scope": testWithContext(
         temporaryValues.context,
@@ -911,10 +921,10 @@ exports.suite = {
               "cannot assign to non-VAR formal parameter"],
              ["PROCEDURE p(b: PBase); BEGIN b := NIL; END p;", 
               "cannot assign to non-VAR formal parameter"],
-             ["PROCEDURE p(a: ARRAY OF INTEGER); BEGIN pArrayRef(a) END p",
-              "non-VAR formal parameter cannot be used as VAR parameter"],
+             ["PROCEDURE p(a: ARRAY OF INTEGER); BEGIN pArrayRef(a) END;",
+              "non-VAR formal parameter cannot be passed as VAR actual parameter"],
              ["PROCEDURE p(r: T); BEGIN recordVar(r); END p",
-              "non-VAR formal parameter cannot be used as VAR parameter"],
+              "non-VAR formal parameter cannot be passed as VAR actual parameter"],
              ["PROCEDURE p(s1, s2: ARRAY OF CHAR); BEGIN s1 := s2 END p",
               "cannot assign to non-VAR formal parameter"],
              ["PROCEDURE p(s: ARRAY OF CHAR); BEGIN s := \"abc\" END p", 
@@ -1390,6 +1400,21 @@ exports.suite = {
             ),
         fail(["m[123]", "invalid MAP key type: STRING or string literal or ARRAY OF CHAR expected, got 'INTEGER'"])
         ),
+    "get and pass as VAR": testWithContext(
+        context(grammar.statement,
+                "TYPE T = RECORD END;"
+                + "VAR mInt: MAP OF INTEGER;"
+                + "    mS: MAP OF STRING;"
+                + "    mR: MAP OF T;"
+                + "PROCEDURE intByRef(VAR i: INTEGER); END;"
+                + "PROCEDURE stringByRef(VAR s: STRING); END;"
+                + "PROCEDURE recordByRef(VAR r: T); END;"
+                ),
+        pass("recordByRef(mR[\"a\"])"),
+        fail(["intByRef(mInt[\"a\"])", "cannot reference map element of type 'INTEGER'"],
+             ["stringByRef(mS[\"a\"])", "cannot reference map element of type 'STRING'"]
+            )
+        ),
     "IN": testWithContext(
         context(grammar.expression,
                 "VAR m: MAP OF INTEGER;"
@@ -1405,7 +1430,7 @@ exports.suite = {
         context(grammar.declarationSequence,
                 "TYPE M = MAP OF INTEGER;"),
         pass(),
-        fail(["PROCEDURE p(m: M); BEGIN m[\"abc\"] := 123; END;", "cannot assign to read-only variable"])
+        fail(["PROCEDURE p(m: M); BEGIN m[\"abc\"] := 123; END;", "cannot assign to read-only MAP's element"])
         ),
     "FOREACH": testWithContext(
         context(grammar.statement,

test/test_unit_oberon.js

@@ -77,7 +77,7 @@ exports.suite = {
             ),
     pass(),
     fail(["PROCEDURE p(a: ARRAY OF INTEGER); BEGIN pArrayRef(a) END p",
-          "read-only variable cannot be used as VAR parameter"]
+          "non-VAR formal parameter cannot be passed as VAR actual parameter"]
          )
     ),
 "Non-VAR RECORD parameter cannot be passed as VAR": testWithContext(
@@ -87,19 +87,19 @@ exports.suite = {
             ),
     pass(),
     fail(["PROCEDURE p(r: T); BEGIN recordVar(r); END p",
-          "read-only variable cannot be used as VAR parameter"]
+          "non-VAR formal parameter cannot be passed as VAR actual parameter"]
          )
     ),
 "Non-VAR open array assignment fails": testWithGrammar(
     grammar.procedureDeclaration,
     pass(),
     fail(["PROCEDURE p(s1, s2: ARRAY OF CHAR); BEGIN s1 := s2 END p",
-          "cannot assign to read-only variable"])
+          "cannot assign to non-VAR formal parameter"])
     ),
 "string assignment to non-VAR open array fails": testWithGrammar(
     grammar.procedureDeclaration,
     pass(),
-    fail(["PROCEDURE p(s: ARRAY OF CHAR); BEGIN s := \"abc\" END p", "cannot assign to read-only variable"])
+    fail(["PROCEDURE p(s: ARRAY OF CHAR); BEGIN s := \"abc\" END p", "cannot assign to non-VAR formal parameter"])
     ),
 "procedure": testWithGrammar(
     grammar.procedureDeclaration,