View Issue Details

IDProjectCategoryView StatusLast Update
0037221FPCCompilerpublic2020-09-18 17:02
ReporterOndrej Pokorny Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityN/A
Status resolvedResolutionfixed 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0037221: [Patch] Copy() from open array to dynamic array
DescriptionThe attached patch extends the Copy() intrinsic to be able to copy an open array to a dynamic array
Steps To Reproduceprocedure Test(const A: array of Integer);
var
  B: array of Integer;
begin
  B := Copy(A);
  B := Copy(A, 2, Length(A)-2);
end;
TagsNo tags attached.
Fixed in Revision46890
FPCOldBugId
FPCTarget-
Attached Files

Activities

Ondrej Pokorny

2020-06-16 20:33

developer  

CopyConstArray.lpr (993 bytes)   
program CopyConstArray;

{$mode objfpc}{$h+}

type
  TIntegerArray = array of Integer;

procedure WritelnArray(const A: TIntegerArray);
var
  I: Integer;
begin
  for I in A do
    Writeln(I);
end;

procedure TestOpen(const A: array of Integer);
var
  B: array of Integer;
begin
  B := Copy(A);
  WritelnArray(B);
end;

procedure TestOpen2(const A: array of Integer);
var
  B: array of Integer;
begin
  B := Copy(A, 1, 2);
  WritelnArray(B);
end;

procedure TestDyn(const A: TIntegerArray);
var
  B: array of Integer;
begin
  B := Copy(A);
  WritelnArray(B);
end;

procedure TestDyn2(const A: TIntegerArray);
var
  B: array of Integer;
begin
  B := Copy(A, 1, 2);
  WritelnArray(B);
end;

begin
  Writeln('TestOpen:');
  TestOpen([0, 1, 2, 3, 4, 5]);
  Writeln('TestOpen2:');
  TestOpen2([0, 1, 2, 3, 4, 5]);
  Writeln('TestDyn:');
  TestDyn([0, 1, 2, 3, 4, 5]);
  Writeln('TestDyn2:');
  TestDyn2([0, 1, 2, 3, 4, 5]);
  ReadLn;
end.

CopyConstArray.lpr (993 bytes)   
CopyOpen2DynArray-02.patch (7,770 bytes)   
Index: compiler/ninl.pas
===================================================================
--- compiler/ninl.pas	(revision 45251)
+++ compiler/ninl.pas	(working copy)
@@ -1898,8 +1898,17 @@
           begin
             minargs:=1;
             resultdef:=paradef;
-            func:='fpc_dynarray_copy';
+            func:='fpc_array_to_dynarray_copy';
           end
+        else
+         if is_open_array(paradef) then
+          begin
+            minargs:=1;
+            resultdef:=carraydef.create(0, -1, tarraydef(paradef).rangedef);
+            tarraydef(resultdef).arrayoptions := tarraydef(resultdef).arrayoptions + [ado_IsDynamicArray];
+            tarraydef(resultdef).elementdef := tarraydef(paradef).elementdef;
+            func:='fpc_array_to_dynarray_copy';
+          end
         else if counter in [2..3] then
           begin
             resultdef:=cshortstringtype;
@@ -4665,7 +4674,12 @@
     function tinlinenode.first_copy: tnode;
       var
         lowppn,
-        highppn,
+        countppn,
+        elesizeppn,
+        eletypeppn,
+        maxcountppn,
+        arrayppn,
+        rttippn,
         npara,
         paras   : tnode;
         ppn     : tcallparanode;
@@ -4705,16 +4719,26 @@
         else if is_dynamic_array(resultdef) then
           begin
             { create statements with call }
+            elesizeppn:=cordconstnode.create(tarraydef(paradef).elesize,sinttype,false);
+            eletypeppn:=caddrnode.create_internal(
+              crttinode.create(tstoreddef(tarraydef(paradef).elementdef),fullrtti,rdt_normal));
+            maxcountppn:=geninlinenode(in_length_x,false,ppn.left.getcopy);
             case counter of
               1:
                 begin
                   { copy the whole array using [0..high(sizeint)] range }
-                  highppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
+                  countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
                   lowppn:=cordconstnode.create(0,sinttype,false);
                 end;
+              2:
+                begin
+                  { copy the array using [low..high(sizeint)] range }
+                  countppn:=cordconstnode.create(torddef(sinttype).high,sinttype,false);
+                  lowppn:=tcallparanode(paras).left.getcopy;
+                end;
               3:
                 begin
-                  highppn:=tcallparanode(paras).left.getcopy;
+                  countppn:=tcallparanode(paras).left.getcopy;
                   lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
                 end;
               else
@@ -4721,14 +4745,28 @@
                 internalerror(2012100701);
             end;
 
