pas2js: started array SetLength using resize and hidden boolean to mark referenced arrays

git-svn-id: trunk@45294 -

packages/pastojs/src/fppas2js.pp

@@ -1,6 +1,6 @@
 {
     This file is part of the Free Component Library (FCL)
-    Copyright (c) 2019 by Michael Van Canneyt
+    Copyright (c) 2020 by Michael Van Canneyt
 
     Pascal to Javascript converter class.
 
@@ -548,6 +548,7 @@ type
     pbifnArray_Copy,
     pbifnArray_Equal,
     pbifnArray_Length,
+    pbifnArray_Reference,
     pbifnArray_SetLength,
     pbifnArray_Static_Clone,
     pbifnAs,
@@ -723,6 +724,7 @@ const
     'arrayCopy', // rtl.arrayCopy      pbifnArray_Copy
     'arrayEq', // rtl.arrayEq          pbifnArray_Equal
     'length', // rtl.length
+    'arrayRef', // rtl.arrayRef  pbifnArray_Reference
     'arraySetLength', // rtl.arraySetLength
     '$clone',
     'as', // rtl.as
@@ -1754,6 +1756,8 @@ type
     Function IsSystemUnit(aModule: TPasModule): boolean; virtual;
     Function HasTypeInfo(El: TPasType; AContext: TConvertContext): boolean; virtual;
     Function IsClassRTTICreatedBefore(aClass: TPasClassType; Before: TPasElement; AConText: TConvertContext): boolean;
+    Function IsExprTemporaryVar(Expr: TPasExpr): boolean; virtual;
+    Function IsExprPropertySetterConst(Expr: TPasExpr; AContext: TConvertContext): boolean; virtual;
     Procedure FindAvailableLocalName(var aName: string; JSExpr: TJSElement);
     Function GetImplJSProcScope(El: TPasElement; Src: TJSSourceElements;
       AContext: TConvertContext): TPas2JSProcedureScope;
@@ -1854,6 +1858,7 @@ type
       AContext: TConvertContext): TJSCallExpression; overload; virtual;
     Function CreateArrayInit(ArrayType: TPasArrayType; Expr: TPasExpr;
       El: TPasElement; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateArrayRef(El: TPasElement; ArrayExpr: TJSElement): TJSElement; virtual;
     Function CreateCmpArrayWithNil(El: TPasElement; JSArray: TJSElement;
       OpCode: TExprOpCode): TJSElement; virtual;
     Function CreateCloneStaticArray(El: TPasElement; ArrTypeEl: TPasArrayType;
@@ -16539,6 +16544,17 @@ begin
     RaiseInconsistency(20180617233317,Expr);
 end;
 
+function TPasToJSConverter.CreateArrayRef(El: TPasElement; ArrayExpr: TJSElement
+  ): TJSElement;
+var
+  Call: TJSCallExpression;
+begin
+  Call:=CreateCallExpression(El);
+  Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnArray_Reference)]);
+  Call.AddArg(ArrayExpr);
+  Result:=Call;
+end;
+
 function TPasToJSConverter.CreateCmpArrayWithNil(El: TPasElement;
   JSArray: TJSElement; OpCode: TExprOpCode): TJSElement;
 // convert "array = nil" to "rtl.length(array) > 0"
@@ -19573,6 +19589,9 @@ end;
 
 function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
   AContext: TConvertContext): TJSElement;
+var
+  lRightIsTemp, lRightIsTempValid: boolean;
+  lLeftIsConstSetter, lLeftIsConstSetterValid: boolean;
 
   procedure NotSupported(AssignContext: TAssignContext; id: TMaxPrecInt);
   begin
@@ -19586,6 +19605,28 @@ function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
         +GetResolverResultDbg(AssignContext.RightResolved));
   end;
 
+  function RightIsTemporaryVar: boolean;
+  // returns true if right side is a temporary variable, e.g. a function result
+  begin
+    if not lRightIsTempValid then
+      begin
+      lRightIsTempValid:=true;
+      lRightIsTemp:=IsExprTemporaryVar(El.right);
+      end;
+    Result:=lRightIsTemp;
+  end;
+
+  function LeftIsConstSetter: boolean;
+  // returns true if left side is a property setter with const argument
+  begin
+    if not lLeftIsConstSetterValid then
+      begin
+      lLeftIsConstSetterValid:=true;
+      lLeftIsConstSetter:=IsExprPropertySetterConst(El.left,AContext);
+      end;
+    Result:=lLeftIsConstSetter
+  end;
+
   function CreateRangeCheck(AssignSt: TJSElement;
     MinVal, MaxVal: TMaxPrecInt; RTLFunc: TPas2JSBuiltInName): TJSElement;
   var
