pastojs: SetLength(arr,dim1,dim2,...) and keep old values

git-svn-id: trunk@37354 -

packages/pastojs/src/fppas2js.pp

@@ -113,7 +113,7 @@ Works:
 - dynamic arrays
   - arrays can be null
   - init as "arr = []"  so typeof works
-  - SetLength(arr,len) becomes  arr = SetLength(arr,len,defaultvalue)
+  - SetLength(arr,dim1,...) becomes  arr = rtl.arraySetLength(arr,defaultvalue,dim1,dim2,...)
   - length(), low(), high(), assigned(), concat()
   - assign nil -> []  so typeof works
   - read, write element arr[index]
@@ -129,7 +129,7 @@ Works:
   - const c: dynarray = (a,b,...)
 - static arrays
   - range: enumtype, boolean, int, char, custom int
-  - init as arr = rtl.arrayNewMultiDim([dim1,dim2,...],value)
+  - init as arr = rtl.arraySetLength(null,value,dim1,dim2,...)
   - init with expression
   - length(1-dim array)
   - low(1-dim array), high(1-dim array)
@@ -384,7 +384,6 @@ type
     pbifnArray_Concat,
     pbifnArray_Copy,
     pbifnArray_Length,
-    pbifnArray_NewMultiDim,
     pbifnArray_SetLength,
     pbifnAs,
     pbifnAsExt,
@@ -487,7 +486,6 @@ const
     'arrayConcat', // rtl.arrayConcat
     'arrayCopy', // rtl.arrayCopy
     'length', // rtl.length
-    'arrayNewMultiDim', // rtl.arrayNewMultiDim
     'arraySetLength', // rtl.arraySetLength
     'as', // rtl.as
     'asExt', // rtl.asExt
@@ -539,7 +537,7 @@ const
     'symDiffSet', // rtl.symDiffSet >< (symmetrical difference)
     'unionSet', // rtl.unionSet +
     'spaceLeft', // rtl.spaceLeft
-    'strSetLength', // rtl.
+    'strSetLength', // rtl.strSetLength
     '$init',
     '$e',
     '$impl',
@@ -6376,6 +6374,7 @@ var
   ValInit: TJSElement;
   AssignContext: TAssignContext;
   ElType: TPasType;
+  i: Integer;
 begin
   Result:=nil;
   Param0:=El.Params[0];
@@ -6387,13 +6386,13 @@ begin
   {$ENDIF}
   if ResolvedParam0.TypeEl is TPasArrayType then
     begin
-    // SetLength(AnArray,newlength)
+    // SetLength(AnArray,dim1,dim2,...)
     ArrayType:=TPasArrayType(ResolvedParam0.TypeEl);
     {$IFDEF VerbosePasResolver}
     writeln('TPasToJSConverter.ConvertBuiltInSetLength array');
     {$ENDIF}
 
-    // ->  AnArray = rtl.setArrayLength(AnArray,newlength,initvalue)
+    // ->  AnArray = rtl.setArrayLength(AnArray,defaultvalue,dim1,dim2,...)
     AssignContext:=TAssignContext.Create(El,nil,AContext);
     try
       AContext.Resolver.ComputeElement(Param0,AssignContext.LeftResolved,[rcNoImplicitProc]);
@@ -6406,15 +6405,21 @@ begin
       Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_SetLength]]);
       // 1st param: AnArray
       Call.AddArg(ConvertElement(Param0,AContext));
-      // 2nd param: newlength
-      Call.AddArg(ConvertElement(El.Params[1],AContext));
-      // 3rd param: default value
+      // 2nd param: default value
+      for i:=3 to length(El.Params) do
+        begin
+        ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
+        ArrayType:=ElType as TPasArrayType;
+        end;
       ElType:=AContext.Resolver.ResolveAliasType(ArrayType.ElType);
       if ElType.ClassType=TPasRecordType then
         ValInit:=CreateReferencePathExpr(ElType,AContext)
       else
         ValInit:=CreateValInit(ElType,nil,Param0,AContext);
       Call.AddArg(ValInit);
+      // add params: dim1, dim2, ...
+      for i:=1 to length(El.Params)-1 do
+        Call.AddArg(ConvertElement(El.Params[i],AContext));
 
       // create left side:  array =
       Result:=CreateAssignStatement(Param0,AssignContext);
@@ -11063,7 +11068,7 @@ function TPasToJSConverter.CreateArrayInit(ArrayType: TPasArrayType;
   Expr: TPasExpr; El: TPasElement; AContext: TConvertContext): TJSElement;
 var
   Call: TJSCallExpression;