-            { create call to fpc_dynarray_copy }
-            npara:=ccallparanode.create(highppn,
+            if is_open_array(paradef) then
+              begin
+                arrayppn:=caddrnode.create_internal(ppn.left);
+                rttippn:=cordconstnode.create(0,voidpointertype,false);
+              end
+            else if is_dynamic_array(paradef) then
+              begin
+                arrayppn:=ctypeconvnode.create_internal(ppn.left,voidpointertype);
+                rttippn:=caddrnode.create_internal(crttinode.create(tstoreddef(paradef),initrtti,rdt_normal));
+              end
+            else
+              internalerror(2012100702);
+
+            { create call to fpc_array_to_dynarray_copy }
+            npara:=ccallparanode.create(eletypeppn,
+                   ccallparanode.create(elesizeppn,
+                   ccallparanode.create(maxcountppn,
+                   ccallparanode.create(countppn,
                    ccallparanode.create(lowppn,
-                   ccallparanode.create(caddrnode.create_internal
-                      (crttinode.create(tstoreddef(paradef),initrtti,rdt_normal)),
-                   ccallparanode.create
-                      (ctypeconvnode.create_internal(ppn.left,voidpointertype),nil))));
-            result:=ccallnode.createinternres('fpc_dynarray_copy',npara,paradef);
+                   ccallparanode.create(rttippn,
+                   ccallparanode.create(arrayppn,nil)))))));
+            result:=ccallnode.createinternres('fpc_array_to_dynarray_copy',npara,resultdef);
 
             ppn.left:=nil;
             paras.free;
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc	(revision 45251)
+++ rtl/inc/compproc.inc	(working copy)
@@ -69,6 +69,11 @@
 {$ifdef FPC_HAS_FEATURE_DYNARRAYS}
 function fpc_dynarray_copy(psrc : pointer;ti : pointer;
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
+function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
+    elesize : sizeint;
+    eletype : pointer
+    ) : fpc_stub_dynarray;compilerproc;
 function  fpc_dynarray_length(p : pointer) : tdynarrayindex; compilerproc;
 function  fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
 procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
Index: rtl/inc/dynarr.inc
===================================================================
--- rtl/inc/dynarr.inc	(revision 45251)
+++ rtl/inc/dynarr.inc	(working copy)
@@ -323,13 +323,34 @@
     lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
   var
     realpsrc : pdynarray;
+  begin
+     fpc_dynarray_clear(pointer(result),ti);
+     if psrc=nil then
+       exit;
+     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
+     fpc_array_to_dynarray_copy(psrc, ti, lowidx, count, realpsrc^.high+1,pdynarraytypedata(ti)^.elSize,pdynarraytypedata(ti)^.elType);
+  end;
+
+{ provide local access to array_to_dynarray_copy }
+function int_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
+    elesize : sizeint;
+    eletype : pointer
+    ) : fpc_stub_dynarray;[external name 'FPC_ARR_TO_DYNARR_COPY'];
+
+{ copy a custom array (open/dynamic/static) to dynamic array }
+function fpc_array_to_dynarray_copy(psrc : pointer;ti : pointer;
+    lowidx,count,maxcount:tdynarrayindex;
+    elesize : sizeint;
+    eletype : pointer
+    ) : fpc_stub_dynarray;[Public,Alias:'FPC_ARR_TO_DYNARR_COPY'];compilerproc;
+  var
     i,size : sizeint;
-    elesize : sizeint;
-    eletype : pointer;
   begin
      fpc_dynarray_clear(pointer(result),ti);
      if psrc=nil then
        exit;
+
 {$ifndef FPC_DYNARRAYCOPY_FIXED}
      if (lowidx=-1) and (count=-1) then
        begin
@@ -337,7 +358,6 @@
          count:=high(tdynarrayindex);
        end;
 {$endif FPC_DYNARRAYCOPY_FIXED}
-     realpsrc:=pdynarray(psrc-sizeof(tdynarray));
      if (lowidx<0) then
        begin
        { Decrease count if index is negative, this is different from how copy()
@@ -347,29 +367,11 @@
          count:=count+lowidx;
          lowidx:=0;
        end;
-     if (count>realpsrc^.high-lowidx+1) then
-       count:=realpsrc^.high-lowidx+1;
+     if (count>maxcount-lowidx) then
+       count:=maxcount-lowidx;
      if count<=0 then
        exit;
 
-     { skip kind and name }
-{$ifdef VER3_0}
-     ti:=aligntoptr(ti+2+PByte(ti)[1]);
-{$else VER3_0}
-     ti:=aligntoqword(ti+2+PByte(ti)[1]);
-{$endif VER3_0}
-
-     elesize:=pdynarraytypedata(ti)^.elSize;
-     { only set if type needs finalization }
-     {$ifdef VER3_0}
-     eletype:=pdynarraytypedata(ti)^.elType;
-     {$else}
-     if assigned(pdynarraytypedata(ti)^.elType) then
-       eletype:=pdynarraytypedata(ti)^.elType^
-     else
-       eletype:=nil;
-     {$endif}
-
      { create new array }
      size:=elesize*count;
      getmem(pointer(result),size+sizeof(tdynarray));
CopyOpen2DynArray-02.patch (7,770 bytes)   

Sven Barth

2020-09-18 17:02

manager   ~0125620

I'm sorry for the long wait and thank you for the patch. I had to adjust a few things (e.g. fpc_dynarray_copy is only needed for cycling with 3.2.0; also the code in there would not have worked with 3.2.0 anymore; additionally eletype should be Nil for non-managed types).

Please test and close if okay.

Issue History

Date Modified Username Field Change
2020-06-16 20:33 Ondrej Pokorny New Issue
2020-06-16 20:33 Ondrej Pokorny File Added: CopyConstArray.lpr
2020-06-16 20:33 Ondrej Pokorny File Added: CopyOpen2DynArray-02.patch
2020-09-18 16:11 Sven Barth Assigned To => Sven Barth
2020-09-18 16:11 Sven Barth Status new => assigned
2020-09-18 17:02 Sven Barth Status assigned => resolved
2020-09-18 17:02 Sven Barth Resolution open => fixed
2020-09-18 17:02 Sven Barth Fixed in Version => 3.3.1
2020-09-18 17:02 Sven Barth Fixed in Revision => 46890
2020-09-18 17:02 Sven Barth FPCTarget => -
2020-09-18 17:02 Sven Barth Note Added: 0125620