pas2js: backported fix SetLength resize

compiler/packages/fcl-passrc/src/pasresolver.pp

@@ -1927,7 +1927,7 @@ type
       ErrorEl: TPasElement; RaiseOnIncompatible: boolean): integer;
     function CheckEqualCompatibilityUserType(
       const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
-      RaiseOnIncompatible: boolean): integer; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
+      RaiseOnIncompatible: boolean): integer; virtual; // LHS.BaseType=btContext=RHS.BaseType and both rrfReadable
     function CheckTypeCast(El: TPasType; Params: TParamsExpr; RaiseOnError: boolean): integer;
     function CheckTypeCastRes(const FromResolved, ToResolved: TPasResolverResult;
       ErrorEl: TPasElement; RaiseOnError: boolean): integer; virtual;

compiler/packages/pastojs/src/fppas2js.pp

@@ -565,6 +565,7 @@ type
     pbifnArray_Copy,
     pbifnArray_Equal,
     pbifnArray_Length,
+    pbifnArray_Reference,
     pbifnArray_SetLength,
     pbifnArray_Static_Clone,
     pbifnAs,
@@ -729,6 +730,7 @@ const
     'arrayCopy', // rtl.arrayCopy
     'arrayEq', // rtl.arrayEq
     'length', // rtl.length
+    'arrayRef', // rtl.arrayRef  pbifnArray_Reference
     'arraySetLength', // rtl.arraySetLength
     '$clone',
     'as', // rtl.as
@@ -1409,6 +1411,10 @@ type
     procedure AddElementData(Data: TPas2JsElementData); virtual;
     function CreateElementData(DataClass: TPas2JsElementDataClass;
       El: TPasElement): TPas2JsElementData; virtual;
+    // checking compatibilility
+    function CheckEqualCompatibilityUserType(const LHS,
+      RHS: TPasResolverResult; ErrorEl: TPasElement;
+      RaiseOnIncompatible: boolean): integer; override;
     // utility
     procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
       Args: array of {$IFDEF pas2js}jsvalue{$ELSE}const{$ENDIF}; ErrorPosEl: TPasElement); override;
@@ -1710,6 +1716,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;
@@ -1803,6 +1811,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;
@@ -5469,6 +5478,20 @@ begin
   AddElementData(Result);
 end;
 
+function TPas2JSResolver.CheckEqualCompatibilityUserType(const LHS,
+  RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean
+  ): integer;
+begin
+  Result:=inherited CheckEqualCompatibilityUserType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
+  if Result=cIncompatible then exit;
+  if (LHS.LoTypeEl is TPasArrayType)
+      and (length(TPasArrayType(LHS.LoTypeEl).Ranges)>0) then
+    RaiseMsg(20200508103543,nXIsNotSupported,sXIsNotSupported,['compare static array'],ErrorEl);
+  if (RHS.LoTypeEl is TPasArrayType)
+      and (length(TPasArrayType(RHS.LoTypeEl).Ranges)>0) then
+    RaiseMsg(20200508103544,nXIsNotSupported,sXIsNotSupported,['compare static array'],ErrorEl);
+end;
+
 procedure TPas2JSResolver.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
   const Fmt: String; Args: array of {$IFDEF pas2js}jsvalue{$ELSE}const{$ENDIF};
   ErrorPosEl: TPasElement);
@@ -7127,6 +7150,7 @@ var
   JSBinClass: TJSBinaryClass;
   ResolvedEl: TPasResolverResult;
   AInt, BInt: TMaxPrecInt;
+  LArrType: TPasArrayType;
 begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertBinaryExpressionRes OpCode="',OpcodeStrings[El.OpCode],'" Left=',GetResolverResultDbg(LeftResolved),' Right=',GetResolverResultDbg(RightResolved));
@@ -7648,6 +7672,7 @@ begin
         end
       else if LeftTypeEl.ClassType=TPasArrayType then
         begin
+        LArrType:=TPasArrayType(LeftTypeEl);
         if RightResolved.BaseType=btNil then
           begin
           // convert "array = nil" to "rtl.length(array) === 0"
@@ -7655,6 +7680,11 @@ begin
           Result:=CreateCmpArrayWithNil(El,A,El.OpCode);
           A:=nil;
           exit;
+          end
+        else if length(LArrType.Ranges)>0 then
+          begin
+          // LHS is static array
+          aResolver.RaiseMsg(20200508102656,nXIsNotSupported,sXIsNotSupported,['compare static array'],TPasElement(El));
           end;
         end;
       end;
@@ -10640,6 +10670,7 @@ begin
         Call.AddArg(ConvertExpression(El.Params[i],AContext));
       if StaticDims<>nil then
         begin
+        Call.AddArg(CreateLiteralJSString(El,'s'));
         for i:=0 to StaticDims.Count-1 do
           Call.AddArg(TJSElement(StaticDims[i]));
         StaticDims.OwnsObjects:=false;
@@ -15744,6 +15775,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"
@@ -18411,6 +18453,9 @@ end;
 
 function TPasToJSConverter.ConvertAssignStatement(El: TPasImplAssign;
   AContext: TConvertContext): TJSElement;
