+ support for <dyn. array>+<dyn. array>, resolves #30463

git-svn-id: trunk@38406 -

.gitattributes

@@ -15873,6 +15873,7 @@ tests/webtbs/tw3041.pp svneol=native#text/plain
 tests/webtbs/tw30431.pp svneol=native#text/plain
 tests/webtbs/tw30443.pp svneol=native#text/plain
 tests/webtbs/tw3045.pp svneol=native#text/plain
+tests/webtbs/tw30463.pp svneol=native#text/pascal
 tests/webtbs/tw3048.pp svneol=native#text/plain
 tests/webtbs/tw30498.pp svneol=native#text/pascal
 tests/webtbs/tw30522.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -499,6 +499,13 @@ implementation
                       exit;
                     end;
 
+                 { <dyn. array> + <dyn. array> is handled by the compiler }
+                 if (treetyp=addn) and (is_dynamic_array(ld) or is_dynamic_array(rd)) then
+                    begin
+                      allowed:=false;
+                      exit;
+                    end;
+
                 allowed:=true;
               end;
             objectdef :

compiler/nadd.pas

@@ -56,6 +56,7 @@ interface
           { parts explicitely in the code generator (JM)    }
           function first_addstring: tnode; virtual;
           function first_addset: tnode; virtual;
+          function first_adddynarray : tnode; virtual;
           { only implements "muln" nodes, the rest always has to be done in }
           { the code generator for performance reasons (JM)                 }
           function first_add64bitint: tnode; virtual;
@@ -1236,12 +1237,12 @@ implementation
 
          { convert array constructors to sets, because there is no other operator
            possible for array constructors }
-         if is_array_constructor(left.resultdef) then
+         if not(is_dynamic_array(right.resultdef)) and is_array_constructor(left.resultdef) then
           begin
             arrayconstructor_to_set(left);
             typecheckpass(left);
           end;
-         if is_array_constructor(right.resultdef) then
+         if not(is_dynamic_array(left.resultdef)) and is_array_constructor(right.resultdef) then
           begin
             arrayconstructor_to_set(right);
             typecheckpass(right);
@@ -2120,7 +2121,16 @@ implementation
               inserttypeconv_explicit(right,left.resultdef)
           end
 
-       { support dynamicarray=nil,dynamicarray<>nil }
+         { <dyn. array>+<dyn. array> ? }
+         else if (nodetype=addn) and (is_dynamic_array(ld) or is_dynamic_array(rd)) then
+           begin
+              if not(is_dynamic_array(ld)) then
+                inserttypeconv(left,rd);
+              if not(is_dynamic_array(rd)) then
+                inserttypeconv(right,ld);
+           end
+
+        { support dynamicarray=nil,dynamicarray<>nil }
          else if (is_dynamic_array(ld) and (rt=niln)) or
                  (is_dynamic_array(rd) and (lt=niln)) or
                  (is_dynamic_array(ld) and is_dynamic_array(rd)) then
@@ -2729,6 +2739,104 @@ implementation
         end;
       end;
 
