pastojs: fixed concat array of record and static array

loongson · Sep 12, 2022 · 02f4173 · 02f4173
1 parent eff489a
commit 02f4173
Show file tree

Hide file tree

Showing 4 changed files with 68 additions and 16 deletions.
diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas
@@ -841,6 +841,7 @@   TTestResolverReferenceData = record
     Procedure TestArray_DynArrayChar;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
+    Procedure TestRecordArray_CopyConcat;
     Procedure TestArray_CopyMismatchFail;
     Procedure TestArray_InsertDeleteAccess;
     Procedure TestArray_InsertArray;
@@ -15451,6 +15452,33 @@ procedure TTestResolver.TestStaticArray_CopyConcat;
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecordArray_CopyConcat;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch arrayoperators}',
+  'type',
+  '  TRec = record w: word; end;',
+  '  TDynRec = array of TRec;',
+  'var',
+  '  r: TRec;',
+  '  A: TDynRec;',
+  '  B: TDynRec;',
+  '  C: array of TRec;',
+  'begin',
+  '  A:=A+[r];',
+  '  A:=Concat(A,[r]);',
+  '  A:=Concat(B,[r]);',
+  '  A:=Concat(C,[r]);',
+  '  C:=Concat(A,[r]);',
+  '  A:=Copy(B,1);',
+  '  A:=Copy(B,2,3);',
+  '  A:=Copy(C,4);',
+  '  A:=Copy(C,5,6);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArray_CopyMismatchFail;
 begin
   StartProgram(false);

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
@@ -18935,6 +18935,8 @@ function TPasToJSConverter.CreateArrayConcat(
 var
   Call: TJSCallExpression;
   Func: TPas2JSBuiltInName;
+  TypeEl: TPasType;
+  ArrayType: TPasArrayType;
 begin
   Result:=nil;
   Call:=CreateCallExpression(PosEl);
@@ -18948,11 +18950,27 @@ function TPasToJSConverter.CreateArrayConcat(
       Func:=pbifnArray_Concat;
     if ElTypeResolved.BaseType=btContext then
       begin
-      if ElTypeResolved.LoTypeEl.ClassType=TPasRecordType then
+      TypeEl:=ElTypeResolved.LoTypeEl;
+      if TypeEl.ClassType=TPasArrayType then
+        begin
+        ArrayType:=TPasArrayType(TypeEl);
+        if length(ArrayType.Ranges)>0 then
+          begin
+          // static array
+          Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(Func)]);
+          if AContext.Resolver.HasStaticArrayCloneFunc(ArrayType) then
+            // static array with $clone: rtl.arrayConcat(TArrayOfStaticRec$clone,array1,array2,...)
+            Call.AddArg(CreatePrimitiveDotExpr(CreateReferencePath(TypeEl,AContext,rpkPathAndName)+GetBIName(pbifnArray_Static_Clone),PosEl))
+          else
+            // static array of simple type: rtl.arrayConcat("slice",array1,array2,...)
+            Call.AddArg(CreateLiteralString(PosEl,'slice'));
+          end;
+        end
+      else if TypeEl.ClassType=TPasRecordType then
         begin
         // record: rtl.arrayConcat(RecordType,array1,array2,...)
         Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(Func)]);
-        Call.AddArg(CreateReferencePathExpr(ElTypeResolved.LoTypeEl,AContext));
+        Call.AddArg(CreateReferencePathExpr(TypeEl,AContext));
         end;
       end
     else if ElTypeResolved.BaseType=btSet then
