mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 08:59:27 +02:00
# revisions: 41843,41844,42700
git-svn-id: branches/fixes_3_2@43396 -
This commit is contained in:
parent
c067bf7751
commit
0f4e7b65b2
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -12694,7 +12694,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
|
||||
@ -16435,6 +16438,7 @@ tests/webtbs/tw35862.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3589.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3594.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3595.pp svneol=native#text/plain
|
||||
tests/webtbs/tw35955.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3612.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3617.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3619.pp svneol=native#text/plain
|
||||
|
@ -1009,6 +1009,11 @@ implementation
|
||||
end
|
||||
else if subeq>te_convert_l6 then
|
||||
eq:=pred(subeq)
|
||||
else if subeq=te_convert_operator then
|
||||
{ the operater needs to be applied by element, so we tell
|
||||
the caller that it's some unpreffered conversion and let
|
||||
it handle the per-element stuff }
|
||||
eq:=te_convert_l6
|
||||
else
|
||||
eq:=subeq;
|
||||
doconv:=tc_arrayconstructor_2_dynarray;
|
||||
|
@ -1657,7 +1657,25 @@ implementation
|
||||
left:=nil;
|
||||
{ create a set constructor tree }
|
||||
arrayconstructor_to_set(hp);
|
||||
result:=hp;
|
||||
if is_emptyset(hp) then
|
||||
begin
|
||||
{ enforce the result type for an empty set }
|
||||
hp.resultdef:=resultdef;
|
||||
result:=hp;
|
||||
end
|
||||
else if hp.resultdef<>resultdef then
|
||||
begin
|
||||
{ the set might contain a subrange element (e.g. through a variable),
|
||||
thus we need to insert another type conversion }
|
||||
if nf_explicit in flags then
|
||||
result:=ctypeconvnode.create_explicit(hp,totypedef)
|
||||
else if nf_internal in flags then
|
||||
result:=ctypeconvnode.create_internal(hp,totypedef)
|
||||
else
|
||||
result:=ctypeconvnode.create(hp,totypedef);
|
||||
end
|
||||
else
|
||||
result:=hp;
|
||||
end;
|
||||
|
||||
|
||||
@ -2387,15 +2405,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;
|
||||
|
||||
@ -2484,6 +2493,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
149
tests/test/tarray18.pp
Normal 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
22
tests/test/tarray19.pp
Normal 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
21
tests/test/tarray20.pp
Normal 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.
|
18
tests/webtbs/tw35955.pp
Normal file
18
tests/webtbs/tw35955.pp
Normal file
@ -0,0 +1,18 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tw35955;
|
||||
|
||||
{$mode delphi}
|
||||
|
||||
type
|
||||
TVariantArray = array of Variant;
|
||||
|
||||
var
|
||||
S: string;
|
||||
A: TVariantArray;
|
||||
begin
|
||||
S := 'xyz';
|
||||
A := [S]; // << project1.lpr(13,8) Error: Compilation raised exception internally
|
||||
Writeln(A[0]);
|
||||
Readln;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user