paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 21:28:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #37221: apply adjusted patch by Ondrej Pokorny to allow the use of Copy() on open array parameters (the result will be a dynamic array)

Browse Source 
+ added test

git-svn-id: trunk@46890 -
This commit is contained in:
svenbarth 2020-09-18 15:00:10 +00:00
parent f8b5c81b8b
commit d3e18ccb5e
5 changed files with 199 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14389,6 +14389,7 @@ tests/test/tarray19.pp svneol=native#text/pascal
tests/test/tarray2.pp svneol=native#text/plain
tests/test/tarray20.pp svneol=native#text/pascal
tests/test/tarray21.pp svneol=native#text/pascal
tests/test/tarray22.pp svneol=native#text/pascal
tests/test/tarray3.pp svneol=native#text/plain
tests/test/tarray4.pp svneol=native#text/plain
tests/test/tarray5.pp svneol=native#text/plain

63
compiler/ninl.pas
View File

@ -1914,7 +1914,16 @@ implementation
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
@ -4697,7 +4706,12 @@ implementation
function tinlinenode.first_copy: tnode;
var
lowppn,
highppn,
countppn,
elesizeppn,
eletypeppn,
maxcountppn,
arrayppn,
rttippn,
npara,
paras : tnode;
ppn : tcallparanode;
@ -4737,30 +4751,57 @@ implementation
else if is_dynamic_array(resultdef) then
begin
{ create statements with call }
elesizeppn:=cordconstnode.create(tarraydef(paradef).elesize,sinttype,false);
if is_managed_type(tarraydef(paradef).elementdef) then
eletypeppn:=caddrnode.create_internal(
crttinode.create(tstoreddef(tarraydef(paradef).elementdef),fullrtti,rdt_normal))
else
eletypeppn:=cordconstnode.create(0,voidpointertype,false);
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
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);
end
else if is_dynamic_array(paradef) then
begin
arrayppn:=ctypeconvnode.create_internal(ppn.left,voidpointertype);
end
else
internalerror(2012100702);
rttippn:=caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal));
{ 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;

7
rtl/inc/compproc.inc
View File

@ -67,8 +67,15 @@ Procedure fpc_shortstr_insert_char(source:Char;var s:shortstring;index:SizeInt);
{$endif VER3_0}
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
{$ifdef VER3_2}
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
{$endif VER3_2}
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;

66
rtl/inc/dynarr.inc
View File

@ -315,21 +315,54 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
end;
{ provide local access to dynarr_copy }
function int_dynarray_copy(psrc : pointer;ti : pointer;
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[external name 'FPC_DYNARR_COPY'];
{ 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'];
{$ifdef VER3_2}
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
var
realpsrc : pdynarray;
i,size : sizeint;
eletype,tti : pointer;
elesize : sizeint;
eletype : pointer;
begin
fpc_dynarray_clear(pointer(result),ti);
if psrc=nil then
exit;
realpsrc:=pdynarray(psrc-sizeof(tdynarray));
tti:=aligntoqword(ti+2+PByte(ti)[1]);
elesize:=pdynarraytypedata(tti)^.elSize;
{ only set if type needs finalization }
if assigned(pdynarraytypedata(tti)^.elType) then
eletype:=pdynarraytypedata(tti)^.elType^
else
eletype:=nil;
fpc_array_to_dynarray_copy(psrc,ti,lowidx,count,realpsrc^.high+1,elesize,eletype);
end;
{$endif VER3_2}
{ 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;
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 +370,6 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
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 +379,11 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
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));

99
tests/test/tarray22.pp Normal file
View File

@ -0,0 +1,99 @@
{ %OPT = -gh }
program tarray22;
{$mode objfpc}{$h+}
type
TIntegerArray = array of Integer;
TStringArray = array of String;
generic procedure CheckArray<T>(const Actual, Expected: array of T; Code: LongInt);
var
i: SizeInt;
begin
if Length(Actual) <> Length(Expected) then
Halt(Code);
for i := 0 to High(Actual) do
if Actual[i] <> Expected[i] then
Halt(Code);
end;
procedure TestOpen(const A: array of Integer; Exp: array of Integer; Code: LongInt);
var
B: array of Integer;
begin
B := Copy(A);
specialize CheckArray<Integer>(B, Exp, Code);
end;
procedure TestOpen2(const A: array of Integer; Exp: array of Integer; Code: LongInt);
var
B: array of Integer;
begin
B := Copy(A, 1, 2);
specialize CheckArray<Integer>(B, Exp, Code);
end;
procedure TestDyn(const A: TIntegerArray; Exp: array of Integer; Code: LongInt);
var
B: array of Integer;
begin
B := Copy(A);
specialize CheckArray<Integer>(B, Exp, Code);
end;
procedure TestDyn2(const A: TIntegerArray; Exp: array of Integer; Code: LongInt);
var
B: array of Integer;
begin
B := Copy(A, 1, 2);
specialize CheckArray<Integer>(B, Exp, Code);
end;
procedure TestOpen(const A: array of String; Exp: array of String; Code: LongInt);
var
B: array of String;
begin
B := Copy(A);
specialize CheckArray<String>(B, Exp, Code);
end;
procedure TestOpen2(const A: array of String; Exp: array of String; Code: LongInt);
var
B: array of String;
begin
B := Copy(A, 1, 2);
specialize CheckArray<String>(B, Exp, Code);
end;
procedure TestDyn(const A: TStringArray; Exp: array of String; Code: LongInt);
var
B: array of String;
begin
B := Copy(A);
specialize CheckArray<String>(B, Exp, Code);
end;
procedure TestDyn2(const A: TStringArray; Exp: array of String; Code: LongInt);
var
B: array of String;
begin
B := Copy(A, 1, 2);
specialize CheckArray<String>(B, Exp, Code);
end;
begin
HaltOnNotReleased := True;
TestOpen([0, 1, 2, 3, 4, 5], [0, 1, 2, 3, 4, 5], 1);
TestOpen2([0, 1, 2, 3, 4, 5], [1, 2], 2);
TestDyn([0, 1, 2, 3, 4, 5], [0, 1, 2, 3, 4, 5], 3);
TestDyn2([0, 1, 2, 3, 4, 5], [1, 2], 4);
TestOpen(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Alpha', 'Beta', 'Gamma', 'Delta'], 5);
TestOpen2(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Beta', 'Gamma'], 6);
TestDyn(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Alpha', 'Beta', 'Gamma', 'Delta'], 7);
TestDyn2(['Alpha', 'Beta', 'Gamma', 'Delta'], ['Beta', 'Gamma'], 8);
end.