+var
+  lRightIsTemp, lRightIsTempValid: boolean;
+  lLeftIsConstSetter, lLeftIsConstSetterValid: boolean;
 
   procedure NotSupported(AssignContext: TAssignContext; id: TMaxPrecInt);
   begin
@@ -18424,6 +18469,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
@@ -18494,6 +18561,8 @@ begin
   Result:=nil;
   LHS:=nil;
   aResolver:=AContext.Resolver;
+  lLeftIsConstSetterValid:=false;
+  lRightIsTempValid:=false;
   AssignContext:=TAssignContext.Create(El,nil,AContext);
   try
     if aResolver<>nil then
@@ -18588,6 +18657,9 @@ begin
         if length(TPasArrayType(RightTypeEl).Ranges)>0 then
           begin
           // right side is a static array -> clone
+          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}
@@ -18595,6 +18667,21 @@ begin
                    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
         begin
         if AssignContext.LeftResolved.BaseType in btAllStrings then
@@ -19747,6 +19834,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
@@ -21197,7 +21347,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;
@@ -21230,6 +21394,7 @@ begin
     Include(ExprFlags,rcNoImplicitProcType);
 
   aResolver.ComputeElement(El,ExprResolved,ExprFlags);
+  ExprIsTempValid:=false;
 
   // consider TargetArg access
   if NeedVar then
@@ -21305,11 +21470,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

compiler/packages/pastojs/tests/tcmodules.pas

@@ -421,6 +421,7 @@ type
     Procedure TestArray_StaticChar;
     Procedure TestArray_StaticMultiDim;
     Procedure TestArray_StaticInFunction;
+    Procedure TestArray_StaticMultiDimEqualNotImplemented;
     Procedure TestArrayOfRecord;
     Procedure TestArray_StaticRecord;
     Procedure TestArrayOfSet;
@@ -432,6 +433,7 @@ type
     Procedure TestArray_SetLengthOutArg;
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_SetLengthMultiDim;
+    Procedure TestArray_SetLengthDynOfStatic;
     Procedure TestArray_OpenArrayOfString;
     Procedure TestArray_ConstRef;
     Procedure TestArray_Concat;
@@ -8468,7 +8470,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;',
@@ -8513,7 +8515,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;
 
@@ -8722,6 +8724,22 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_StaticMultiDimEqualNotImplemented;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TArrayInt = array[1..3,1..2] of longint;',
+  'var',
+  '  a,b: TArrayInt;',
+  'begin',
+  '  if a=b then ;',
+  '']);
+  SetExpectedPasResolverError('compare static array is not supported',
+    nXIsNotSupported);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestArrayOfRecord;
 begin
   StartProgram(false);
@@ -8907,10 +8925,10 @@ begin
     LinesToStr([ // statements
     'this.DoIt = function (vG,vH,vI) {',
     '  var vJ = [];',
-    '  vG = vG;',
+    '  vG = rtl.arrayRef(vG);',
-    '  vJ = vH;',
+    '  vJ = rtl.arrayRef(vH);',
-    '  vI.set(vI.get());',
+    '  vI.set(rtl.arrayRef(vI.get()));',
-    '  $mod.DoIt(vG, vG, {',
+    '  $mod.DoIt(rtl.arrayRef(vG), vG, {',
     '    get: function () {',
     '      return vG;',
     '    },',
@@ -8918,7 +8936,7 @@ begin
     '      vG = v;',
     '    }',
     '  });',
-    '  $mod.DoIt(vH, vH, {',
+    '  $mod.DoIt(rtl.arrayRef(vH), vH, {',
     '    get: function () {',
     '      return vJ;',
     '    },',
@@ -8926,8 +8944,8 @@ begin
     '      vJ = v;',
     '    }',
     '  });',
-    '  $mod.DoIt(vI.get(), vI.get(), vI);',
+    '  $mod.DoIt(rtl.arrayRef(vI.get()), vI.get(), vI);',
-    '  $mod.DoIt(vJ, vJ, {',
+    '  $mod.DoIt(rtl.arrayRef(vJ), vJ, {',
     '    get: function () {',
     '      return vJ;',
     '    },',
@@ -8939,7 +8957,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;',
@@ -9244,7 +9262,54 @@ begin
     LinesToStr([
     '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
     '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
-    '$mod.b = rtl.arraySetLength($mod.b, 0, 5, 2);',
+    '$mod.b = rtl.arraySetLength($mod.b, 0, 5, "s", 2);',
+    '']));
+end;
+
+procedure TTestModule.TestArray_SetLengthDynOfStatic;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TStaArr1 = array[1..3] of boolean;',
+  //'  TStaArr2 = array[5..6] of TStaArr1;',
+  '  TDynArr1StaArr1 = array of TStaArr1;',
+  //'  TDynArr1StaArr2 = array of TStaArr2;',
+  '  TDynArr2StaArr1 = array of TDynArr1StaArr1;',
+  //'  TDynArr2StaArr2 = array of TDynArr1StaArr2;',
+  'var',
+  '  DynArr1StaArr1: TDynArr1StaArr1;',
+  //'  DynArr1StaArr2: TDynArr1StaArr1;',
+  '  DynArr2StaArr1: TDynArr2StaArr1;',
+  //'  DynArr2StaArr2: TDynArr2StaArr2;',
+  'begin',
+  '  SetLength(DynArr1StaArr1,11);',
+  '  SetLength(DynArr2StaArr1,12);',
+  '  SetLength(DynArr2StaArr1[13],14);',
+  '  SetLength(DynArr2StaArr1,15,16);',
+  //'  SetLength(DynArr1StaArr2,21);',
+  //'  SetLength(DynArr2StaArr2,22);',
+  //'  SetLength(DynArr2StaArr2[23],24);',
+  //'  SetLength(DynArr2StaArr2,25,26);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_DynOfStatic',
+    LinesToStr([ // statements
+    'this.DynArr1StaArr1 = [];',
+    'this.DynArr2StaArr1 = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DynArr1StaArr1 = rtl.arraySetLength($mod.DynArr1StaArr1, false, 11, "s", 3);',
+    '$mod.DynArr2StaArr1 = rtl.arraySetLength($mod.DynArr2StaArr1, [], 12);',
+    '$mod.DynArr2StaArr1[13] = rtl.arraySetLength($mod.DynArr2StaArr1[13], false, 14, "s", 3);',
+    '$mod.DynArr2StaArr1 = rtl.arraySetLength(',
+    '  $mod.DynArr2StaArr1,',
+    '  false,',
+    '  15,',
+    '  16,',
+    '  "s",',
+    '  3',
+    ');',
     '']));
 end;
 
