浏览代码

* fix for Mantis #36388: correctly handle generic constraints when looking for helpers

git-svn-id: trunk@43629 -
svenbarth 5 年之前
父节点
当前提交
927c91e093
共有 5 个文件被更改,包括 99 次插入0 次删除
  1. 3 0
      .gitattributes
  2. 10 0
      compiler/symtable.pas
  3. 33 0
      tests/test/tgenfunc19.pp
  4. 37 0
      tests/test/ugenfunc19.pp
  5. 16 0
      tests/webtbs/tw36388.pp

+ 3 - 0
.gitattributes

@@ -14640,6 +14640,7 @@ tests/test/tgenfunc15.pp svneol=native#text/pascal
 tests/test/tgenfunc16.pp svneol=native#text/pascal
 tests/test/tgenfunc17.pp svneol=native#text/pascal
 tests/test/tgenfunc18.pp svneol=native#text/pascal
+tests/test/tgenfunc19.pp svneol=native#text/pascal
 tests/test/tgenfunc2.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
@@ -15401,6 +15402,7 @@ tests/test/ugeneric96b.pp svneol=native#text/pascal
 tests/test/ugeneric96c.pp svneol=native#text/pascal
 tests/test/ugeneric96d.pp svneol=native#text/pascal
 tests/test/ugeneric99.pp svneol=native#text/pascal
+tests/test/ugenfunc19.pp svneol=native#text/pascal
 tests/test/ugenfunc7.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
@@ -17878,6 +17880,7 @@ tests/webtbs/tw36212.pp svneol=native#text/pascal
 tests/webtbs/tw36215.pp svneol=native#text/pascal
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
+tests/webtbs/tw36388.pp svneol=native#text/pascal
 tests/webtbs/tw3650.pp svneol=native#text/plain
 tests/webtbs/tw3653.pp svneol=native#text/plain
 tests/webtbs/tw3661.pp svneol=native#text/plain

+ 10 - 0
compiler/symtable.pas

@@ -4236,6 +4236,16 @@ implementation
           anything }
         if current_module.extendeddefs.count=0 then
           exit;
+        if (df_genconstraint in pd.defoptions) then
+          begin
+            { if we have a constraint for a class type or a single interface we
+              use that to resolve helpers at declaration time of the generic,
+              otherwise there can't be any helpers as the type isn't known yet }
+            if pd.typ=objectdef then
+              pd:=tobjectdef(pd).getparentdef
+            else
+              exit;
+          end;
         { no helpers for anonymous types }
         if ((pd.typ in [recorddef,objectdef]) and
             (

+ 33 - 0
tests/test/tgenfunc19.pp

@@ -0,0 +1,33 @@
+program tgenfunc19;
+
+{$mode objfpc}
+
+uses
+  ugenfunc19;
+
+type
+  TTest2 = class(TTest)
+    class function Test: LongInt;
+  end;
+
+  TTest2Helper = class helper for TTest2
+    class function Test: LongInt;
+  end;
+
+class function TTest2.Test: LongInt;
+begin
+  Result := 3;
+end;
+
+class function TTest2Helper.Test: LongInt;
+begin
+  Result := 4;
+end;
+
+begin
+  if specialize DoTest<TTest> <> 2 then
+    Halt(1);
+  if specialize DoTest<TTest2> <> 3 then
+    Halt(2);
+  Writeln('Ok');
+end.

+ 37 - 0
tests/test/ugenfunc19.pp

@@ -0,0 +1,37 @@
+unit ugenfunc19;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TTest = class
+    class function Test: LongInt; static;
+  end;
+
+  TTestHelper = class helper for TTest
+    class function Test: LongInt; static;
+  end;
+
+generic function DoTest<T: TTest>: LongInt;
+
+implementation
+
+class function TTest.Test: LongInt;
+begin
+  Result := 1;
+end;
+
+class function TTestHelper.Test: LongInt;
+begin
+  Result := 2;
+end;
+
+generic function DoTest<T>: LongInt;
+begin
+  Result := T.Test;
+end;
+
+
+end.
+

+ 16 - 0
tests/webtbs/tw36388.pp

@@ -0,0 +1,16 @@
+{ %NORUN }
+
+{$mode objfpc}
+
+program tw36388;
+uses
+  SysUtils, FGL;
+
+generic function CopyList<T: TFPSList> (source: T): T;
+begin
+ // Internal error 200204175
+  result := T.Create;
+end;
+
+begin
+end.