-  DimArray, ArrLit: TJSArrayLiteral;
+  ArrLit: TJSArrayLiteral;
   i, DimSize: Integer;
   RangeResolved, ElTypeResolved, ExprResolved: TPasResolverResult;
   Range: TPasExpr;
@@ -11072,6 +11077,7 @@ var
   DefaultValue: TJSElement;
   ArrayValues: TPasExprArray;
   US: TJSString;
+  DimLits: TObjectList;
 begin
   if Assigned(Expr) then
     begin
@@ -11110,16 +11116,18 @@ begin
   else
     begin
     // static array
-    // create "rtl.arrayNewMultiDim([dim1,dim2,...],defaultvalue)"
+    // create "rtl.arraySetLength(null,defaultvalue,dim1,dim2,...)"
     if AContext.Resolver=nil then
       RaiseNotSupported(El,AContext,20170223113050,'');
     Result:=nil;
+    DimLits:=TObjectList.Create(true);
     try
       Call:=CreateCallExpression(El);
-      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_NewMultiDim]]);
-      // add parameter [dim1,dim2,...]
-      DimArray:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
-      Call.AddArg(DimArray);
+      Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnArray_SetLength]]);
+      // add parameter null
+      Call.AddArg(CreateLiteralNull(El));
+
+      // create parameters dim1,dim2,...
       CurArrayType:=ArrayType;
       while true do
         begin
@@ -11134,7 +11142,7 @@ begin
             RaiseNotSupported(Range,AContext,20170223113318,GetResolverResultDbg(RangeResolved));
             end;
           Lit:=CreateLiteralNumber(El,DimSize);
-          DimArray.Elements.AddElement.Expr:=Lit;
+          DimLits.Add(Lit);
           end;
         AContext.Resolver.ComputeElement(CurArrayType.ElType,ElTypeResolved,[rcType]);
         if (ElTypeResolved.TypeEl is TPasArrayType) then
@@ -11153,8 +11161,15 @@ begin
       DefaultValue:=CreateValInit(ElTypeResolved.TypeEl,nil,El,AContext);
       Call.AddArg(DefaultValue);
 
+      // add parameters dim1,dim2,...
+      for i:=0 to DimLits.Count-1 do
+        Call.AddArg(TJSElement(DimLits[i]));
+      DimLits.OwnsObjects:=false;
+      DimLits.Clear;
+
       Result:=Call;
     finally
+      DimLits.Free;
       if Result=nil then
         Call.Free;
     end;

packages/pastojs/tests/tcmodules.pas

@@ -316,6 +316,7 @@ type
     Procedure TestArrayEnumTypeRange;
     Procedure TestArray_SetLengthOutArg;
     Procedure TestArray_SetLengthProperty;
+    Procedure TestArray_SetLengthMultiDim;
     Procedure TestArray_OpenArrayOfString;
     Procedure TestArray_Concat;
     Procedure TestArray_Copy;
@@ -4941,7 +4942,7 @@ begin
     'this.b = false;'
     ]),
     LinesToStr([ // $mod.$main
-    '$mod.Arr = rtl.arraySetLength($mod.Arr,3,0);',
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,0,3);',
     '$mod.Arr[0] = 4;',
     '$mod.Arr[1] = rtl.length($mod.Arr) + $mod.Arr[0];',
     '$mod.Arr[$mod.i] = 5;',
@@ -5029,8 +5030,8 @@ begin
     '$mod.i = $mod.Arr2[6][7];',
     '$mod.Arr2[8][9] = $mod.i;',
     '$mod.i = $mod.Arr2[10][11];',
-    '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, 14, []);',
-    '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 16, 0);',
+    '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
+    '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
     '']));
 end;
 
