1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 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.
|