* synchronized with trunk

git-svn-id: branches/wasm@46894 -
This commit is contained in:
nickysn 2020-09-18 21:31:05 +00:00
commit 0967f0c371
18 changed files with 413 additions and 51 deletions

8
.gitattributes vendored
View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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,

View File

@ -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;

View File

@ -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;

View File

@ -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
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.

View File

@ -0,0 +1,10 @@
{%FAIL}
{$mode objfpc}
program tarrconstr10;
var
a: array[0..2] of integer;
begin
a := [1,2];
end.

View File

@ -0,0 +1,10 @@
{%FAIL}
{$mode objfpc}
program tarrconstr11;
var
a: array[0..2] of integer;
begin
a := [1,2,3,4];
end.

View 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.

View File

@ -0,0 +1,10 @@
{%FAIL}
{$mode objfpc}
program tarrconstr13;
var
a: array[0..0] of integer;
begin
a := ['a'];
end.

View File

@ -0,0 +1,10 @@
{%FAIL}
{$mode objfpc}
program tarrconstr14;
var
a: array[0..2] of integer;
begin
a := [];
end.

View 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.

View File

@ -0,0 +1,9 @@
{$mode objfpc}
program tarrconstr9;
var
a: array[0..2] of integer;
begin
a := [1,2,3];
end.