@@ -9716,7 +9781,7 @@ begin
     'this.DoOpenInt = function (a) {',
     '  $mod.DoOpenInt(rtl.arrayConcatN(a, [1]));',
     '  $mod.DoOpenInt(rtl.arrayConcatN([1], a));',
-    '  $mod.DoInt(a);',
+    '  $mod.DoInt(rtl.arrayRef(a));',
     '  $mod.DoInt(rtl.arrayConcatN(a, [1]));',
     '  $mod.DoInt(rtl.arrayConcatN([1], a));',
     '};',
@@ -9752,7 +9817,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);',
@@ -9809,7 +9874,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);',
@@ -12742,6 +12807,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');
@@ -12760,6 +12827,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;');
@@ -12777,14 +12850,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];',
@@ -12792,6 +12865,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;'
     ]),
@@ -26176,8 +26254,8 @@ begin
     'this.ArrInt = [];',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.Arr = $mod.TheArray;',
+    '$mod.Arr = rtl.arrayRef($mod.TheArray);',
-    '$mod.TheArray = $mod.Arr;',
+    '$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;',
@@ -26185,7 +26263,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) ;',

compiler/utils/pas2js/dist/rtl.js

@@ -801,10 +801,22 @@ 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 = [];
+    var s = 9999;
     for (var i=2; i<arguments.length; i++){
-      stack.push({ dim:arguments[i]+0, a:null, i:0, src:null });
+      var j = arguments[i];
+      if (j==='s'){ s = i-2; }
+      else {
+        stack.push({ dim:j+0, a:null, i:0, src:null });
+      }
     }
     var dimmax = stack.length-1;
     var depth = 0;
@@ -812,13 +824,28 @@ var rtl = {
     var item = null;
     var a = null;
     var src = arr;
-    var oldlen = 0
+    var srclen = 0, 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){
+        a = [];
+        srclen = 0;
+        oldlen = 0;
+      } else if (src.$pas2jsrefcnt>0 || depth>=s){
+        a = [];
+        srclen = src.length;
+        oldlen = srclen;
+      } else {
+        a = src;
+        srclen = 0;
+        oldlen = a.length;
+      }
+      a.length = stack[depth].dim;
+      if (depth>0){
+        item.a[item.i]=a;
         item.i++;
       }
       if (depth<dimmax){
@@ -828,20 +855,23 @@ 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
+          // array of dyn array
+          for (var i=0; i<srclen; i++) a[i]=src[i];
+          for (var i=oldlen; i<lastlen; i++) a[i]=[];
         } else if (rtl.isObject(defaultvalue)) {
           if (rtl.isTRecord(defaultvalue)){
-            for (var i=0; i<lastlen; i++){
+            // array of record
-              a[i]=(i<oldlen)?defaultvalue.$clone(src[i]):defaultvalue.$new(); // e.g. record
+            for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
+            for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
+          } else {
+            // array of set
+            for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
+            for (var i=oldlen; i<lastlen; i++) a[i]={};
           }
         } else {
-            for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?rtl.refSet(src[i]):{}; // e.g. set
+          for (var i=0; i<srclen; i++) a[i]=src[i];
-          }
+          for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
-        } else {
-          for (var i=0; i<lastlen; i++)
-            a[i]=(i<oldlen)?src[i]:defaultvalue;
         }
         while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
           depth--;
@@ -854,40 +884,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;