+    function taddnode.first_adddynarray : tnode;
+      var
+        p: tnode;
+        newstatement : tstatementnode;
+        tempnode (*,tempnode2*) : ttempcreatenode;
+        cmpfuncname: string;
+        para: tcallparanode;
+      begin
+        result:=nil;
+        { when we get here, we are sure that both the left and the right }
+        { node are both strings of the same stringtype (JM)              }
+        case nodetype of
+          addn:
+            begin
+              if (left.nodetype=arrayconstructorn) and (tarrayconstructornode(left).isempty) then
+                begin
+                  result:=right;
+                  left.free;
+                  left:=nil;
+                  right:=nil;
+                  exit;
+                end;
+              if (right.nodetype=arrayconstructorn) and (tarrayconstructornode(right).isempty) then
+                begin
+                  result:=left;
+                  left:=nil;
+                  right.free;
+                  right:=nil;
+                  exit;
+                end;
+              { create the call to the concat routine both strings as arguments }
+              if assigned(aktassignmentnode) and
+                  (aktassignmentnode.right=self) and
+                  (aktassignmentnode.left.resultdef=resultdef) and
+                  valid_for_var(aktassignmentnode.left,false) then
+                begin
+                  para:=ccallparanode.create(
+                          ctypeconvnode.create_internal(right,voidcodepointertype),
+                        ccallparanode.create(
+                          ctypeconvnode.create_internal(left,voidcodepointertype),
+                        ccallparanode.create(
+                          caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)),
+                        ccallparanode.create(
+                          ctypeconvnode.create_internal(aktassignmentnode.left.getcopy,voidcodepointertype),nil)
+                        )));
+                  result:=ccallnode.createintern(
+                            'fpc_dynarray_concat',
+                            para
+                          );
+                  include(aktassignmentnode.flags,nf_assign_done_in_right);
+                  firstpass(result);
+                end
+              else
+                begin
+                  result:=internalstatements(newstatement);
+                  tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
+                  addstatement(newstatement,tempnode);
+                  { initialize the temp, since it will be passed to a
+                    var-parameter (and finalization, which is performed by the
+                    ttempcreate node and which takes care of the initialization
+                    on native targets, is a noop on managed VM targets) }
+                  if (target_info.system in systems_managed_vm) and
+                     is_managed_type(resultdef) then
+                    addstatement(newstatement,cinlinenode.create(in_setlength_x,
+                      false,
+                      ccallparanode.create(genintconstnode(0),
+                        ccallparanode.create(ctemprefnode.create(tempnode),nil))));
+                  para:=ccallparanode.create(
+                          ctypeconvnode.create_internal(right,voidcodepointertype),
+                        ccallparanode.create(
+                          ctypeconvnode.create_internal(left,voidcodepointertype),
+                        ccallparanode.create(
+                          caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)),
+                        ccallparanode.create(
+                          ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidcodepointertype),nil)
+                        )));
+                  addstatement(
+                    newstatement,
+                    ccallnode.createintern(
+                      'fpc_dynarray_concat',
+                      para
+                    )
+                  );
+                  addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
+                  addstatement(newstatement,ctemprefnode.create(tempnode));
+                end;
+              { we reused the arguments }
+              left := nil;
+              right := nil;
+            end;
+          unequaln,equaln:
+            { nothing to do }
+            ;
+          else
+            Internalerror(2018030301);
+          end;
+      end;
+
 
     function taddnode.use_generic_mul32to64: boolean;
       begin
@@ -3218,6 +3326,15 @@ implementation
              exit;
            end;
 
+         { Can we optimize multiple dyn. array additions into a single call?
+           This need to be done on a complete tree to detect the multiple
+           add nodes and is therefor done before the subtrees are processed }
+         if canbemultidynarrayadd(self) then
+           begin
+             result:=genmultidynarrayadd(self);
+             exit;
+           end;
+
          { typical set tests like (s*[const. set])<>/=[] can be converted into an or'ed chain of in tests
            for var sets if const. set contains only a few elements }
          if (cs_opt_level1 in current_settings.optimizerswitches) and (nodetype in [unequaln,equaln]) and (left.resultdef.typ=setdef) and not(is_smallset(left.resultdef)) then
@@ -3581,6 +3698,11 @@ implementation
             end
 {$endif SUPPORT_MMX}
 
+         else if is_dynamic_array(ld) or is_dynamic_array(rd) then
+           begin
+             result:=first_adddynarray;
+             exit;
+           end
          { the general solution is to convert to 32 bit int }
          else
            begin

compiler/nld.pas

@@ -121,6 +121,7 @@ interface
           function docompare(p: tnode): boolean; override;
           procedure force_type(def:tdef);
           procedure insert_typeconvs;
+          function isempty : boolean;
        end;
        tarrayconstructornodeclass = class of tarrayconstructornode;
 
@@ -1016,6 +1017,12 @@ implementation
       end;
 
 
+    function tarrayconstructornode.isempty:boolean;
+      begin
+        result:=not(assigned(left)) and not(assigned(right));
+      end;
+
+
     function tarrayconstructornode.pass_typecheck:tnode;
       var
         hdef  : tdef;

compiler/nopt.pas

