mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 11:48:34 +02:00
+ extend Concat() with support for dynamic arrays
+ added test git-svn-id: trunk@37723 -
This commit is contained in:
svenbarth
parent
24c634d38d
commit
916ff0b92c
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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
|
||||
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);
|
||||
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);
|
||||
end;
|
||||
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
|
||||
{ no need to call the concat helper }
|
||||
result:=firstn;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ 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;
|
||||
end;
|
||||
|
||||
list.free;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
|
||||
100
tests/test/tarray14.pp
Normal file
100
tests/test/tarray14.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user