* fix for Mantis #36909: apply patch by Ryan Joseph so that array constructors can be used for static arrays as well.

+ added test

git-svn-id: trunk@46891 -
This commit is contained in:
svenbarth 2020-09-18 15:00:15 +00:00
parent d3e18ccb5e
commit 2ff18e48a0
10 changed files with 199 additions and 3 deletions

7
.gitattributes vendored
View File

@ -14398,6 +14398,12 @@ tests/test/tarray7.pp svneol=native#text/plain
tests/test/tarray8.pp svneol=native#text/plain
tests/test/tarray9.pp svneol=native#text/plain
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/tarrconstr3.pp svneol=native#text/pascal
tests/test/tarrconstr4.pp svneol=native#text/pascal
@ -14405,6 +14411,7 @@ tests/test/tarrconstr5.pp svneol=native#text/pascal
tests/test/tarrconstr6.pp svneol=native#text/pascal
tests/test/tarrconstr7.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/tasm10.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_array_2_dynarray,
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;
@ -1168,6 +1169,17 @@ implementation
eq:=te_convert_l1;
doconv:=tc_string_2_chararray;
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
{ other arrays }
begin

View File

@ -119,6 +119,7 @@ interface
function typecheck_array_2_dynarray : tnode; virtual;
function typecheck_elem_2_openarray : tnode; virtual;
function typecheck_arrayconstructor_to_dynarray : tnode; virtual;
function typecheck_arrayconstructor_to_array : tnode; virtual;
private
function _typecheck_int_to_int : tnode;
function _typecheck_cord_to_pointer : tnode;
@ -151,6 +152,7 @@ interface
function _typecheck_array_2_dynarray : tnode;
function _typecheck_elem_2_openarray : tnode;
function _typecheck_arrayconstructor_to_dynarray: tnode;
function _typecheck_arrayconstructor_to_array : tnode;
protected
function first_int_to_int : tnode;virtual;
function first_cstring_to_pchar : tnode;virtual;
@ -2083,6 +2085,64 @@ implementation
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;
begin
result := typecheck_int_to_int;
@ -2269,6 +2329,12 @@ implementation
end;
function ttypeconvnode._typecheck_arrayconstructor_to_array : tnode;
begin
result:=typecheck_arrayconstructor_to_array;
end;
function ttypeconvnode.target_specific_general_typeconv: boolean;
begin
result:=false;
@ -2393,7 +2459,8 @@ implementation
{ interface_2_variant} @ttypeconvnode._typecheck_variant_to_interface,
{ array_2_dynarray} @ttypeconvnode._typecheck_array_2_dynarray,
{ 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
tprocedureofobject = function : tnode of object;
@ -3978,6 +4045,7 @@ implementation
nil,
nil,
@ttypeconvnode._first_nothing,
@ttypeconvnode._first_nothing,
@ttypeconvnode._first_nothing
);
type
@ -4255,7 +4323,8 @@ implementation
@ttypeconvnode._second_nothing, { interface_2_variant }
@ttypeconvnode._second_nothing, { array_2_dynarray }
@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
tprocedureofobject = procedure of object;

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.