@@ -76,6 +76,8 @@ function canbeaddsstringcsstringoptnode(p: taddnode): boolean;
 function genaddsstringcsstringoptnode(p: taddnode): tnode;
 function canbemultistringadd(p: taddnode): boolean;
 function genmultistringadd(p: taddnode): tnode;
+function canbemultidynarrayadd(p: taddnode): boolean;
+function genmultidynarrayadd(p: taddnode): tnode;
 
 
 function is_addsstringoptnode(p: tnode): boolean;
@@ -406,6 +408,97 @@ begin
     end;
 end;
 
+
+function canbemultidynarrayadd(p: taddnode): boolean;
+var
+  hp : tnode;
+  i  : longint;
+begin
+  result:=false;
+  if not(is_dynamic_array(p.resultdef)) then
+    exit;
+  i:=0;
+  hp:=p;
+  while assigned(hp) and (hp.nodetype=addn) do
+    begin
+      inc(i);
+      hp:=taddnode(hp).left;
+    end;
+  result:=(i>1);
+end;
+
+
+function genmultidynarrayadd(p: taddnode): tnode;
+var
+  hp,sn : tnode;
+  arrp  : tarrayconstructornode;
+  newstatement : tstatementnode;
+  tempnode    : ttempcreatenode;
+  para : tcallparanode;
+begin
+  arrp:=nil;
+  hp:=p;
+  while assigned(hp) and (hp.nodetype=addn) do
+    begin
+      sn:=ctypeconvnode.create_internal(taddnode(hp).right.getcopy,voidpointertype);
+      arrp:=carrayconstructornode.create(sn,arrp);
+      hp:=taddnode(hp).left;
+    end;
+  sn:=ctypeconvnode.create_internal(hp.getcopy,voidpointertype);
+  arrp:=carrayconstructornode.create(sn,arrp);
+  arrp.allow_array_constructor:=true;
+  if assigned(aktassignmentnode) and
+     (aktassignmentnode.right=p) and
+     (aktassignmentnode.left.resultdef=p.resultdef) and
+     valid_for_var(aktassignmentnode.left,false) then
+    begin
+      para:=ccallparanode.create(
+              arrp,
+            ccallparanode.create(
+              caddrnode.create_internal(crttinode.create(tstoreddef(p.resultdef),initrtti,rdt_normal)),
+            ccallparanode.create(
+              ctypeconvnode.create_internal(aktassignmentnode.left.getcopy,voidpointertype),nil)
+          ));
+      result:=ccallnode.createintern(
+                'fpc_dynarray_concat_multi',
+                para
+              );
+      include(aktassignmentnode.flags,nf_assign_done_in_right);
+    end
+  else
+    begin
+      result:=internalstatements(newstatement);
+      tempnode:=ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent ,true);
+      addstatement(newstatement,tempnode);
+      { initialize the temp, since it will be passed to a
+        var-parameter (and finalization, which is performed by the
+        ttempcreate node and which takes care of the initialization
+        on native targets, is a noop on managed VM targets) }
+      if (target_info.system in systems_managed_vm) and
+         is_managed_type(p.resultdef) then
+        addstatement(newstatement,cinlinenode.create(in_setlength_x,
+          false,
+          ccallparanode.create(genintconstnode(0),
+            ccallparanode.create(ctemprefnode.create(tempnode),nil))));
+      para:=ccallparanode.create(
+              arrp,
+            ccallparanode.create(
+              caddrnode.create_internal(crttinode.create(tstoreddef(p.resultdef),initrtti,rdt_normal)),
+            ccallparanode.create(
+              ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidpointertype),nil)
+          ));
+      addstatement(
+        newstatement,
+        ccallnode.createintern(
+          'fpc_dynarray_concat_multi',
+          para
+        )
+      );
+      addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
+      addstatement(newstatement,ctemprefnode.create(tempnode));
+    end;
+end;
+
 begin
   caddsstringcharoptnode := taddsstringcharoptnode;
   caddsstringcsstringoptnode := taddsstringcsstringoptnode;

rtl/inc/compproc.inc

