From 684c8842e7242e2c2557bb8c01dcd7c040f3b1a4 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Fri, 5 Sep 2014 14:42:22 +0000
Subject: [PATCH] Fix for Mantis #26599.

pgenutils.pas, check_generic_constraints:
  * correctly handle forward defs if the constraint is either a single IInterface/IUnknown or a TObject/class

+ added tests

git-svn-id: trunk@28601 -
---
 .gitattributes                 |  5 +++++
 compiler/pgenutil.pas          | 33 +++++++++++++++++++++++++++-----
 tests/test/tgenconstraint37.pp | 35 ++++++++++++++++++++++++++++++++++
 tests/test/tgenconstraint38.pp | 20 +++++++++++++++++++
 tests/test/tgenconstraint39.pp | 23 ++++++++++++++++++++++
 tests/test/tgenconstraint40.pp | 23 ++++++++++++++++++++++
 tests/webtbs/tw26599.pp        | 19 ++++++++++++++++++
 7 files changed, 153 insertions(+), 5 deletions(-)
 create mode 100644 tests/test/tgenconstraint37.pp
 create mode 100644 tests/test/tgenconstraint38.pp
 create mode 100644 tests/test/tgenconstraint39.pp
 create mode 100644 tests/test/tgenconstraint40.pp
 create mode 100644 tests/webtbs/tw26599.pp

diff --git a/.gitattributes b/.gitattributes
index dc09676a97..596ffa81c7 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -11541,7 +11541,11 @@ tests/test/tgenconstraint33.pp svneol=native#text/pascal
 tests/test/tgenconstraint34.pp svneol=native#text/pascal
 tests/test/tgenconstraint35.pp svneol=native#text/pascal
 tests/test/tgenconstraint36.pp svneol=native#text/pascal
+tests/test/tgenconstraint37.pp svneol=native#text/pascal
+tests/test/tgenconstraint38.pp svneol=native#text/pascal
+tests/test/tgenconstraint39.pp svneol=native#text/pascal
 tests/test/tgenconstraint4.pp svneol=native#text/pascal
+tests/test/tgenconstraint40.pp svneol=native#text/pascal
 tests/test/tgenconstraint5.pp svneol=native#text/pascal
 tests/test/tgenconstraint6.pp svneol=native#text/pascal
 tests/test/tgenconstraint7.pp svneol=native#text/pascal
@@ -14067,6 +14071,7 @@ tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
+tests/webtbs/tw26599.pp svneol=native#text/pascal
 tests/webtbs/tw26615.pp svneol=native#text/pascal
 tests/webtbs/tw26627.pp -text svneol=native#text/plain
 tests/webtbs/tw2666.pp svneol=native#text/plain
diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas
index 2b0a3e3acf..6187e16a35 100644
--- a/compiler/pgenutil.pas
+++ b/compiler/pgenutil.pas
@@ -182,11 +182,26 @@ uses
                           odt_interfacecorba,
                           odt_interfacejava,
                           odt_dispinterface:
-                            if not def_is_related(paraobjdef,formalobjdef.childof) then
-                              begin
-                                MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
-                                result:=false;
-                              end;
+                            begin
+                              if (oo_is_forward in paraobjdef.objectoptions) and
+                                  (paraobjdef.objecttype=formalobjdef.objecttype) and
+                                  (df_genconstraint in formalobjdef.defoptions) and
+                                  (
+                                    (formalobjdef.objecttype=odt_interfacecom) and
+                                    (formalobjdef.childof=interface_iunknown)
+                                  )
+                                  or
+                                  (
+                                    (formalobjdef.objecttype=odt_interfacecorba) and
+                                    (formalobjdef.childof=nil)
+                                  ) then
+                                continue;
+                              if not def_is_related(paraobjdef,formalobjdef.childof) then
+                                begin
+                                  MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
+                                  result:=false;
+                                end;
+                            end;
                           odt_class,
                           odt_javaclass:
                             begin
@@ -225,6 +240,14 @@ uses
                             result:=false;
                             continue;
                           end;
