mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 04:49:19 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@46894 -
This commit is contained in:
commit
0967f0c371
8
.gitattributes
vendored
8
.gitattributes
vendored
@ -14429,6 +14429,7 @@ tests/test/tarray19.pp svneol=native#text/pascal
|
|||||||
tests/test/tarray2.pp svneol=native#text/plain
|
tests/test/tarray2.pp svneol=native#text/plain
|
||||||
tests/test/tarray20.pp svneol=native#text/pascal
|
tests/test/tarray20.pp svneol=native#text/pascal
|
||||||
tests/test/tarray21.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/tarray3.pp svneol=native#text/plain
|
||||||
tests/test/tarray4.pp svneol=native#text/plain
|
tests/test/tarray4.pp svneol=native#text/plain
|
||||||
tests/test/tarray5.pp svneol=native#text/plain
|
tests/test/tarray5.pp svneol=native#text/plain
|
||||||
@ -14437,6 +14438,12 @@ tests/test/tarray7.pp svneol=native#text/plain
|
|||||||
tests/test/tarray8.pp svneol=native#text/plain
|
tests/test/tarray8.pp svneol=native#text/plain
|
||||||
tests/test/tarray9.pp svneol=native#text/plain
|
tests/test/tarray9.pp svneol=native#text/plain
|
||||||
tests/test/tarrconstr1.pp svneol=native#text/pascal
|
tests/test/tarrconstr1.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr10.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr11.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr12.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr13.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr14.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr15.pp svneol=native#text/pascal
|
||||||
tests/test/tarrconstr2.pp svneol=native#text/pascal
|
tests/test/tarrconstr2.pp svneol=native#text/pascal
|
||||||
tests/test/tarrconstr3.pp svneol=native#text/pascal
|
tests/test/tarrconstr3.pp svneol=native#text/pascal
|
||||||
tests/test/tarrconstr4.pp svneol=native#text/pascal
|
tests/test/tarrconstr4.pp svneol=native#text/pascal
|
||||||
@ -14444,6 +14451,7 @@ tests/test/tarrconstr5.pp svneol=native#text/pascal
|
|||||||
tests/test/tarrconstr6.pp svneol=native#text/pascal
|
tests/test/tarrconstr6.pp svneol=native#text/pascal
|
||||||
tests/test/tarrconstr7.pp svneol=native#text/pascal
|
tests/test/tarrconstr7.pp svneol=native#text/pascal
|
||||||
tests/test/tarrconstr8.pp svneol=native#text/pascal
|
tests/test/tarrconstr8.pp svneol=native#text/pascal
|
||||||
|
tests/test/tarrconstr9.pp svneol=native#text/pascal
|
||||||
tests/test/tasm1.pp svneol=native#text/plain
|
tests/test/tasm1.pp svneol=native#text/plain
|
||||||
tests/test/tasm10.pp svneol=native#text/plain
|
tests/test/tasm10.pp svneol=native#text/plain
|
||||||
tests/test/tasm10a.pp svneol=native#text/plain
|
tests/test/tasm10a.pp svneol=native#text/plain
|
||||||
|
@ -105,7 +105,8 @@ interface
|
|||||||
tc_variant_2_interface,
|
tc_variant_2_interface,
|
||||||
tc_array_2_dynarray,
|
tc_array_2_dynarray,
|
||||||
tc_elem_2_openarray,
|
tc_elem_2_openarray,
|
||||||
tc_arrayconstructor_2_dynarray
|
tc_arrayconstructor_2_dynarray,
|
||||||
|
tc_arrayconstructor_2_array
|
||||||
);
|
);
|
||||||
|
|
||||||
function compare_defs_ext(def_from,def_to : tdef;
|
function compare_defs_ext(def_from,def_to : tdef;
|
||||||
@ -1168,6 +1169,17 @@ implementation
|
|||||||
eq:=te_convert_l1;
|
eq:=te_convert_l1;
|
||||||
doconv:=tc_string_2_chararray;
|
doconv:=tc_string_2_chararray;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
{ to normal array }
|
||||||
|
if is_normal_array(def_to) and is_array_constructor(def_from) then
|
||||||
|
begin
|
||||||
|
{ element count must match exactly }
|
||||||
|
if tarraydef(def_to).elecount=tarraydef(def_from).elecount then
|
||||||
|
begin
|
||||||
|
eq:=te_convert_l2;
|
||||||
|
doconv:=tc_arrayconstructor_2_array;
|
||||||
|
end;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
{ other arrays }
|
{ other arrays }
|
||||||
begin
|
begin
|
||||||
|
@ -119,6 +119,7 @@ interface
|
|||||||
function typecheck_array_2_dynarray : tnode; virtual;
|
function typecheck_array_2_dynarray : tnode; virtual;
|
||||||
function typecheck_elem_2_openarray : tnode; virtual;
|
function typecheck_elem_2_openarray : tnode; virtual;
|
||||||
function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
|
function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
|
||||||
|
function typecheck_arrayconstructor_to_array : tnode; virtual;
|
||||||
private
|
private
|
||||||
function _typecheck_int_to_int : tnode;
|
function _typecheck_int_to_int : tnode;
|
||||||
function _typecheck_cord_to_pointer : tnode;
|
function _typecheck_cord_to_pointer : tnode;
|
||||||
@ -150,7 +151,8 @@ interface
|
|||||||
function _typecheck_interface_to_variant : tnode;
|
function _typecheck_interface_to_variant : tnode;
|
||||||
function _typecheck_array_2_dynarray : tnode;
|
function _typecheck_array_2_dynarray : tnode;
|
||||||
function _typecheck_elem_2_openarray : tnode;
|
function _typecheck_elem_2_openarray : tnode;
|
||||||
function _typecheck_arrayconstructor_to_dynarray: tnode;
|
function _typecheck_arrayconstructor_to_dynarray : tnode;
|
||||||
|
function _typecheck_arrayconstructor_to_array : tnode;
|
||||||
protected
|
protected
|
||||||
function first_int_to_int : tnode;virtual;
|
function first_int_to_int : tnode;virtual;
|
||||||
function first_cstring_to_pchar : tnode;virtual;
|
function first_cstring_to_pchar : tnode;virtual;
|
||||||
@ -1999,12 +2001,13 @@ implementation
|
|||||||
|
|
||||||
function ttypeconvnode.typecheck_arrayconstructor_to_dynarray : tnode;
|
function ttypeconvnode.typecheck_arrayconstructor_to_dynarray : tnode;
|
||||||
var
|
var
|
||||||
newstatement,assstatement:tstatementnode;
|
newstatement,
|
||||||
arrnode:ttempcreatenode;
|
assstatement : tstatementnode;
|
||||||
temp2:ttempcreatenode;
|
arrnode : ttempcreatenode;
|
||||||
assnode:tnode;
|
temp2 : ttempcreatenode;
|
||||||
paracount:integer;
|
assnode : tnode;
|
||||||
elemnode:tarrayconstructornode;
|
paracount : integer;
|
||||||
|
elemnode : tarrayconstructornode;
|
||||||
begin
|
begin
|
||||||
{ assignment of []? }
|
{ assignment of []? }
|
||||||
if (
|
if (
|
||||||
@ -2083,6 +2086,64 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ttypeconvnode.typecheck_arrayconstructor_to_array : tnode;
|
||||||
|
var
|
||||||
|
newstatement,
|
||||||
|
assstatement : tstatementnode;
|
||||||
|
arrnode : ttempcreatenode;
|
||||||
|
temp2 : ttempcreatenode;
|
||||||
|
assnode : tnode;
|
||||||
|
paracount : integer;
|
||||||
|
elemnode : tarrayconstructornode;
|
||||||
|
begin
|
||||||
|
tarrayconstructornode(left).force_type(tarraydef(resultdef).elementdef);
|
||||||
|
|
||||||
|
result:=internalstatements(newstatement);
|
||||||
|
{ create temp for result }
|
||||||
|
arrnode:=ctempcreatenode.create(totypedef,totypedef.size,tt_persistent,true);
|
||||||
|
addstatement(newstatement,arrnode);
|
||||||
|
|
||||||
|
paracount:=0;
|
||||||
|
|
||||||
|
{ create an assignment call for each element }
|
||||||
|
assnode:=internalstatements(assstatement);
|
||||||
|
if left.nodetype=arrayconstructorrangen then
|
||||||
|
internalerror(2020041402);
|
||||||
|
elemnode:=tarrayconstructornode(left);
|
||||||
|
while assigned(elemnode) do
|
||||||
|
begin
|
||||||
|
{ arr[i] := param_i }
|
||||||
|
if not assigned(elemnode.left) then
|
||||||
|
internalerror(2020041403);
|
||||||
|
addstatement(assstatement,
|
||||||
|
cassignmentnode.create(
|
||||||
|
cvecnode.create(
|
||||||
|
ctemprefnode.create(arrnode),
|
||||||
|
cordconstnode.create(paracount,tarraydef(totypedef).rangedef,false)),
|
||||||
|
elemnode.left));
|
||||||
|
elemnode.left:=nil;
|
||||||
|
inc(paracount);
|
||||||
|
elemnode:=tarrayconstructornode(elemnode.right);
|
||||||
|
if assigned(elemnode) and (elemnode.nodetype<>arrayconstructorn) then
|
||||||
|
internalerror(2020041404);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ get temp for array of lengths }
|
||||||
|
temp2:=ctempcreatenode.create_value(sinttype,sinttype.size,tt_persistent,false,cordconstnode.create(paracount,s32inttype,true));
|
||||||
|
addstatement(newstatement,temp2);
|
||||||
|
|
||||||
|
{ add assignment statememnts }
|
||||||
|
addstatement(newstatement,ctempdeletenode.create(temp2));
|
||||||
|
addstatement(newstatement,assnode);
|
||||||
|
{ the last statement should return the value as
|
||||||
|
location and type, this is done be referencing the
|
||||||
|
temp and converting it first from a persistent temp to
|
||||||
|
normal temp }
|
||||||
|
addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode));
|
||||||
|
addstatement(newstatement,ctemprefnode.create(arrnode));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode._typecheck_int_to_int : tnode;
|
function ttypeconvnode._typecheck_int_to_int : tnode;
|
||||||
begin
|
begin
|
||||||
result := typecheck_int_to_int;
|
result := typecheck_int_to_int;
|
||||||
@ -2269,6 +2330,12 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function ttypeconvnode._typecheck_arrayconstructor_to_array : tnode;
|
||||||
|
begin
|
||||||
|
result:=typecheck_arrayconstructor_to_array;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
function ttypeconvnode.target_specific_general_typeconv: boolean;
|
function ttypeconvnode.target_specific_general_typeconv: boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
@ -2393,7 +2460,8 @@ implementation
|
|||||||
{ interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
|
{ interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
|
||||||
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
|
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
|
||||||
{ elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
|
{ elem_2_openarray } @ttypeconvnode._typecheck_elem_2_openarray,
|
||||||
{ arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray
|
{ arrayconstructor_2_dynarray } @ttypeconvnode._typecheck_arrayconstructor_to_dynarray,
|
||||||
|
{ arrayconstructor_2_array } @ttypeconvnode._typecheck_arrayconstructor_to_array
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
tprocedureofobject = function : tnode of object;
|
tprocedureofobject = function : tnode of object;
|
||||||
@ -3978,6 +4046,7 @@ implementation
|
|||||||
nil,
|
nil,
|
||||||
nil,
|
nil,
|
||||||
@ttypeconvnode._first_nothing,
|
@ttypeconvnode._first_nothing,
|
||||||
|
@ttypeconvnode._first_nothing,
|
||||||
@ttypeconvnode._first_nothing
|
@ttypeconvnode._first_nothing
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
@ -4255,7 +4324,8 @@ implementation
|
|||||||
@ttypeconvnode._second_nothing, { interface_2_variant }
|
@ttypeconvnode._second_nothing, { interface_2_variant }
|
||||||
@ttypeconvnode._second_nothing, { array_2_dynarray }
|
@ttypeconvnode._second_nothing, { array_2_dynarray }
|
||||||
@ttypeconvnode._second_elem_to_openarray, { elem_2_openarray }
|
@ttypeconvnode._second_elem_to_openarray, { elem_2_openarray }
|
||||||
@ttypeconvnode._second_nothing { arrayconstructor_2_dynarray }
|
@ttypeconvnode._second_nothing, { arrayconstructor_2_dynarray }
|
||||||
|
@ttypeconvnode._second_nothing { arrayconstructor_2_array }
|
||||||
);
|
);
|
||||||
type
|
type
|
||||||
tprocedureofobject = procedure of object;
|
tprocedureofobject = procedure of object;
|
||||||
|
@ -1914,7 +1914,16 @@ implementation
|
|||||||
begin
|
begin
|
||||||
minargs:=1;
|
minargs:=1;
|
||||||
resultdef:=paradef;
|
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
|
end
|
||||||
else if counter in [2..3] then
|
else if counter in [2..3] then
|
||||||
begin
|
begin
|
||||||
@ -4697,7 +4706,12 @@ implementation
|
|||||||
function tinlinenode.first_copy: tnode;
|
function tinlinenode.first_copy: tnode;
|
||||||
var
|
var
|
||||||
lowppn,
|
lowppn,
|
||||||
highppn,
|
countppn,
|
||||||
|
elesizeppn,
|
||||||
|
eletypeppn,
|
||||||
|
maxcountppn,
|
||||||
|
arrayppn,
|
||||||
|
rttippn,
|
||||||
npara,
|
npara,
|
||||||
paras : tnode;
|
paras : tnode;
|
||||||
ppn : tcallparanode;
|
ppn : tcallparanode;
|
||||||
@ -4737,30 +4751,57 @@ implementation
|
|||||||
else if is_dynamic_array(resultdef) then
|
else if is_dynamic_array(resultdef) then
|
||||||
begin
|
begin
|
||||||
{ create statements with call }
|
{ 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
|
case counter of
|
||||||
1:
|
1:
|
||||||
begin
|
begin
|
||||||
{ copy the whole array using [0..high(sizeint)] range }
|
{ 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);
|
lowppn:=cordconstnode.create(0,sinttype,false);
|
||||||
end;
|
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:
|
3:
|
||||||
begin
|
begin
|
||||||
highppn:=tcallparanode(paras).left.getcopy;
|
countppn:=tcallparanode(paras).left.getcopy;
|
||||||
lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
|
lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy;
|
||||||
end;
|
end;
|
||||||
else
|
else
|
||||||
internalerror(2012100701);
|
internalerror(2012100701);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ create call to fpc_dynarray_copy }
|
if is_open_array(paradef) then
|
||||||
npara:=ccallparanode.create(highppn,
|
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(lowppn,
|
||||||
ccallparanode.create(caddrnode.create_internal
|
ccallparanode.create(rttippn,
|
||||||
(crttinode.create(tstoreddef(paradef),initrtti,rdt_normal)),
|
ccallparanode.create(arrayppn,nil)))))));
|
||||||
ccallparanode.create
|
result:=ccallnode.createinternres('fpc_array_to_dynarray_copy',npara,resultdef);
|
||||||
(ctypeconvnode.create_internal(ppn.left,voidpointertype),nil))));
|
|
||||||
result:=ccallnode.createinternres('fpc_dynarray_copy',npara,paradef);
|
|
||||||
|
|
||||||
ppn.left:=nil;
|
ppn.left:=nil;
|
||||||
paras.free;
|
paras.free;
|
||||||
|
@ -1256,7 +1256,10 @@ begin
|
|||||||
if DoBeginEnd then
|
if DoBeginEnd then
|
||||||
AddLn('begin');
|
AddLn('begin');
|
||||||
IncIndent;
|
IncIndent;
|
||||||
WriteImplElement(AIfElse.IfBranch, False);
|
if AIfElse.IfBranch is TPasImplBeginBlock then
|
||||||
|
WriteImplBlock(TPasImplBeginBlock(AIfElse.IfBranch))
|
||||||
|
else
|
||||||
|
WriteImplElement(AIfElse.IfBranch, False);
|
||||||
DecIndent;
|
DecIndent;
|
||||||
if DoBeginEnd then
|
if DoBeginEnd then
|
||||||
begin
|
begin
|
||||||
|
@ -104,7 +104,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
PendingSystemTail^:=SystemEvent;
|
PendingSystemTail^:=SystemEvent;
|
||||||
inc(PendingSystemTail);
|
inc(PendingSystemTail);
|
||||||
if longint(PendingSystemTail)=longint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
|
if PtrUInt(PendingSystemTail)=PtrUInt(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
|
||||||
PendingSystemTail:=@PendingSystemEvent;
|
PendingSystemTail:=@PendingSystemEvent;
|
||||||
inc(PendingSystemEvents);
|
inc(PendingSystemEvents);
|
||||||
end;
|
end;
|
||||||
|
@ -2117,7 +2117,7 @@ BEGIN
|
|||||||
Tp := Last; { Set temporary ptr }
|
Tp := Last; { Set temporary ptr }
|
||||||
Repeat
|
Repeat
|
||||||
Tp := Tp^.Next; { Get next view }
|
Tp := Tp^.Next; { Get next view }
|
||||||
IF Byte(Longint(CallPointerMethodLocal(TCallbackFunBoolParam(P),
|
IF Byte(PtrUInt(CallPointerMethodLocal(TCallbackFunBoolParam(P),
|
||||||
{ On most systems, locals are accessed relative to base pointer,
|
{ On most systems, locals are accessed relative to base pointer,
|
||||||
but for MIPS cpu, they are accessed relative to stack pointer.
|
but for MIPS cpu, they are accessed relative to stack pointer.
|
||||||
This needs adaptation for so low level routines,
|
This needs adaptation for so low level routines,
|
||||||
|
@ -145,7 +145,7 @@ begin
|
|||||||
EnterCriticalSection(ChangeSystemEvents);
|
EnterCriticalSection(ChangeSystemEvents);
|
||||||
SystemEvent:=PendingSystemHead^;
|
SystemEvent:=PendingSystemHead^;
|
||||||
inc(PendingSystemHead);
|
inc(PendingSystemHead);
|
||||||
if ptrint(PendingSystemHead)=ptrint(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
|
if PtrUInt(PendingSystemHead)=PtrUInt(@PendingSystemEvent)+sizeof(PendingSystemEvent) then
|
||||||
PendingSystemHead:=@PendingSystemEvent;
|
PendingSystemHead:=@PendingSystemEvent;
|
||||||
dec(PendingSystemEvents);
|
dec(PendingSystemEvents);
|
||||||
LastSystemEvent:=SystemEvent;
|
LastSystemEvent:=SystemEvent;
|
||||||
|
@ -67,8 +67,15 @@ Procedure fpc_shortstr_insert_char(source:Char;var s:shortstring;index:SizeInt);
|
|||||||
{$endif VER3_0}
|
{$endif VER3_0}
|
||||||
|
|
||||||
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
|
{$ifdef FPC_HAS_FEATURE_DYNARRAYS}
|
||||||
|
{$ifdef VER3_2}
|
||||||
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
|
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
|
||||||
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;compilerproc;
|
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_length(p : pointer) : tdynarrayindex; compilerproc;
|
||||||
function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
|
function fpc_dynarray_high(p : pointer) : tdynarrayindex; compilerproc;
|
||||||
procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
|
procedure fpc_dynarray_clear(var p : pointer;ti : pointer); compilerproc;
|
||||||
|
@ -315,21 +315,54 @@ procedure fpc_dynarray_setlength(var p : pointer;pti : pointer;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ provide local access to dynarr_copy }
|
{ provide local access to array_to_dynarray_copy }
|
||||||
function int_dynarray_copy(psrc : pointer;ti : pointer;
|
function int_array_to_dynarray_copy(psrc : pointer;ti : pointer;
|
||||||
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[external name 'FPC_DYNARR_COPY'];
|
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;
|
function fpc_dynarray_copy(psrc : pointer;ti : pointer;
|
||||||
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
|
lowidx,count:tdynarrayindex) : fpc_stub_dynarray;[Public,Alias:'FPC_DYNARR_COPY'];compilerproc;
|
||||||
var
|
var
|
||||||
realpsrc : pdynarray;
|
realpsrc : pdynarray;
|
||||||
i,size : sizeint;
|
eletype,tti : pointer;
|
||||||
elesize : sizeint;
|
elesize : sizeint;
|
||||||
eletype : pointer;
|
|
||||||
begin
|
begin
|
||||||
fpc_dynarray_clear(pointer(result),ti);
|
fpc_dynarray_clear(pointer(result),ti);
|
||||||
if psrc=nil then
|
if psrc=nil then
|
||||||
exit;
|
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}
|
{$ifndef FPC_DYNARRAYCOPY_FIXED}
|
||||||
if (lowidx=-1) and (count=-1) then
|
if (lowidx=-1) and (count=-1) then
|
||||||
begin
|
begin
|
||||||
@ -337,7 +370,6 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
|
|||||||
count:=high(tdynarrayindex);
|
count:=high(tdynarrayindex);
|
||||||
end;
|
end;
|
||||||
{$endif FPC_DYNARRAYCOPY_FIXED}
|
{$endif FPC_DYNARRAYCOPY_FIXED}
|
||||||
realpsrc:=pdynarray(psrc-sizeof(tdynarray));
|
|
||||||
if (lowidx<0) then
|
if (lowidx<0) then
|
||||||
begin
|
begin
|
||||||
{ Decrease count if index is negative, this is different from how copy()
|
{ 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;
|
count:=count+lowidx;
|
||||||
lowidx:=0;
|
lowidx:=0;
|
||||||
end;
|
end;
|
||||||
if (count>realpsrc^.high-lowidx+1) then
|
if (count>maxcount-lowidx) then
|
||||||
count:=realpsrc^.high-lowidx+1;
|
count:=maxcount-lowidx;
|
||||||
if count<=0 then
|
if count<=0 then
|
||||||
exit;
|
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 }
|
{ create new array }
|
||||||
size:=elesize*count;
|
size:=elesize*count;
|
||||||
getmem(pointer(result),size+sizeof(tdynarray));
|
getmem(pointer(result),size+sizeof(tdynarray));
|
||||||
|
99
tests/test/tarray22.pp
Normal file
99
tests/test/tarray22.pp
Normal 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.
|
||||||
|
|
10
tests/test/tarrconstr10.pp
Normal file
10
tests/test/tarrconstr10.pp
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
{%FAIL}
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr10;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..2] of integer;
|
||||||
|
begin
|
||||||
|
a := [1,2];
|
||||||
|
end.
|
10
tests/test/tarrconstr11.pp
Normal file
10
tests/test/tarrconstr11.pp
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
{%FAIL}
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr11;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..2] of integer;
|
||||||
|
begin
|
||||||
|
a := [1,2,3,4];
|
||||||
|
end.
|
29
tests/test/tarrconstr12.pp
Normal file
29
tests/test/tarrconstr12.pp
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr12;
|
||||||
|
|
||||||
|
procedure CheckArray(Actual, Expected: array of Integer; 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;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..2,0..2] of integer;
|
||||||
|
i, j: integer;
|
||||||
|
begin
|
||||||
|
a := [[1,2,3],[10,20,30],[100,200,300]];
|
||||||
|
|
||||||
|
for i := 0 to 2 do
|
||||||
|
for j := 0 to 2 do
|
||||||
|
writeln(i,',',j,':',a[i,j]);
|
||||||
|
|
||||||
|
CheckArray(a[0], [1, 2, 3], 1);
|
||||||
|
CheckArray(a[1], [10,20,30], 2);
|
||||||
|
CheckArray(a[2], [100,200,300], 3);
|
||||||
|
end.
|
10
tests/test/tarrconstr13.pp
Normal file
10
tests/test/tarrconstr13.pp
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
{%FAIL}
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr13;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..0] of integer;
|
||||||
|
begin
|
||||||
|
a := ['a'];
|
||||||
|
end.
|
10
tests/test/tarrconstr14.pp
Normal file
10
tests/test/tarrconstr14.pp
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
{%FAIL}
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr14;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..2] of integer;
|
||||||
|
begin
|
||||||
|
a := [];
|
||||||
|
end.
|
30
tests/test/tarrconstr15.pp
Normal file
30
tests/test/tarrconstr15.pp
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
{ %OPT = -gh }
|
||||||
|
|
||||||
|
program tarrconstr15;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
procedure CheckArray(Actual, Expected: array of String; 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;
|
||||||
|
|
||||||
|
var
|
||||||
|
arr: array[0..3] of String;
|
||||||
|
i: SizeInt;
|
||||||
|
begin
|
||||||
|
HaltOnNotReleased := True;
|
||||||
|
|
||||||
|
arr := ['Alpha', 'Beta', 'Gamma', 'Delta'];
|
||||||
|
CheckArray(arr, ['Alpha', 'Beta', 'Gamma', 'Delta'], 1);
|
||||||
|
|
||||||
|
{ ensure that everything is freed correctly }
|
||||||
|
for i := Low(arr) to High(arr) do
|
||||||
|
UniqueString(arr[i]);
|
||||||
|
end.
|
9
tests/test/tarrconstr9.pp
Normal file
9
tests/test/tarrconstr9.pp
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
program tarrconstr9;
|
||||||
|
|
||||||
|
var
|
||||||
|
a: array[0..2] of integer;
|
||||||
|
begin
|
||||||
|
a := [1,2,3];
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user