+ implement support for Insert() for dynamic arrays; the parameter that is inserted can be a dynamic or static array of the same type, an array constructor or a single element of the arrays type; all that is determined based on the second type

+ added test

git-svn-id: trunk@36307 -

.gitattributes

@@ -12083,6 +12083,7 @@ tests/test/targ1b.pp svneol=native#text/plain
 tests/test/tarray1.pp svneol=native#text/plain
 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/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

@@ -4608,12 +4608,27 @@ implementation
      function tinlinenode.handle_insert: tnode;
        var
          procname : String;
+         c : longint;
+         n,
+         newn,
+         datan,
+         datacountn,
+         firstn,
+         secondn : tnode;
          first,
          second : tdef;
+         isconstr,
+         iscomparray,
+         iscompelem : boolean;
+         datatemp : ttempcreatenode;
+         insertblock : tblocknode;
+         insertstatement : tstatementnode;
        begin
          { determine the correct function based on the second parameter }
-         first:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left.resultdef;
-         second:=tcallparanode(tcallparanode(left).right).left.resultdef;
+         firstn:=tcallparanode(tcallparanode(tcallparanode(left).right).right).left;
+         first:=firstn.resultdef;
+         secondn:=tcallparanode(tcallparanode(left).right).left;
+         second:=secondn.resultdef;
          if is_shortstring(second) then
            begin
              if is_char(first) then
@@ -4627,6 +4642,69 @@ implementation
            procname:='fpc_widestr_insert'
          else if is_ansistring(second) then
            procname:='fpc_ansistr_insert'
+         else if is_dynamic_array(second) then
+           begin
+             { The first parameter needs to be
+               a) a dynamic array of the same type
+               b) a single element of the same type
+               c) a static array of the same type (not Delphi compatible)
+             }
+             isconstr:=is_array_constructor(first);
+             iscomparray:=(first.typ=arraydef) and equal_defs(tarraydef(first).elementdef,tarraydef(second).elementdef);
+             iscompelem:=compare_defs(first,tarraydef(second).elementdef,niln)<>te_incompatible;
+             if not iscomparray
+                 and not iscompelem
+                 and not isconstr then
+               begin
+                 CGMessagePos(fileinfo,type_e_array_required);
+                 exit(cerrornode.create);
+               end;
+             insertblock:=internalstatements(insertstatement);
+             if iscomparray then
+               begin
+                 datatemp:=ctempcreatenode.create_value(first,first.size,tt_normal,false,firstn);
+                 addstatement(insertstatement,datatemp);
+                 datan:=caddrnode.create_internal(cvecnode.create(ctemprefnode.create(datatemp),cordconstnode.create(0,sizesinttype,false)));
+                 datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
+               end
+             else if isconstr then
+               begin
+                 inserttypeconv(firstn,second);
+                 datatemp:=ctempcreatenode.create_value(second,second.size,tt_normal,false,firstn);
+                 addstatement(insertstatement,datatemp);
+                 datan:=caddrnode.create_internal(cvecnode.create(ctemprefnode.create(datatemp),cordconstnode.create(0,sizesinttype,false)));
+                 datacountn:=cinlinenode.create(in_length_x,false,ctemprefnode.create(datatemp));
+               end
+             else
+               begin
+                 if is_const(firstn) then
+                   begin
+                     datatemp:=ctempcreatenode.create_value(tarraydef(second).elementdef,tarraydef(second).elementdef.size,tt_normal,false,firstn);
+                     addstatement(insertstatement,datatemp);
+                     datan:=caddrnode.create_internal(ctemprefnode.create(datatemp));
+                   end
+                 else
+                   datan:=caddrnode.create_internal(ctypeconvnode.create_internal(firstn,tarraydef(second).elementdef));
+                 datacountn:=cordconstnode.create(1,sizesinttype,false);
+               end;
+             procname:='fpc_dynarray_insert';
+             { recreate the parameters as array pointer, source, data, count, typeinfo }
+             newn:=ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(second),initrtti,rdt_normal)),
+                     ccallparanode.create(datacountn,
+                       ccallparanode.create(datan,
+                         ccallparanode.create(tcallparanode(left).left,
+                           ccallparanode.create(ctypeconvnode.create_internal(secondn,voidpointertype),nil)))));
+             addstatement(insertstatement,ccallnode.createintern(procname,newn));
+             if assigned(datatemp) then
+               addstatement(insertstatement,ctempdeletenode.create(datatemp));
+             tcallparanode(tcallparanode(tcallparanode(left).right).right).left:=nil; // insert idx
+             tcallparanode(tcallparanode(left).right).left:=nil; // dyn array
+             tcallparanode(left).left:=nil; // insert element/array
+             left.free;
+             left:=nil;
+             result:=insertblock;
+             exit; { ! }
+           end
          else if second.typ=undefineddef then
            { just pick one }
            procname:='fpc_ansistr_insert'

