* fix global generic functions with constraints in mode Delphi by handling implementations with defines outside of parse_generic_parameters

+ added tests

git-svn-id: trunk@44189 -

.gitattributes

@@ -14768,6 +14768,9 @@ 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/tgenfunc20.pp svneol=native#text/pascal
+tests/test/tgenfunc21.pp svneol=native#text/pascal
+tests/test/tgenfunc22.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
 tests/test/tgenfunc5.pp svneol=native#text/pascal

compiler/pdecsub.pas

@@ -664,7 +664,7 @@ implementation
                       message(type_e_type_id_expected)
                     else
                       begin
-                        genericparams:=parse_generic_parameters(not(m_delphi in current_settings.modeswitches) or parse_only);
+                        genericparams:=parse_generic_parameters(true);
                         if not assigned(genericparams) then
                           internalerror(2015061201);
                         if genericparams.count=0 then
@@ -835,6 +835,11 @@ implementation
                     messagepos1(decltype.fileinfo,sym_e_generic_type_param_decl,decltype.realname);
                     result:=false;
                   end;
+                if df_genconstraint in impltype.typedef.defoptions then
+                  begin
+                    messagepos(tstoreddef(impltype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+                    result:=false;
+                  end;
               end;
           end;
 

compiler/pparautl.pas

@@ -644,6 +644,11 @@ implementation
                   messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
                   result:=false;
                 end;
+              if (fwpd.interfacedef or assigned(fwpd.struct)) and (df_genconstraint in currtype.typedef.defoptions) then
+                begin
+                  messagepos(tstoreddef(currtype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+                  result:=false;
+                end;
             end;
         end;
 
@@ -664,15 +669,17 @@ implementation
             - proc declared in interface of unit (or in class/record/object)
               and defined in implementation; here the fwpd might contain
               constraints while currpd must only contain undefineddefs
-            - forward declaration in implementation }
+            - forward declaration in implementation: here constraints must be
+              repeated }
           foundretdef:=false;
           for i:=0 to fwpd.genericparas.count-1 do
             begin
               fwtype:=ttypesym(fwpd.genericparas[i]);
               currtype:=ttypesym(currpd.genericparas[i]);
-              { if the type in the currpd isn't a pure undefineddef, then we can
+              { if the type in the currpd isn't a pure undefineddef (thus there
-                stop right there }
+                are constraints and the fwpd was declared in the interface, then
-              if (currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions) then
+                we can stop right there }
+              if fwpd.interfacedef and ((currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions)) then
                 exit;
               if not foundretdef then
                 begin

tests/test/tgenfunc20.pp

@@ -0,0 +1,35 @@
+unit tgenfunc20;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{generic procedure TestProc1<T: class>;
+
+type
+  TTest = class
+    generic procedure Test<T: class>;
+  end;}
+
+implementation
+
+generic procedure TestProc2<T: class>; forward;
+
+{generic procedure TestProc1<T>;
+begin
+end;
+
+generic procedure TestProc1<T: class>(aArg1: T);
+begin
+end;}
+
+generic procedure TestProc2<T: class>;
+begin
+end;
+
+{generic procedure TTest.Test<T>;
+begin
+end;}
+
+end.
+

tests/test/tgenfunc21.pp

@@ -0,0 +1,35 @@
+unit tgenfunc21;
+
+{$mode delphi}
+
+interface
+
+procedure TestProc1<T: class>; overload;
+
+type
+  TTest = class
+    procedure Test<T: class>;
+  end;
+
+implementation
+
+procedure TestProc2<T: class>; forward;
+
+procedure TestProc1<T>;
+begin
+end;
+
+procedure TestProc1<T: class>(aArg1: T); overload;
+begin
+end;
+
+procedure TestProc2<T: class>;
+begin
+end;
+
+procedure TTest.Test<T>;
+begin
+end;
+
+end.
+

tests/test/tgenfunc22.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+unit tgenfunc22;
+
+{$mode delphi}
+
+interface
+
+procedure Test<T: class>;
+
+implementation
+
+procedure Test<T: class>;
+begin
+
+end;
+
+end.
+