@@ -19656,6 +19697,8 @@ begin
   Result:=nil;
   LHS:=nil;
   aResolver:=AContext.Resolver;
+  lLeftIsConstSetterValid:=false;
+  lRightIsTempValid:=false;
   AssignContext:=TAssignContext.Create(El,nil,AContext);
   try
     if aResolver<>nil then
@@ -19739,7 +19782,8 @@ begin
       end
     else if AssignContext.RightResolved.BaseType=btCurrency then
       begin
-      // double := currency  ->  double := currency/10000
+      // noncurrency := currency
+      // e.g. double := currency  ->  double := currency/10000
       AssignContext.RightSide:=CreateDivideNumber(El,AssignContext.RightSide,10000);
       end
     else if AssignContext.RightResolved.BaseType=btContext then
@@ -19750,11 +19794,29 @@ begin
         if length(TPasArrayType(RightTypeEl).Ranges)>0 then
           begin
           // right side is a static array -> clone
-          {$IFDEF VerbosePas2JS}
-          writeln('TPasToJSConverter.ConvertAssignStatement STATIC ARRAY variable Right={',GetResolverResultDbg(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
-          {$ENDIF}
-          AssignContext.RightSide:=CreateCloneStaticArray(El.right,
-                    TPasArrayType(RightTypeEl),AssignContext.RightSide,AContext);
+          if (not RightIsTemporaryVar)
+              and (not LeftIsConstSetter) then
+            begin
+            {$IFDEF VerbosePas2JS}
+            writeln('TPasToJSConverter.ConvertAssignStatement STATIC ARRAY variable Right={',GetResolverResultDbg(AssignContext.RightResolved),'} AssignContext.RightResolved.IdentEl=',GetObjName(AssignContext.RightResolved.IdentEl));
+            {$ENDIF}
+            AssignContext.RightSide:=CreateCloneStaticArray(El.right,
+                   TPasArrayType(RightTypeEl),AssignContext.RightSide,AContext);
+            end;
+          end
+        else if RightTypeEl.Parent.ClassType=TPasArgument then
+         // right side is open array
+        else
+          begin
+          // right side is dynamic array
+          if (AssignContext.LeftResolved.BaseType=btContext)
+              and (AssignContext.LeftResolved.LoTypeEl is TPasArrayType)
+              and (not RightIsTemporaryVar)
+              and (not LeftIsConstSetter) then
+            begin
+            // DynArrayA := DynArrayB  ->  DynArrayA = rtl.arrayRef(DynArrayB)
+            AssignContext.RightSide:=CreateArrayRef(El.right,AssignContext.RightSide);
+            end;
           end;
         end
       else if RightTypeEl.ClassType=TPasClassType then
@@ -20909,6 +20971,69 @@ begin
     end;
 end;
 
+function TPasToJSConverter.IsExprTemporaryVar(Expr: TPasExpr): boolean;
+var
+  Params: TParamsExpr;
+  Ref: TResolvedReference;
+  C: TClass;
+begin
+  if Expr.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    if [rrfNewInstance,rrfImplicitCallWithoutParams]*Ref.Flags<>[] then
+      exit(true);
+    end;
+
+  C:=Expr.ClassType;
+  if C=TParamsExpr then
+    begin
+    Params:=TParamsExpr(Expr);
+    if Params.Kind=pekFuncParams then
+      exit(true);
+    end
+  else if C.InheritsFrom(TBinaryExpr) then
+    exit(true);
+
+  Result:=false;
+end;
+
+function TPasToJSConverter.IsExprPropertySetterConst(Expr: TPasExpr;
+  AContext: TConvertContext): boolean;
+var
+  Bin: TBinaryExpr;
+  Ref: TResolvedReference;
+  Prop: TPasProperty;
+  Setter, Arg: TPasElement;
+  Args: TFPList;
+begin
+  if Expr is TBinaryExpr then
+    begin
+    Bin:=TBinaryExpr(Expr);
+    if Bin.OpCode=eopSubIdent then
+      Expr:=Bin.right;
+    end;
+  if Expr.CustomData is TResolvedReference then
+    begin
+    Ref:=TResolvedReference(Expr.CustomData);
+    if Ref.Declaration is TPasProperty then
+      begin
+      Prop:=TPasProperty(Ref.Declaration);
+      Setter:=AContext.Resolver.GetPasPropertySetter(Prop);
+      if Setter is TPasProcedure then
+        begin
+        Args:=TPasProcedure(Setter).ProcType.Args;
+        if Args.Count>0 then
+          begin
+          Arg:=TPasElement(Args[Args.Count-1]);
+          if (Arg is TPasArgument) and (TPasArgument(Arg).Access in [argConst,argConstRef]) then
+            exit(true);
+          end;
+        end;
+      end;
+    end;
+  Result:=false;
+end;
+
 procedure TPasToJSConverter.FindAvailableLocalName(var aName: string;
   JSExpr: TJSElement);
 var
@@ -22476,7 +22601,21 @@ end;
 function TPasToJSConverter.CreateProcCallArg(El: TPasExpr;
   TargetArg: TPasArgument; AContext: TConvertContext): TJSElement;
 var
+  ExprIsTemp, ExprIsTempValid: boolean;
   ExprResolved, ArgResolved: TPasResolverResult;
+
+  function ExprIsTemporaryVar: boolean;
+  // returns true if Expr is a temporary variable, e.g. a function result
+  begin
+    if not ExprIsTempValid then
+      begin
+      ExprIsTempValid:=true;
+      ExprIsTemp:=IsExprTemporaryVar(El);
+      end;
+    Result:=ExprIsTemp;
+  end;
+
+var
   ExprFlags: TPasResolverComputeFlags;
   IsRecord, NeedVar, ArgTypeIsArray: Boolean;
   ArgTypeEl, ExprTypeEl: TPasType;
@@ -22509,6 +22648,7 @@ begin
     Include(ExprFlags,rcNoImplicitProcType);
 
   aResolver.ComputeElement(El,ExprResolved,ExprFlags);
+  ExprIsTempValid:=false;
 
   if (TargetArg.ArgType=nil) and (ExprResolved.LoTypeEl is TPasRecordType) then
     NeedVar:=false; // pass aRecord to UntypedArg -> no reference needed
@@ -22560,7 +22700,8 @@ begin
       begin
       if ArgResolved.BaseType<>btCurrency then
         begin
-        // pass currency to double  -> /10000
+        // pass currency to noncurrency
+        // e.g. pass currency to double  -> /10000
         Result:=CreateDivideNumber(El,Result,10000);
         end;
       end
@@ -22587,11 +22728,25 @@ begin
         begin
         if length(TPasArrayType(ExprTypeEl).Ranges)>0 then
           begin
-          if TargetArg.Access=argDefault then
+          if (TargetArg.Access=argDefault)
+              and not ExprIsTemporaryVar then
             begin
             // pass static array with argDefault  -> clone
             Result:=CreateCloneStaticArray(El,TPasArrayType(ExprTypeEl),Result,AContext);
             end;
+          end
+        else
+          begin
+          // pass dyn or open array
+          if (TargetArg.Access=argDefault)
+              and (ArgResolved.BaseType=btContext)
+              and (ArgResolved.LoTypeEl is TPasArrayType)
+              and not (ArgResolved.LoTypeEl.Parent is TPasArgument)
+              and not ExprIsTemporaryVar then
+            begin
+            // pass dyn array to argDefault array  -> reference
+            Result:=CreateArrayRef(El,Result);
+            end;
           end;
         end
       else if ExprTypeEl.ClassType=TPasClassType then

packages/pastojs/tests/tcmodules.pas

@@ -418,6 +418,7 @@ type
     Procedure TestArray_Dynamic;
     Procedure TestArray_Dynamic_Nil;
     Procedure TestArray_DynMultiDimensional;
+    Procedure TestArray_DynamicAssign;
     Procedure TestArray_StaticInt;
     Procedure TestArray_StaticBool;
     Procedure TestArray_StaticChar;
@@ -435,6 +436,7 @@ type
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_SetLengthMultiDim;
     Procedure TestArray_OpenArrayOfString;
+    Procedure TestArray_ArrayOfCharAssignString; // ToDo
     Procedure TestArray_ConstRef;
     Procedure TestArray_Concat;
     Procedure TestArray_Copy;
@@ -8523,28 +8525,29 @@ end;
 procedure TTestModule.TestArray_DynMultiDimensional;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TArrayInt = array of longint;');
-  Add('  TArrayArrayInt = array of TArrayInt;');
-  Add('var');
-  Add('  Arr: TArrayInt;');
-  Add('  Arr2: TArrayArrayInt;');
-  Add('  i: longint;');
-  Add('begin');
-  Add('  arr2:=nil;');
-  Add('  if arr2=nil then;');
-  Add('  if nil=arr2 then;');
-  Add('  i:=low(arr2);');
-  Add('  i:=low(arr2[1]);');
-  Add('  i:=high(arr2);');
-  Add('  i:=high(arr2[2]);');
-  Add('  arr2[3]:=arr;');
-  Add('  arr2[4][5]:=i;');
-  Add('  i:=arr2[6][7];');
-  Add('  arr2[8,9]:=i;');
-  Add('  i:=arr2[10,11];');
-  Add('  SetLength(arr2,14);');
-  Add('  SetLength(arr2[15],16);');
+  Add([
+  'type',
+  '  TArrayInt = array of longint;',
+  '  TArrayArrayInt = array of TArrayInt;',
+  'var',
+  '  Arr: TArrayInt;',
+  '  Arr2: TArrayArrayInt;',
+  '  i: longint;',
+  'begin',
+  '  arr2:=nil;',
+  '  if arr2=nil then;',
+  '  if nil=arr2 then;',
+  '  i:=low(arr2);',
+  '  i:=low(arr2[1]);',
+  '  i:=high(arr2);',
+  '  i:=high(arr2[2]);',
+  '  arr2[3]:=arr;',
+  '  arr2[4][5]:=i;',
+  '  i:=arr2[6][7];',
+  '  arr2[8,9]:=i;',
+  '  i:=arr2[10,11];',
+  '  SetLength(arr2,14);',
+  '  SetLength(arr2[15],16);']);
   ConvertProgram;
   CheckSource('TestArray_Dynamic',
     LinesToStr([ // statements
@@ -8560,7 +8563,7 @@ begin
     '$mod.i = 0;',
     '$mod.i = rtl.length($mod.Arr2) - 1;',
     '$mod.i = rtl.length($mod.Arr2[2]) - 1;',
-    '$mod.Arr2[3] = $mod.Arr;',
+    '$mod.Arr2[3] = rtl.arrayRef($mod.Arr);',
     '$mod.Arr2[4][5] = $mod.i;',
     '$mod.i = $mod.Arr2[6][7];',
     '$mod.Arr2[8][9] = $mod.i;',
@@ -8570,6 +8573,71 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_DynamicAssign;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TArrayInt = array of longint;',
+  '  TArrayArrayInt = array of TArrayInt;',
+  'procedure Run(a: TArrayInt; const b: TArrayInt; constref c: TArrayInt);',
+  'begin',
+  'end;',
+  'procedure Fly(var a: TArrayInt);',
+  'begin',
+  'end;',
+  'var',
+  '  Arr: TArrayInt;',
+  '  Arr2: TArrayArrayInt;',
+  'begin',
+  '  arr:=nil;',
+  '  arr2:=nil;',
+  '  arr2[1]:=nil;',
+  '  arr2[2]:=arr;',
+  '  Run(arr,arr,arr);',
+  '  Fly(arr);',
+  '  Run(arr2[4],arr2[5],arr2[6]);',
+  '  Fly(arr2[7]);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_DynamicAssign',
+    LinesToStr([ // statements
+    'this.Run = function (a, b, c) {',
+    '};',
+    'this.Fly = function (a) {',
+    '};',
+    'this.Arr = [];',
+    'this.Arr2 = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Arr = [];',
+    '$mod.Arr2 = [];',
+    '$mod.Arr2[1] = [];',
+    '$mod.Arr2[2] = rtl.arrayRef($mod.Arr);',
+    '$mod.Run(rtl.arrayRef($mod.Arr), $mod.Arr, $mod.Arr);',
+    '$mod.Fly({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.Arr;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.Arr = v;',
+    '    }',
+    '});',
+    '$mod.Run(rtl.arrayRef($mod.Arr2[4]), $mod.Arr2[5], $mod.Arr2[6]);',
+    '$mod.Fly({',
+    '  a: 7,',
+    '  p: $mod.Arr2,',
+    '  get: function () {',
+    '      return this.p[this.a];',
+    '    },',
+    '  set: function (v) {',
+    '      this.p[this.a] = v;',
+    '    }',
+    '});',
+    '']));
+end;
+
 procedure TTestModule.TestArray_StaticInt;
 begin
   StartProgram(false);
@@ -8605,7 +8673,7 @@ begin
     '$mod.i = 2;',
     '$mod.i = 4;',
     '$mod.b = $mod.Arr[0] === $mod.Arr[1];',
-    '$mod.Arr = rtl.arraySetLength(null,0,3).slice(0);',
+    '$mod.Arr = rtl.arraySetLength(null,0,3);',
     '']));
 end;
 
@@ -8999,10 +9067,10 @@ begin
     LinesToStr([ // statements
     'this.DoIt = function (vG,vH,vI) {',
     '  var vJ = [];',
-    '  vG = vG;',
-    '  vJ = vH;',
-    '  vI.set(vI.get());',
-    '  $mod.DoIt(vG, vG, {',
+    '  vG = rtl.arrayRef(vG);',
+    '  vJ = rtl.arrayRef(vH);',
+    '  vI.set(rtl.arrayRef(vI.get()));',
+    '  $mod.DoIt(rtl.arrayRef(vG), vG, {',
     '    get: function () {',
     '      return vG;',
     '    },',
@@ -9010,7 +9078,7 @@ begin
     '      vG = v;',
     '    }',
     '  });',
-    '  $mod.DoIt(vH, vH, {',
+    '  $mod.DoIt(rtl.arrayRef(vH), vH, {',
     '    get: function () {',
     '      return vJ;',
     '    },',
@@ -9018,8 +9086,8 @@ begin
     '      vJ = v;',
     '    }',
     '  });',
-    '  $mod.DoIt(vI.get(), vI.get(), vI);',
-    '  $mod.DoIt(vJ, vJ, {',
+    '  $mod.DoIt(rtl.arrayRef(vI.get()), vI.get(), vI);',
+    '  $mod.DoIt(rtl.arrayRef(vJ), vJ, {',
     '    get: function () {',
     '      return vJ;',
     '    },',
@@ -9031,7 +9099,7 @@ begin
     'this.i = [];'
     ]),
     LinesToStr([
-    '$mod.DoIt($mod.i,$mod.i,{',
+    '$mod.DoIt(rtl.arrayRef($mod.i),$mod.i,{',
     '  p: $mod,',
     '  get: function () {',
     '      return this.p.i;',
@@ -9373,6 +9441,38 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_ArrayOfCharAssignString;
+begin
+  exit; // todo
+
+  StartProgram(false);
+  Add([
+  'type TArr = array of char;',
+  'var',
+  '  c: char;',
+  '  s: string;',
+  '  a: TArr;',
+  'procedure Run(const a: array of char);',
+  'begin',
+  '  Run(c);',
+  //'  Run(s);',
+  'end;',
+  'begin',
+  //'  a:=c;',
+  //'  a:=s;',
+  //'  a:=#13;',
+  //'  a:=''Foo'';',
+  //'  Run(c);',
+  //'  Run(s);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_ArrayOfCharAssignString',
+    LinesToStr([ // statements
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestArray_ConstRef;
 begin
   StartProgram(false);
@@ -9748,8 +9848,8 @@ begin
   '  integer = longint;',
   '  TArrInt = array of integer;',
   '  TArrSet = array of (red,green,blue);',
-  'procedure DoOpenInt(a: array of integer); forward;',
-  'procedure DoInt(a: TArrInt);',
+  'procedure DoOpenInt(const a: array of integer); forward;',
+  'procedure DoInt(const a: TArrInt);',
   'begin',
   '  DoInt(a+[1]);',
   '  DoInt([1]+a);',
@@ -9757,7 +9857,7 @@ begin
   '  DoOpenInt(a+[1]);',
   '  DoOpenInt([1]+a);',
   'end;',
-  'procedure DoOpenInt(a: array of integer);',
+  'procedure DoOpenInt(const a: array of integer);',
   'begin',
   '  DoOpenInt(a+[1]);',
   '  DoOpenInt([1]+a);',
@@ -9765,7 +9865,7 @@ begin
   '  DoInt(a+[1]);',
   '  DoInt([1]+a);',
   'end;',
-  'procedure DoSet(a: TArrSet);',
+  'procedure DoSet(const a: TArrSet);',
   'begin',
   '  DoSet(a+[red]);',
   '  DoSet([blue]+a);',
@@ -9844,7 +9944,7 @@ begin
   '  integer = longint;',
   '  TArrInt = array of integer;',
   '  TArrArrInt = array of TArrInt;',
-  'procedure DoInt(a: TArrArrInt);',
+  'procedure DoInt(const a: TArrArrInt);',
   'begin',
   '  DoInt(a+[[1]]);',
   '  DoInt([[1]]+a);',
@@ -9901,7 +10001,7 @@ begin
   '  integer = longint;',
   '  TArrInt = array[1..2] of integer;',
   '  TArrArrInt = array of TArrInt;',
-  'procedure DoInt(a: TArrArrInt);',
+  'procedure DoInt(const a: TArrArrInt);',
   'begin',
   '  DoInt(a+[[1,2]]);',
   '  DoInt([[1,2]]+a);',
@@ -12950,6 +13050,8 @@ begin
   Add('    function GetItems: tarray;');
   Add('    procedure SetItems(Value: tarray);');
   Add('    property Items: tarray read getitems write setitems;');
+  Add('    procedure SetNumbers(const Value: tarray);');
+  Add('    property Numbers: tarray write setnumbers;');
   Add('  end;');
   Add('function tobject.getitems: tarray;');
   Add('begin');
@@ -12968,6 +13070,12 @@ begin
   Add('  Self.Items[9]:=Self.Items[10];');
   Add('  Items[Items[11]]:=Items[Items[12]];');
   Add('end;');
+  Add('procedure tobject.SetNumbers(const Value: tarray);');
+  Add('begin;');
+  Add('  Numbers:=nil;');
+  Add('  Numbers:=Value;');
+  Add('  Self.Numbers:=Value;');
+  Add('end;');
   Add('var Obj: tobject;');
   Add('begin');
   Add('  obj.items:=nil;');
@@ -12985,14 +13093,14 @@ begin
     '  };',
     '  this.GetItems = function () {',
     '    var Result = [];',
-    '    Result = this.FItems;',
+    '    Result = rtl.arrayRef(this.FItems);',
     '    return Result;',
     '  };',
     '  this.SetItems = function (Value) {',
-    '    this.FItems = Value;',
+    '    this.FItems = rtl.arrayRef(Value);',
     '    this.FItems = [];',
     '    this.SetItems([]);',
-    '    this.SetItems(this.GetItems());',
+    '    this.SetItems(rtl.arrayRef(this.GetItems()));',
     '    this.GetItems()[1] = 2;',
     '    this.FItems[3] = this.GetItems()[4];',
     '    this.GetItems()[5] = this.GetItems()[6];',
@@ -13000,6 +13108,11 @@ begin
     '    this.GetItems()[9] = this.GetItems()[10];',
     '    this.GetItems()[this.GetItems()[11]] = this.GetItems()[this.GetItems()[12]];',
     '  };',
+    '  this.SetNumbers = function (Value) {',
+    '    this.SetNumbers([]);',
+    '    this.SetNumbers(Value);',
+    '    this.SetNumbers(Value);',
+    '  };',
     '});',
     'this.Obj = null;'
     ]),
@@ -26939,8 +27052,8 @@ begin
     'this.ArrInt = [];',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.Arr = $mod.TheArray;',
-    '$mod.TheArray = $mod.Arr;',
+    '$mod.Arr = rtl.arrayRef($mod.TheArray);',
+    '$mod.TheArray = rtl.arrayRef($mod.Arr);',
     '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
     '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
     '$mod.Arr[4] = $mod.v;',
@@ -26948,7 +27061,7 @@ begin
     '$mod.Arr[6] = null;',
     '$mod.Arr[7] = $mod.TheArray[8];',
     '$mod.Arr[0] = rtl.length($mod.TheArray) - 1;',
-    '$mod.Arr = $mod.ArrInt;',
+    '$mod.Arr = rtl.arrayRef($mod.ArrInt);',
     '$mod.ArrInt = $mod.Arr;',
     'if (rtl.length($mod.TheArray) === 0) ;',
     'if (rtl.length($mod.TheArray) === 0) ;',

utils/pas2js/dist/rtl.js

@@ -388,6 +388,15 @@ var rtl = {
     return null;
   },
 
+  hideProp: function(o,p,v){
+    Object.defineProperty(o,p, {
+      enumerable: false,
+      configurable: true,
+      writable: true
+    });
+    if(arguments.length>2){ o[p]=v; }
+  },
+
   recNewT: function(parent,name,initfn,full){
     // create new record type
     var t = {};
@@ -811,6 +820,13 @@ var rtl = {
     return (arr == null) ? 0 : arr.length;
   },
 
+  arrayRef: function(a){
+    if (a!=null){
+      rtl.hideProp(a,$pas2jsrefcnt,1);
+    }
+    return a;
+  },
+
   arraySetLength: function(arr,defaultvalue,newlength){
     var stack = [];
     for (var i=2; i<arguments.length; i++){
@@ -822,13 +838,22 @@ var rtl = {
     var item = null;
     var a = null;
     var src = arr;
-    var oldlen = 0
+    var oldlen = 0;
     do{
-      a = [];
       if (depth>0){
         item=stack[depth-1];
-        item.a[item.i]=a;
         src = (item.src && item.src.length>item.i)?item.src[item.i]:null;
+      }
+      if (!src || src.$pas2jsrefcnt>0){
+        a = [];
+        oldlen = src?src.length:0;
+      } else {
+        a = src;
+        oldlen = a.length;
+      }
+      a.length = stack[depth].dim;
+      if (depth>0){
+        item.a[item.i]=a;
         item.i++;
       }
       if (depth<dimmax){
@@ -838,7 +863,6 @@ var rtl = {
         item.src = src;
         depth++;
       } else {
-        oldlen = src?src.length:0;
         if (rtl.isArray(defaultvalue)){
           for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?src[i]:[]; // array of dyn array
         } else if (rtl.isObject(defaultvalue)) {
@@ -864,40 +888,6 @@ var rtl = {
     }while (true);
   },
 
-  /*arrayChgLength: function(arr,defaultvalue,newlength){
-    // multi dim: (arr,defaultvalue,dim1,dim2,...)
-    if (arr == null) arr = [];
-    var p = arguments;
-    function setLength(a,argNo){
-      var oldlen = a.length;
-      var newlen = p[argNo];
-      if (oldlen!==newlength){
-        a.length = newlength;
-        if (argNo === p.length-1){
-          if (rtl.isArray(defaultvalue)){
-            for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
-          } else if (rtl.isObject(defaultvalue)) {
-            if (rtl.isTRecord(defaultvalue)){
-              for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue.$new(); // e.g. record
-            } else {
-              for (var i=oldlen; i<newlen; i++) a[i]={}; // e.g. set
-            }
-          } else {
-            for (var i=oldlen; i<newlen; i++) a[i]=defaultvalue;
-          }
-        } else {
-          for (var i=oldlen; i<newlen; i++) a[i]=[]; // nested array
-        }
-      }
-      if (argNo < p.length-1){
-        // multi argNo
-        for (var i=0; i<newlen; i++) a[i]=setLength(a[i],argNo+1);
-      }
-      return a;
-    }
-    return setLength(arr,2);
-  },*/
-
   arrayEq: function(a,b){
     if (a===null) return b===null;
     if (b===null) return false;
@@ -906,6 +896,11 @@ var rtl = {
     return true;
   },
 
+  arrayRef: function(a){
+    if (a!==null) rtl.hideProp(a,'$pas2jsrefcnt',1);
+    return a;
+  },
+
   arrayClone: function(type,src,srcpos,endpos,dst,dstpos){
     // type: 0 for references, "refset" for calling refSet(), a function for new type()
     // src must not be null
@@ -1001,12 +996,7 @@ var rtl = {
   },
 
   refSet: function(s){
-    Object.defineProperty(s, '$shared', {
-      enumerable: false,
-      configurable: true,
-      writable: true,
-      value: true
-    });
+    rtl.hideProp(s,'$shared',true);
     return s;
   },