* fix for Mantis #34526: rely on tc_arrayconstructor_2_set instead of manually converting an array constructor to a set, this way assignment operator overloads are taken into account as well

Note: there is still a conversion to a set if the types were determined to be incompatible, so that the error is still "set of X is incompatible to Y" instead of "array of Z is incompatible to Y"
+ added tests

git-svn-id: trunk@41844 -
This commit is contained in:
svenbarth 2019-04-05 15:24:39 +00:00
parent 156b25501d
commit 18519c9559
5 changed files with 205 additions and 9 deletions

3
.gitattributes vendored
View File

@ -12826,7 +12826,10 @@ tests/test/tarray14.pp svneol=native#text/pascal
tests/test/tarray15.pp svneol=native#text/pascal
tests/test/tarray16.pp svneol=native#text/pascal
tests/test/tarray17.pp svneol=native#text/pascal
tests/test/tarray18.pp svneol=native#text/pascal
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/tarray3.pp svneol=native#text/plain
tests/test/tarray4.pp svneol=native#text/plain
tests/test/tarray5.pp svneol=native#text/plain

View File

@ -2401,15 +2401,6 @@ implementation
not(resultdef.typ in [procvardef,recorddef,setdef]) then
maybe_call_procvar(left,true);
{ convert array constructors to sets, because there is no conversion
possible for array constructors }
if (resultdef.typ<>arraydef) and
is_array_constructor(left.resultdef) then
begin
arrayconstructor_to_set(left);
typecheckpass(left);
end;
if target_specific_general_typeconv then
exit;
@ -2498,6 +2489,16 @@ implementation
te_incompatible :
begin
{ convert an array constructor to a set so that we still get
the error "set of Y incompatible to Z" instead of "array of
X incompatible to Z" }
if (resultdef.typ<>arraydef) and
is_array_constructor(left.resultdef) then
begin
arrayconstructor_to_set(left);
typecheckpass(left);
end;
{ Procedures have a resultdef of voiddef and functions of their
own resultdef. They will therefore always be incompatible with
a procvar. Because isconvertable cannot check for procedures we

149
tests/test/tarray18.pp Normal file
View File

@ -0,0 +1,149 @@
program tarray18;
{$mode objfpc}
{$modeswitch advancedrecords}
function CheckArray(aArr, aExpected: array of LongInt): Boolean;
var
i: LongInt;
begin
if Length(aArr) <> Length(aExpected) then
Exit(False);
for i := Low(aArr) to High(aArr) do
if aArr[i] <> aExpected[i] then
Exit(False);
Result := True;
end;
type
TTest1 = record
f: array of LongInt;
class operator := (a: array of LongInt): TTest1;
end;
TTest2 = record
f: array of LongInt;
class operator Explicit(a: array of LongInt): TTest2;
end;
TTest3 = record
f: array of LongInt;
end;
TTest4 = record
f: array of LongInt;
end;
function AssignArray(a: array of LongInt): specialize TArray<LongInt>;
var
i: LongInt;
begin
SetLength(Result, Length(a));
for i := 0 to High(a) do
Result[i] := a[i];
end;
class operator TTest1.:=(a: array of LongInt): TTest1;
begin
Result.f := AssignArray(a);
end;
class operator TTest2.Explicit(a: array of LongInt): TTest2;
begin
Result.f := AssignArray(a);
end;
operator :=(a: array of LongInt): TTest3;
begin
Result.f := AssignArray(a);
end;
operator :=(a: array of LongInt): TTest4;
begin
Result.f := AssignArray(a);
end;
procedure Test1(aRec: TTest1; a: array of LongInt; aCode: LongInt);
begin
if not CheckArray(aRec.f, a) then
Halt(aCode);
end;
procedure Test2(aRec: TTest2; a: array of LongInt; aCode: LongInt);
begin
if not CheckArray(aRec.f, a) then
Halt(aCode);
end;
procedure Test3(aRec: TTest3; a: array of LongInt; aCode: LongInt);
begin
if not CheckArray(aRec.f, a) then
Halt(aCode);
end;
procedure Test4(aRec: TTest4; a: array of LongInt; aCode: LongInt);
begin
if not CheckArray(aRec.f, a) then
Halt(aCode);
end;
var
t1: TTest1;
t2: TTest2;
t3: TTest3;
t4: TTest4;
begin
t1 := [];
if not CheckArray(t1.f, []) then
Halt(1);
t1 := [2, 4];
if not CheckArray(t1.f, [2, 4]) then
Halt(2);
t1 := TTest1([]);
if not CheckArray(t1.f, []) then
Halt(3);
t1 := TTest1([2, 4]);
if not CheckArray(t1.f, [2, 4]) then
Halt(4);
t2 := TTest2([]);
if not CheckArray(t2.f, []) then
Halt(5);
t2 := TTest2([2, 4]);
if not CheckArray(t2.f, [2, 4]) then
Halt(6);
t3 := [];
if not CheckArray(t3.f, []) then
Halt(7);
t3 := [2, 4];
if not CheckArray(t3.f, [2, 4]) then
Halt(8);
t3 := TTest3([]);
if not CheckArray(t3.f, []) then
Halt(9);
t3 := TTest3([2, 4]);
if not CheckArray(t3.f, [2, 4]) then
Halt(10);
t4 := TTest4([]);
if not CheckArray(t4.f, []) then
Halt(11);
t4 := TTest4([2, 4]);
if not CheckArray(t4.f, [2, 4]) then
Halt(12);
Test1([], [], 13);
Test1([2, 4], [2, 4], 14);
Test2(TTest2([]), [], 15);
Test2(TTest2([2, 4]), [2, 4], 16);
Test3([], [], 17);
Test3([2, 4], [2, 4], 18);
Test4(TTest4([]), [], 19);
Test4(TTest4([2, 4]), [2, 4], 20);
Writeln('ok');
end.

22
tests/test/tarray19.pp Normal file
View File

@ -0,0 +1,22 @@
{ %FAIL }
program tarray19;
{$mode objfpc}
{$modeswitch advancedrecords}
type
TTest = record
class operator Explicit(a: array of LongInt): TTest;
end;
class operator TTest.Explicit(a: array of LongInt): TTest;
begin
end;
var
t: TTest;
begin
t := [21, 42];
end.

21
tests/test/tarray20.pp Normal file
View File

@ -0,0 +1,21 @@
{ %FAIL }
program tarray20;
{$mode objfpc}
{$modeswitch advancedrecords}
type
TTest = record
end;
operator Explicit(a: array of LongInt): TTest;
begin
end;
var
t: TTest;
begin
t := [21, 42];
end.