@@ -81,6 +81,7 @@ procedure fpc_dynarray_assign(var dest : pointer; src : pointer; ti: pointer); c
 procedure fpc_dynarray_delete(var p : pointer;source,count : SizeInt;pti : pointer);compilerproc;
 procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;count : SizeInt;pti : pointer);compilerproc;
 procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr:array of pointer); compilerproc;
+procedure fpc_dynarray_concat(var dest : pointer; pti: pointer; const src1,src2 : pointer); compilerproc;
 {$endif VER3_0}
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
 

rtl/inc/dynarr.inc

@@ -401,11 +401,7 @@ procedure fpc_dynarray_delete(var p : pointer;source,count : SizeInt;pti : point
        end;
 
      { skip kind and name }
-{$ifdef VER3_0}
-     ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
-{$else VER3_0}
      ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
-{$endif VER3_0}
 
      elesize:=pdynarraytypedata(ti)^.elSize;
      eletype:=pdynarraytypedata(ti)^.elType2^;
@@ -468,6 +464,7 @@ procedure fpc_dynarray_delete(var p : pointer;source,count : SizeInt;pti : point
     newp^.high:=newhigh;
   end;
 
+
 procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;count : SizeInt;pti : pointer);compilerproc;
   var
     newhigh,
@@ -501,11 +498,7 @@ procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;co
       source:=0;
 
     { skip kind and name }
-{$ifdef VER3_0}
-    ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
-{$else VER3_0}
     ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
-{$endif VER3_0}
 
     elesize:=pdynarraytypedata(ti)^.elSize;
     eletype:=pdynarraytypedata(ti)^.elType2^;
@@ -600,6 +593,7 @@ procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;co
     newp^.high:=newhigh;
   end;
 
+
 procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr:array of pointer); compilerproc;
   var
     i,
@@ -610,11 +604,8 @@ procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr
     srealp : pdynarray;
     ti : pointer;
     elesize : sizeint;
-    {eletype,}eletypemngd : pointer;
+    eletypemngd : pointer;
   begin
-    { the destination is overwritten in each case, so clear it }
-    fpc_dynarray_clear(dest,pti);
-
     { sanity check }
     if length(sarr)=0 then
       exit;
@@ -622,35 +613,33 @@ procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr
     totallen:=0;
     for i:=0 to high(sarr) do
       if assigned(sarr[i]) then
-        begin
+        inc(totallen,pdynarray(sarr[i]-sizeof(tdynarray))^.high+1);
-          srealp:=pdynarray(sarr[i]-sizeof(tdynarray));
-          inc(totallen,srealp^.high+1);
-        end;
 
     if totallen=0 then
-      exit;
+      begin
+        fpc_dynarray_clear(dest,pti);
+        exit;
+      end;
 
     { skip kind and name }
-{$ifdef VER3_0}
-    ti:=aligntoptr(Pointer(pti)+2+PByte(pti)[1]);
-{$else VER3_0}
     ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
-{$endif VER3_0}
 
     elesize:=pdynarraytypedata(ti)^.elSize;
-    //eletype:=pdynarraytypedata(ti)^.elType2^;
+
     { only set if type needs initialization }
     if assigned(pdynarraytypedata(ti)^.elType) then
       eletypemngd:=pdynarraytypedata(ti)^.elType^
     else
       eletypemngd:=nil;
 
-    { allocate new array }
-    getmem(newp,totallen*elesize+sizeof(tdynarray));
-    fillchar(newp^,sizeof(tdynarray),0);
-
     { copy the elements of each source array }
     offset:=0;
+
+    { the idea to reuse the first array, re-allocate it and append the other entries is not possible as the first entry
+      might be finalized later on by the caller however in case of a re-allocate, the entry itself might be gone }
+    { allocate new array }
+    getmem(newp,totallen*elesize+sizeof(tdynarray));
+
     for i:=0 to high(sarr) do
       if assigned(sarr[i]) then
         begin
@@ -661,6 +650,79 @@ procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr
               inc(offset,srealp^.high+1);
             end;
         end;
