Browse Source

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

svenbarth 6 years ago
parent
commit
18519c9559
5 changed files with 205 additions and 9 deletions
  1. 3 0
      .gitattributes
  2. 10 9
      compiler/ncnv.pas
  3. 149 0
      tests/test/tarray18.pp
  4. 22 0
      tests/test/tarray19.pp
  5. 21 0
      tests/test/tarray20.pp

+ 3 - 0
.gitattributes

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

+ 10 - 9
compiler/ncnv.pas

@@ -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 - 0
tests/test/tarray18.pp

@@ -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 - 0
tests/test/tarray19.pp

@@ -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 - 0
tests/test/tarray20.pp

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