@@ -5055,7 +5056,7 @@ begin
   ConvertProgram;
   CheckSource('TestArray_StaticInt',
     LinesToStr([ // statements
-    'this.Arr = rtl.arrayNewMultiDim([3],0);',
+    'this.Arr = rtl.arraySetLength(null,0,3);',
     'this.Arr2 = [5, 6, 7];',
     'this.i = 0;',
     'this.b = false;'
@@ -5098,8 +5099,8 @@ begin
   ConvertProgram;
   CheckSource('TestArray_StaticBool',
     LinesToStr([ // statements
-    'this.Arr = rtl.arrayNewMultiDim([2],false);',
-    'this.Arr2 = rtl.arrayNewMultiDim([1],false);',
+    'this.Arr = rtl.arraySetLength(null,false,2);',
+    'this.Arr2 = rtl.arraySetLength(null,false,1);',
     'this.Arr3 = [true, false];',
     'this.b = false;'
     ]),
@@ -5148,8 +5149,8 @@ begin
   ConvertProgram;
   CheckSource('TestArray_StaticChar',
     LinesToStr([ // statements
-    'this.Arr = rtl.arrayNewMultiDim([65536], "");',
-    'this.Arr2 = rtl.arrayNewMultiDim([26], "");',
+    'this.Arr = rtl.arraySetLength(null, "", 65536);',
+    'this.Arr2 = rtl.arraySetLength(null, "", 26);',
     'this.Arr3 = ["p", "a", "s"];',
     'this.Arr4 = ["p", "a", "s"];',
     'this.c = "";',
@@ -5216,8 +5217,8 @@ begin
     '$mod.i = $mod.Arr2[6][7];',
     '$mod.Arr2[8][9] = $mod.i;',
     '$mod.i = $mod.Arr2[10][11];',
-    '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, 14, []);',
-    '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 16, 0);',
+    '$mod.Arr2 = rtl.arraySetLength($mod.Arr2, [], 14);',
+    '$mod.Arr2[15] = rtl.arraySetLength($mod.Arr2[15], 0, 16);',
     '']));
 end;
 
@@ -5260,7 +5261,7 @@ begin
     'this.i = 0;'
     ]),
     LinesToStr([ // $mod.$main
-    '$mod.Arr = rtl.arraySetLength($mod.Arr,3, $mod.TRec);',
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,$mod.TRec,3);',
     '$mod.Arr[0].Int = 4;',
     '$mod.Arr[1].Int = rtl.length($mod.Arr)+$mod.Arr[2].Int;',
     '$mod.Arr[$mod.Arr[$mod.i].Int].Int = $mod.Arr[5].Int;',
@@ -5475,7 +5476,7 @@ begin
     '};',
     'this.e = 0;',
     'this.i = 0;',
-    'this.a = rtl.arrayNewMultiDim([2],0);',
+    'this.a = rtl.arraySetLength(null,0,2);',
     'this.numbers = [1, 2];',
     'this.names = ["red", "blue"];',
     '']),
@@ -5502,7 +5503,7 @@ begin
   CheckSource('TestArray_SetLengthOutArg',
     LinesToStr([ // statements
     'this.DoIt = function (a) {',
-    '  a.set(rtl.arraySetLength(a.get(), 2, 0));',
+    '  a.set(rtl.arraySetLength(a.get(), 0, 2));',
     '};',
     '']),
     LinesToStr([
@@ -5534,7 +5535,29 @@ begin
     'this.Obj = null;',
     '']),
     LinesToStr([
-    '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 2, 0));',
+    '$mod.Obj.SetColors(rtl.arraySetLength($mod.Obj.GetColors(), 0, 2));',
+    '']));
+end;
+
+procedure TTestModule.TestArray_SetLengthMultiDim;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TArrArrInt = array of array of longint;',
+  'var',
+  '  a: TArrArrInt;',
+  'begin',
+  '  SetLength(a,2);',
+  '  SetLength(a,3,4);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestArray_SetLengthMultiDim',
+    LinesToStr([ // statements
+    'this.a = [];']),
+    LinesToStr([
+    '$mod.a = rtl.arraySetLength($mod.a, [], 2);',
+    '$mod.a = rtl.arraySetLength($mod.a, 0, 3, 4);',
     '']));
 end;
 
@@ -12362,8 +12385,8 @@ begin
     LinesToStr([ // $mod.$main
     '$mod.Arr = $mod.TheArray;',
     '$mod.TheArray = $mod.Arr;',
-    '$mod.Arr = rtl.arraySetLength($mod.Arr,2,undefined);',
-    '$mod.TheArray = rtl.arraySetLength($mod.TheArray,3,undefined);',
+    '$mod.Arr = rtl.arraySetLength($mod.Arr,undefined,2);',
+    '$mod.TheArray = rtl.arraySetLength($mod.TheArray,undefined,3);',
     '$mod.Arr[4] = $mod.v;',
     '$mod.Arr[5] = rtl.length($mod.TheArray);',
     '$mod.Arr[6] = null;',
@@ -14488,7 +14511,7 @@ begin
     '  procsig: rtl.newTIProcSig(null),',
     '  methodkind: 0',
     '});',
-    'this.StaticArray = rtl.arrayNewMultiDim([2], "");',
+    'this.StaticArray = rtl.arraySetLength(null,"",2);',
     'this.tiStaticArray = null;',
     'this.DynArray = [];',
     'this.tiDynArray = null;',