@@ -23261,7 +23279,8 @@ function TPasToJSConverter.ConvertDirectAssignArrayConcat(El: TPasImplAssign;
             Call.AddArg(ConvertExpression(FirstParam,ParentContext));
             for i:=0 to length(SubParams.Params)-1 do
               begin
-              JS:=CreateArrayEl(SubParams.Params[i],ParentContext);
+              JS:=ConvertExpression(SubParams.Params[i],ParentContext);
+              //JS:=CreateArrayEl(SubParams.Params[i],ParentContext);
               Call.AddArg(JS);
               end;
             Result:=Call;
@@ -23315,7 +23334,8 @@ function TPasToJSConverter.ConvertDirectAssignArrayAdd(El: TPasImplAssign;
       Call.AddArg(ConvertExpression(BinLeft,ParentContext));
       for i:=0 to length(SubParams.Params)-1 do
         begin
-        JS:=CreateArrayEl(SubParams.Params[i],ParentContext);
+        JS:=ConvertExpression(SubParams.Params[i],ParentContext);
+        //JS:=CreateArrayEl(SubParams.Params[i],ParentContext);
         Call.AddArg(JS);
         end;
       Result:=Call;

diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
@@ -11437,11 +11437,11 @@   '  TRec = record',
     '$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 2);',
     '$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 3, 4);',
     '$mod.ArrRec = $mod.ArrRec;',
-    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r));',
-    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r), $mod.TRec.$clone($mod.r));',
+    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.r);',
+    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.r, $mod.r);',
     '$mod.ArrSet = $mod.ArrSet;',
-    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f));',
-    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f), rtl.refSet($mod.f));',
+    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, $mod.f);',
+    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, $mod.f, $mod.f);',
     '$mod.ArrJSValue = $mod.ArrJSValue;',
     '$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 11);',
     '$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 12, 13);',
@@ -11708,10 +11708,10 @@   '  TRec = record',
     LinesToStr([ // $mod.$main
     '$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 2);',
     '$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 3, 4);',
-    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r));',
-    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r), $mod.TRec.$clone($mod.r));',
-    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f));',
-    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f), rtl.refSet($mod.f));',
+    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.r);',
+    '$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.r, $mod.r);',
+    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, $mod.f);',
+    '$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, $mod.f, $mod.f);',
     '$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 11);',
     '$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 12, 13);',
     '$mod.ArrFlag = rtl.arrayPushN($mod.ArrFlag, $mod.TFlag.small);',
@@ -11994,8 +11994,8 @@ procedure TTestModule.TestArray_ArrayLitStaticAsParam;
   CheckSource('TestArray_ArrayLitStaticAsParam',
     LinesToStr([ // statements
     'this.DoInt = function (a) {',
-    '  $mod.DoInt(rtl.arrayConcatN(a, [[1, 2]]));',
-    '  $mod.DoInt(rtl.arrayConcatN([[1, 2]], a));',
+    '  $mod.DoInt(rtl.arrayConcat("slice", a, [[1, 2]]));',
+    '  $mod.DoInt(rtl.arrayConcat("slice", [[1, 2]], a));',
     '  $mod.DoInt(a);',
     '};',
     'this.i = rtl.arraySetLength(null, 0, 2);',
@@ -12004,8 +12004,8 @@ procedure TTestModule.TestArray_ArrayLitStaticAsParam;
     LinesToStr([ // $mod.$main
     '$mod.a = [[1, 1]];',
     '$mod.a = [$mod.i.slice(0)];',
-    '$mod.a = rtl.arrayPushN($mod.a, $mod.i.slice(0));',
-    '$mod.a = rtl.arrayConcatN([$mod.i.slice(0)], $mod.a);',
+    '$mod.a = rtl.arrayPush("slice", $mod.a, $mod.i);',
+    '$mod.a = rtl.arrayConcat("slice", [$mod.i.slice(0)], $mod.a);',
     '$mod.DoInt([[1, 1]]);',
     '$mod.DoInt([[1, 2], [3, 4]]);',
     '']));

diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js
@@ -1002,6 +1002,10 @@ var rtl = {
     // This function does not range check.
     if(type === 'refSet') {
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = rtl.refSet(src[srcpos]); // ref set
+    } else if (type === 'slice'){
+      for (; srcpos<endpos; srcpos++) dst[dstpos++] = src[srcpos].slice(0); // clone static array of simple types
+    } else if (typeof(type)==='function'){
+      for (; srcpos<endpos; srcpos++) dst[dstpos++] = type(src[srcpos]); // clone function
     } else if (rtl.isTRecord(type)){
       for (; srcpos<endpos; srcpos++) dst[dstpos++] = type.$clone(src[srcpos]); // clone record
     }  else {