+ extend Concat() with support for dynamic arrays

+ added test

git-svn-id: trunk@37723 -

.gitattributes

@@ -12403,6 +12403,7 @@ tests/test/tarray10.pp svneol=native#text/plain
 tests/test/tarray11.pp svneol=native#text/pascal
 tests/test/tarray12.pp svneol=native#text/pascal
 tests/test/tarray13.pp svneol=native#text/pascal
+tests/test/tarray14.pp svneol=native#text/pascal
 tests/test/tarray2.pp svneol=native#text/plain
 tests/test/tarray3.pp svneol=native#text/plain
 tests/test/tarray4.pp svneol=native#text/plain

compiler/ninl.pas

@@ -124,7 +124,7 @@ implementation
 
     uses
       verbose,globals,systems,constexp,
-      globtype,cutils,fmodule,
+      globtype,cutils,cclasses,fmodule,
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
       cpuinfo,
       pass_1,
@@ -4850,10 +4850,21 @@ implementation
          begin
            CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'Concat');
            MessagePos1(fileinfo,sym_e_param_list,'Concat(String[;String;...])');
+           MessagePos1(fileinfo,sym_e_param_list,'Concat(Dynamic Array[;Dynamic Array;...])');
          end;
 
        var
          cpn : tcallparanode;
+         list : tfpobjectlist;
+         n,
+         arrn,
+         firstn : tnode;
+         startidx,
+         i : longint;
+         arrconstr : tarrayconstructornode;
+         newstatement : tstatementnode;
+         tempnode : ttempcreatenode;
+         lastchanged : boolean;
        begin
          if not assigned(left) then
            begin
@@ -4861,32 +4872,153 @@ implementation
              exit(cerrornode.create);
            end;
          result:=nil;
-         { the arguments are right to left, but we need them left to right
-           with the correct nesting }
+         { the arguments are right to left, but we need to work on them from
+           left to right, so insert them in a list and process that from back
+           to front }
+         list:=tfpobjectlist.create(false);
+         { remember the last (aka first) dynamic array parameter (important
+           in case of array constructors) }
+         arrn:=nil;
          cpn:=tcallparanode(left);
          while assigned(cpn) do
            begin