+    { increase reference counts of all the elements }
+    if assigned(eletypemngd) then
+      begin
+        for i:=0 to totallen-1 do
+          int_addref(pointer(newp)+sizeof(tdynarray)+i*elesize,eletypemngd);
+      end;
+
+    { clear at the end, dest could be a reference to an array being used also as source }
+    fpc_dynarray_clear(dest,pti);
+    dest:=pointer(newp)+sizeof(tdynarray);
+    newp^.refcount:=1;
+    newp^.high:=totallen-1;
+  end;
+
+
+procedure fpc_dynarray_concat(var dest : pointer; pti: pointer; const src1,src2 : pointer); compilerproc;
+  var
+    i,
+    offset,
+    totallen : sizeint;
+    newp,
+    realp,
+    srealp : pdynarray;
+    ti : pointer;
+    elesize : sizeint;
+    eletypemngd : pointer;
+  begin
+    totallen:=0;
+    if assigned(src1) then
+      inc(totallen,pdynarray(src1-sizeof(tdynarray))^.high+1);
+    if assigned(src2) then
+      inc(totallen,pdynarray(src2-sizeof(tdynarray))^.high+1);
+
+    if totallen=0 then
+      begin
+        fpc_dynarray_clear(dest,pti);
+        exit;
+      end;
+
+    { skip kind and name }
+    ti:=aligntoqword(Pointer(pti)+2+PByte(pti)[1]);
+
+    elesize:=pdynarraytypedata(ti)^.elSize;
+
+    { only set if type needs initialization }
+    if assigned(pdynarraytypedata(ti)^.elType) then
+      eletypemngd:=pdynarraytypedata(ti)^.elType^
+    else
+      eletypemngd:=nil;
+
+    { the idea to reuse the first array, re-allocate it and append the other entries is not possible as the first entry
+      might be finalized later on by the caller however in case of a re-allocate, the entry itself might be gone }
+    { allocate new array }
+    getmem(newp,totallen*elesize+sizeof(tdynarray));
+
+    { copy the elements of each source array }
+    offset:=0;
+    if assigned(src1) then
+      begin
+        srealp:=pdynarray(src1-sizeof(tdynarray));
+        if srealp^.high>=0 then
+          begin
+            move(src1^,(pointer(newp)+sizeof(tdynarray)+offset*elesize)^,(srealp^.high+1)*elesize);
+            inc(offset,srealp^.high+1);
+          end;
+      end;
+
+    if assigned(src2) then
+      begin
+        srealp:=pdynarray(src2-sizeof(tdynarray));
+        if srealp^.high>=0 then
+          move(src2^,(pointer(newp)+sizeof(tdynarray)+offset*elesize)^,(srealp^.high+1)*elesize);
+      end;
 
     { increase reference counts of all the elements }
     if assigned(eletypemngd) then
@@ -669,6 +731,8 @@ procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr
           int_addref(pointer(newp)+sizeof(tdynarray)+i*elesize,eletypemngd);
       end;
 
+    { clear at the end, dest could be a reference to an array being also source }
+    fpc_dynarray_clear(dest,pti);
     dest:=pointer(newp)+sizeof(tdynarray);
     newp^.refcount:=1;
     newp^.high:=totallen-1;

tests/webtbs/tw30463.pp

@@ -0,0 +1,46 @@
+{$mode objfpc}
+procedure p1;
+  var
+    A: array of Integer;
+    i: integer;
+  begin
+    A := [];
+    A := A + A;
+    A := Concat(A,[123456789]);
+    A := A + [6];
+    A := A + A;
+
+    if A[0]<>123456789 then
+      Halt(1);
+    if A[High(A)]<>6 then
+      Halt(1);
+  end;
+
+procedure p2;
+  var
+    A, B, C: array of Integer;
+
+    i: integer;
+  begin
+    A := [];
+    A := A + A + A;
+    A := Concat(A,[123456789],[8]);
+    A := A + [6] + A;
+    A := A + A + A;
+    B:=copy(A);
+    C:=B+A;
+
+    if C[0]<>123456789 then
+      Halt(1);
+    if C[High(C)]<>8 then
+      Halt(1);
+    if C[High(C)-1]<>123456789 then
+      Halt(1);
+  end;
+
+begin
+//  p1;
+  p2;
+  writeln('ok');
+end.
+