+                        { for forward declared classes we allow pure TObject/class declarations }
+                        if (oo_is_forward in paraobjdef.objectoptions) and
+                            (df_genconstraint in formaldef.defoptions) then
+                          begin
+                            if (formalobjdef.childof=class_tobject) and
+                                not formalobjdef.implements_any_interfaces then
+                              continue;
+                          end;
                         if assigned(formalobjdef.childof) and
                             not def_is_related(paradef,formalobjdef.childof) then
                           begin
diff --git a/tests/test/tgenconstraint37.pp b/tests/test/tgenconstraint37.pp
new file mode 100644
index 0000000000..a9d46c211b
--- /dev/null
+++ b/tests/test/tgenconstraint37.pp
@@ -0,0 +1,35 @@
+{ %NORUN }
+
+program tgenconstraint37;
+
+{$mode objfpc}
+
+type
+  generic TGenericTObject<T: TObject> = class
+  end;
+
+  generic TGenericClass<T: class> = class
+  end;
+
+  generic TGenericIInterface<T: IInterface> = class
+  end;
+
+  TTestObject = class;
+  ITestInterface = interface;
+
+
+  TGenericTObjectTTestObject = specialize TGenericTObject<TTestObject>;
+
+  TGenericClassTTestObject = specialize TGenericClass<TTestObject>;
+
+  TGenericIInterfaceITestInterface = specialize TGenericIInterface<ITestInterface>;
+
+
+  TTestObject = class
+  end;
+
+  ITestInterface = interface
+  end;
+
+begin
+end.
diff --git a/tests/test/tgenconstraint38.pp b/tests/test/tgenconstraint38.pp
new file mode 100644
index 0000000000..95a319e890
--- /dev/null
+++ b/tests/test/tgenconstraint38.pp
@@ -0,0 +1,20 @@
+{ %FAIL }
+
+program tgenconstraint38;
+
+{$mode objfpc}
+
+type
+  generic TGeneric<T: TObject, IInterface> = class
+  end;
+
+  TTest = class;
+
+  TGenericTTest = specialize TGeneric<TTest>;
+
+  TTest = class
+  end;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint39.pp b/tests/test/tgenconstraint39.pp
new file mode 100644
index 0000000000..4230178ee1
--- /dev/null
+++ b/tests/test/tgenconstraint39.pp
@@ -0,0 +1,23 @@
+{ %FAIL }
+
+program tgenconstraint39;
+
+{$mode objfpc}
+
+type
+  TSomeClass = class
+  end;
+
+  generic TGeneric<T: TSomeClass> = class
+  end;
+
+  TTest = class;
+
+  TGenericTTest = specialize TGeneric<TTest>;
+
+  TTest = class(TSomeClass)
+  end;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint40.pp b/tests/test/tgenconstraint40.pp
new file mode 100644
index 0000000000..a89d14d384
--- /dev/null
+++ b/tests/test/tgenconstraint40.pp
@@ -0,0 +1,23 @@
+{ %FAIL }
+
+program tgenconstraint40;
+
+{$mode objfpc}
+
+type
+  ISomeInterface = interface
+  end;
+
+  generic TGeneric<T: ISomeInterface> = class
+  end;
+
+  ITest = interface;
+
+  TGenericITest = specialize TGeneric<ITest>;
+
+  ITest = interface(ISomeInterface)
+  end;
+
+begin
+
+end.
diff --git a/tests/webtbs/tw26599.pp b/tests/webtbs/tw26599.pp
new file mode 100644
index 0000000000..1cc76c9a34
--- /dev/null
+++ b/tests/webtbs/tw26599.pp
@@ -0,0 +1,19 @@
+{ %NORUN }
+
+program tw26599;
+
+{$mode delphi}
+
+type
+  TSomeList<T : TObject> = Class
+  End; { Class }
+
+  TSomeClass = Class;
+  TSomeClassList = TSomeList<TSomeClass>;
+
+  TSomeClass = Class(TObject)
+    SomeList : TSomeClassList;
+  End;
+
+begin
+end.