-             if assigned(result) then
+             list.add(cpn.left);
+             if is_dynamic_array(cpn.left.resultdef) then
+               arrn:=cpn.left;
+             cpn.left:=nil;
+             cpn:=tcallparanode(cpn.right);
+           end;
+
+         if list.count=0 then
+           internalerror(2017100901);
+
+         firstn:=tnode(list.last);
+         if not assigned(firstn) then
+           internalerror(2017100902);
+
+         { are we dealing with strings or dynamic arrays? }
+         if is_dynamic_array(firstn.resultdef) or is_array_constructor(firstn.resultdef) then
+           begin
+             { try to combine all consecutive array constructors }
+             lastchanged:=false;
+             i:=0;
+             repeat
+               if lastchanged or is_array_constructor(tnode(list[i]).resultdef) then
+                 begin
+                   if (i<list.count-1) and is_array_constructor(tnode(list[i+1]).resultdef) then
+                     begin
+                       arrconstr:=tarrayconstructornode(list[i+1]);
+                       while assigned(arrconstr.right) do
+                         arrconstr:=tarrayconstructornode(arrconstr.right);
+                       arrconstr.right:=tnode(list[i]);
+                       list[i]:=list[i+1];
+                       list.delete(i+1);
+                       lastchanged:=true;
+                       tnode(list[i]).resultdef:=nil;
+                       { don't increase index! }
+                       continue;
+                     end;
+                   if lastchanged then
+                     begin
+                       { we concatted all consecutive ones, so typecheck the new one again }
+                       n:=tnode(list[i]);
+                       typecheckpass(n);
+                       list[i]:=n;
+                     end;
+                   lastchanged:=false;
+                 end;
+               inc(i);
+             until i=list.count;
+
+             if list.count=1 then
                begin
-                 if result.nodetype=addn then
-                   taddnode(result).left:=caddnode.create(addn,cpn.left,taddnode(result).left)
-                 else
-                   result:=caddnode.create(addn,cpn.left,result);
+                 { no need to call the concat helper }
+                 result:=firstn;
                end
              else
                begin
-                 result:=cpn.left;
-                 { Force string type if it isn't yet }
-                 if not(
-                        (result.resultdef.typ=stringdef) or
-                        is_chararray(result.resultdef) or
-                        is_char(result.resultdef)
-                       ) then
-                   inserttypeconv(result,cshortstringtype);
+                 { if we reach this point then the concat list didn't consist
+                   solely of array constructors }
+                 if not assigned(arrn) then
+                   internalerror(2017101001);
+
+                 result:=internalstatements(newstatement);
+
+                 { generate the open array constructor for the source arrays
+                   note: the order needs to be swapped again here! }
+                 arrconstr:=nil;
+                 for i:=0 to list.count-1 do
+                   begin
+                     n:=tnode(list[i]);
+                     { first convert to the target type }
+                     if not is_array_constructor(n.resultdef) then
+                       inserttypeconv(n,arrn.resultdef);
+                     { we need to ensure that we get a reference counted
+                       assignement for the temp array }
+                     tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
+                     addstatement(newstatement,tempnode);
+                     addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),n));
+                     addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
+                     n:=ctemprefnode.create(tempnode);
+                     { then to a plain pointer for the helper }
+                     inserttypeconv_internal(n,voidpointertype);
+                     arrconstr:=carrayconstructornode.create(n,arrconstr);
+                   end;
+                 arrconstr.allow_array_constructor:=true;
+
+                 { based on the code from nopt.genmultistringadd() }
+                 tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.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(arrn.resultdef) then
+                   addstatement(newstatement,cinlinenode.create(in_setlength_x,
+                     false,
+                     ccallparanode.create(genintconstnode(0),
+                       ccallparanode.create(ctemprefnode.create(tempnode),nil))));
+
+                 cpn:=ccallparanode.create(
+                         arrconstr,
+                         ccallparanode.create(
+                           caddrnode.create_internal(crttinode.create(tstoreddef(arrn.resultdef),initrtti,rdt_normal)),
+                             ccallparanode.create(ctypeconvnode.create_internal(ctemprefnode.create(tempnode),voidpointertype),nil))
+                       );
+                 addstatement(
+                   newstatement,
+                   ccallnode.createintern(
+                     'fpc_dynarray_concat_multi',
+                     cpn
+                   )
+                 );
+                 addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode));
+                 addstatement(newstatement,ctemprefnode.create(tempnode));
+               end;
+           end
+         else
+           begin
+             { enforce strings }
+             for i:=list.count-1 downto 0 do
+               begin
+                 if assigned(result) then
+                   result:=caddnode.create(addn,result,tnode(list[i]))
+                 else
+                   begin
+                     result:=tnode(list[i]);
+                     { Force string type if it isn't yet }
+                     if not(
+                            (result.resultdef.typ=stringdef) or
+                            is_chararray(result.resultdef) or
+                            is_char(result.resultdef)
+                           ) then
+                       inserttypeconv(result,cshortstringtype);
+                   end;
                end;
-             cpn.left:=nil;
-             cpn:=tcallparanode(cpn.right);
            end;
+
+         list.free;
        end;
 
 

rtl/inc/compproc.inc

@@ -80,6 +80,7 @@ procedure fpc_dynarray_assign(var dest : pointer; src : pointer; ti: pointer); c
 { no reference to the Delete()/Insert() intrinsic, due to typeinfo parameter }
 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;
 {$endif VER3_0}
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
 

rtl/inc/dynarr.inc

@@ -599,6 +599,80 @@ procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;co
     newp^.refcount:=1;
     newp^.high:=newhigh;
   end;
+
+procedure fpc_dynarray_concat_multi(var dest : pointer; pti: pointer; const sarr:array of pointer); compilerproc;
+  var
+    i,
+    offset,
+    totallen : sizeint;
+    newp,
+    realp,
+    srealp : pdynarray;
+    ti : pointer;
+    elesize : sizeint;
+    {eletype,}eletypemngd : pointer;
+  begin
+    { the destination is overwritten in each case, so clear it }
+    fpc_dynarray_clear(dest,ti);
+
+    { sanity check }
+    if length(sarr)=0 then
+      exit;
+
+    totallen:=0;
+    for i:=0 to high(sarr) do
+      if assigned(sarr[i]) then
+        begin
+          srealp:=pdynarray(sarr[i]-sizeof(tdynarray));
+          inc(totallen,srealp^.high+1);
+        end;
+
+    if totallen=0 then
+      exit;
+
+    { 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;
+    for i:=0 to high(sarr) do
+      if assigned(sarr[i]) then
+        begin
+          srealp:=pdynarray(sarr[i]-sizeof(tdynarray));
+          if srealp^.high>=0 then
+            begin
+              move(sarr[i]^,(pointer(newp)+sizeof(tdynarray)+offset*elesize)^,(srealp^.high+1)*elesize);
+              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;
+
+    dest:=pointer(newp)+sizeof(tdynarray);
+    newp^.refcount:=1;
+    newp^.high:=totallen-1;
+  end;
 {$endif VER3_0}
 
 

tests/test/tarray14.pp

@@ -0,0 +1,100 @@
+program tarray14;
+
+{procedure Dump(arr: array of LongInt);
+var
+  i: LongInt;
+begin
+  Writeln('Length: ', Length(arr));
+  Write('Data:');
+  for i in arr do
+    Write(' ', i);
+  Writeln;
+end;}
+
+type
+  TLongIntArray = array of LongInt;
+
+procedure Check(darr: array of LongInt; sarr: array of TLongIntArray; var code: LongInt);
+var
+  i, j, k: LongInt;
+begin
+  j := 0;
+  k := 0;
+  for i:=0 to High(darr) do begin
+    if j>High(sarr) then
+      Halt(code);
+    while Length(sarr[j]) = 0 do begin
+      Inc(j);
+      if j>High(sarr) then
+        Halt(code + 1);
+      k:=0;
+    end;
+    //writeln('comparing element ', i, ' against element ', k, ' of array ', j);
+    if darr[i] <> sarr[j][k] then
+      Halt(code + 2);
+    Inc(k);
+    if k=Length(sarr[j]) then begin
+      Inc(j);
+      k:=0;
+    end;
+  end;
+  if (j < High(sarr)) or ((j = High(sarr)) and (k < High(sarr[j]))) then
+    Halt(code + 3);
+  code := code + 4;
+end;
+
+var
+  ai, ai1, ai2, ai3, ai4: array of LongInt;
+  code: LongInt = 0;
+begin
+  ai1 := [1, 2, 3];
+  ai2 := [6, 8, 10];
+  ai3 := [15, 17, 19];
+  ai4 := [23, 24, 25];
+
+  Writeln('Testing variables');
+  ai := Concat(ai1);
+  Check(ai, [ai1], code);
+  ai := Concat(ai1, ai2);
+  Check(ai, [ai1, ai2], code);
+  ai := Concat(ai2, ai1);
+  Check(ai, [ai2, ai1], code);
+  ai := Concat(ai1, ai2, ai3, ai4);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat(Concat(ai1, ai2), Concat(ai3, ai4));
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+
+  Writeln('Testing array constructors');
+  ai := Concat([1, 2, 3]);
+  Check(ai, [ai1], code);
+  ai := Concat([1, 2, 3], [6, 8, 10]);
+  Check(ai, [ai1, ai2], code);
+  ai := Concat([6, 8, 10], [1, 2, 3]);
+  Check(ai, [ai2, ai1], code);
+  ai := Concat([1, 2, 3], [6, 8, 10], [15, 17, 19], [23, 24, 25]);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat(Concat([1, 2, 3], [6, 8, 10]), Concat([15, 17, 19], [23, 24, 25]));
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+
+  Writeln('Testing mix of variables and array constructors');
+  ai := Concat(ai1, [6, 8, 10]);
+  Check(ai, [ai1, ai2], code);
+  ai := Concat([1, 2, 3], ai2);
+  Check(ai, [ai1, ai2], code);
+  ai := Concat([6, 8, 10], ai1);
+  Check(ai, [ai2, ai1], code);
+  ai := Concat(ai2, [1, 2, 3]);
+  Check(ai, [ai2, ai1], code);
+  ai := Concat([1, 2, 3], ai2, [15, 17, 19], ai4);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat(ai1, [6, 8, 10], [15, 17, 19], ai4);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat([1, 2, 3], [6, 8, 10], [15, 17, 19], ai4);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat(ai1, [6, 8, 10], [15, 17, 19], [23, 24, 25]);
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+  ai := Concat(Concat([1, 2, 3], [6, 8, 10]), Concat([15, 17, 19], [23, 24, 25]));
+  Check(ai, [ai1, ai2, ai3, ai4], code);
+
+  Writeln('ok');
+end.