rtl/inc/compproc.inc

@@ -77,8 +77,9 @@ procedure fpc_dynarray_incr_ref(p : pointer); compilerproc;
 procedure fpc_dynarray_setlength(var p : pointer;pti : pointer; dimcount : sizeint;dims : pdynarrayindex); compilerproc;
 procedure fpc_dynarray_assign(var dest : pointer; src : pointer; ti: pointer); compilerproc;
 {$ifndef VER3_0}
-{ no reference to the Delete() intrinsic, due to typeinfo parameter }
+{ 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;
 {$endif VER3_0}
 {$endif FPC_HAS_FEATURE_DYNARRAYS}
 

rtl/inc/dynarr.inc

@@ -467,6 +467,138 @@ procedure fpc_dynarray_delete(var p : pointer;source,count : SizeInt;pti : point
     newp^.refcount:=1;
     newp^.high:=newhigh;
   end;
+
+procedure fpc_dynarray_insert(var p : pointer;source : SizeInt;data : pointer;count : SizeInt;pti : pointer);compilerproc;
+  var
+    newhigh,
+    i : tdynarrayindex;
+    size : sizeint;
+    realp,
+    newp : pdynarray;
+    ti : pointer;
+    elesize : sizeint;
+    eletype,eletypemngd : pointer;
+  begin
+    if not assigned(data) or
+        (count=0) then
+      exit;
+
+    if assigned(p) then
+      realp:=pdynarray(p-sizeof(tdynarray))
+    else
+      realp:=nil;
+    newp:=realp;
+
+    { cap insert index }
+    if assigned(p) then
+      begin
+        if source<0 then
+          source:=0
+        else if source>realp^.high+1 then
+          source:=realp^.high+1;
+      end
+    else
+      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^;
+    { only set if type needs initialization }
+    if assigned(pdynarraytypedata(ti)^.elType) then
+      eletypemngd:=pdynarraytypedata(ti)^.elType^
+    else
+      eletypemngd:=nil;
+
+    { determine new memory size }
+    if assigned(p) then
+      newhigh:=realp^.high+count
+    else
+      newhigh:=count-1;
+    size:=elesize*(newhigh+1)+sizeof(tdynarray);
+
+    if assigned(p) then
+      begin
+        if realp^.refcount<>1 then
+          begin
+            { make an unique copy }
+            getmem(newp,size);
+            fillchar(newp^,sizeof(tdynarray),0);
+
+            { copy leading elements }
+            if source>0 then
+              move(p^,(pointer(newp)+sizeof(tdynarray))^,source*elesize);
+            { insert new elements }
+            move(data^,(pointer(newp)+sizeof(tdynarray)+source*elesize)^,count*elesize);
+            { copy trailing elements }
+            if realp^.high-source+1>0 then
+              move((p+source*elesize)^,(pointer(newp)+sizeof(tdynarray)+(source+count)*elesize)^,(realp^.high-source+1)*elesize);
+
+            { increment ref. count of managed members }
+            if assigned(eletypemngd) then
+              for i:=0 to newhigh do
+                int_addref(pointer(newp)+sizeof(tdynarray)+elesize*i,eletypemngd);
+
+            { a declock(ref. count) isn't enough here }
+            { it could be that the in MT environments  }
+            { in the mean time the refcount was       }
+            { decremented                             }
+
+            { it is, because it doesn't really matter }
+            { if the array is now removed             }
+            fpc_dynarray_clear(p,pti);
+          end
+        else
+          begin
+            { resize the array }
+            reallocmem(realp,size);
+
+            { p might no longer be correct }
+            p:=pointer(realp)+sizeof(tdynarray);
+
+            { move the trailing part after the inserted data }
+            if source<=realp^.high then
+              move((p+source*elesize)^,(p+(source+count)*elesize)^,(realp^.high-source+1)*elesize);
+
+            { move the inserted data to the destination }
+            move(data^,(p+source*elesize)^,count*elesize);
+
+            { increase reference counts of inserted elements }
+            if assigned(eletypemngd) then
+              begin
+                for i:=source to source+count-1 do
+                  int_addref(p+i*elesize,eletypemngd);
+              end;
+
+            newp:=realp;
+          end;
+      end
+    else
+      begin
+        { allocate new array }
+        getmem(newp,size);
+        fillchar(newp^,sizeof(tdynarray),0);
+
+        { insert data }
+        move(data^,(pointer(newp)+sizeof(tdynarray))^,count*elesize);
+
+        { increase reference counts of inserted elements }
+        if assigned(eletypemngd) then
+          begin
+            for i:=0 to count-1 do
+              int_addref(pointer(newp)+sizeof(tdynarray)+i*elesize,eletypemngd);
+          end;
+      end;
+
+    p:=pointer(newp)+sizeof(tdynarray);
+    newp^.refcount:=1;
+    newp^.high:=newhigh;
+  end;
 {$endif VER3_0}
 
 

tests/test/tarray12.pp

@@ -0,0 +1,169 @@
+program tarray12;
+
+{$mode objfpc}
+
+uses
+  SysUtils;
+
+procedure PrintArray(a: array of LongInt);
+var
+  i: LongInt;
+begin
+  Writeln('Length: ', Length(a));
+  Write('Data: ');
+  for i := Low(a) to High(a) do begin
+    if i > Low(a) then
+      Write(', ');
+    Write(a[i]);
+  end;
+  Writeln;
+end;
+
+procedure CheckArray(aExpected, aGot: array of LongInt);
+var
+  i: LongInt;
+begin
+  if Length(aExpected) <> Length(aGot) then
+    Halt(1);
+  for i := Low(aExpected) to High(aExpected) do begin
+    if aExpected[i] <> aGot[i] then
+      Halt(2);
+  end;
+end;
+
+function InitArray(aCount: LongInt): specialize TArray<LongInt>;
+var
+  i: LongInt;
+begin
+  SetLength(Result, aCount);
+  for i := 0 to aCount - 1 do
+    Result[i] := i;
+end;
+
+type
+  TTest = class(TInterfacedObject, IInterface)
+    function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+  end;
+
+var
+  gRefCount: LongInt = 0;
+
+function TTest._AddRef: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+  Result := inherited _AddRef;
+  gRefCount := Result;
+end;
+
+function TTest._Release: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+  Result := inherited _Release;
+  gRefCount := Result;
+end;
+
+function GetIntf: IInterface;
+begin
+  Result := TTest.Create;
+end;
+
+procedure TestIntf;
+
+  procedure DoInsert(const aArg1: specialize TArray<IInterface>; var aArg2: specialize TArray<IInterface>);
+  begin
+    Insert(aArg1, aArg2, 0);
+  end;
+
+var
+  ai1, ai2: specialize TArray<IInterface>;
+  intf: IInterface;
+  c: LongInt;
+begin
+  intf := GetIntf;
+  SetLength(ai1, 1);
+  c := gRefCount;
+  ai1[0] := intf;
+  if c >= gRefCount then
+    Halt(3);
+  intf := Nil;
+  if c <> gRefCount then
+    Halt(4);
+  DoInsert(ai1, ai2);
+  if c >= gRefCount then
+    Halt(5);
+  ai1 := Nil;
+  if gRefCount = 0 then
+    Halt(6);
+  ai2 := Nil;
+  if gRefCount <> 0 then
+    Halt(7);
+end;
+
+var
+  t, t2: specialize TArray<LongInt>;
+  t3: array[0..2] of LongInt;
+begin
+  t := Nil;
+  Insert([1, 3, 5], t, 0);
+  PrintArray(t);
+  CheckArray(t, [1, 3, 5]);
+
+  t := Nil;
+  Insert([], t, 0);
+  PrintArray(t);
+  CheckArray(t, []);
+
+  t := InitArray(5);
+  Insert([], t, 0);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 2, 3, 4]);
+
+  t := InitArray(5);
+  Insert([1, 3, 5], t, 2);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 1, 3, 5, 2, 3, 4]);
+
+  t := InitArray(5);
+  Insert(5, t, 2);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 5, 2, 3, 4]);
+
+{  t := InitArray(5);
+  Insert([1, 3, 5] + [4, 6], t, 2);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 1, 3, 5, 4, 6, 2, 3, 4]);}
+
+  t := InitArray(5);
+  Insert([1, 3, 5], t, -1);
+  PrintArray(t);
+  CheckArray(t, [1, 3, 5, 0, 1, 2, 3, 4]);
+
+  t := InitArray(5);
+  Insert([1, 3, 5], t, 5);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 2, 3, 4, 1, 3, 5]);
+
+  t := InitArray(5);
+  Insert([1, 3, 5], t, 6);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 2, 3, 4, 1, 3, 5]);
+
+  t2 := specialize TArray<LongInt>.Create(1, 3, 5);
+
+  t := InitArray(5);
+  Insert(t2, t, 1);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 3, 5, 1, 2, 3, 4]);
+
+  { support for static arrays is not Delphi compatible, but whatever :) }
+  t := InitArray(5);
+  t3[0] := 2;
+  t3[1] := 4;
+  t3[2] := 6;
+  Insert(t3, t, 2);
+  PrintArray(t);
+  CheckArray(t, [0, 1, 2, 4, 6, 2, 3, 4]);
+
+  TestIntf;
+
+  Writeln('Ok');
+end.