* fix for Mantis #34287: correctly handle "inherited method" calls if "method" is a generic (no matter if it's mode Delphi or not)

+ added test

git-svn-id: trunk@39787 -

.gitattributes

@@ -16249,6 +16249,7 @@ tests/webtbs/tw34124.pp svneol=native#text/pascal
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
 tests/webtbs/tw34239.pp svneol=native#text/pascal
+tests/webtbs/tw34287.pp svneol=native#text/pascal
 tests/webtbs/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.pp svneol=native#text/plain
@@ -16859,6 +16860,8 @@ tests/webtbs/uw3340.pp svneol=native#text/plain
 tests/webtbs/uw3353.pp svneol=native#text/plain
 tests/webtbs/uw3356.pp svneol=native#text/plain
 tests/webtbs/uw33839.pp -text svneol=native#text/pascal
+tests/webtbs/uw34287a.pp svneol=native#text/pascal
+tests/webtbs/uw34287b.pp svneol=native#text/pascal
 tests/webtbs/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain

compiler/pexpr.pas

@@ -3362,6 +3362,9 @@ implementation
          filepos    : tfileposinfo;
          callflags  : tcallnodeflags;
          idstr      : tidstring;
+         spezcontext : tspecializationcontext;
+         isspecialize,
+         mightbegeneric,
          useself,
          dopostfix,
          again,
@@ -3483,6 +3486,7 @@ implementation
                       hclassdef:=java_fpcbaserecordtype
                     else
                       internalerror(2012012401);
+                    spezcontext:=nil;
                     { if inherited; only then we need the method with
                       the same name }
                     if token <> _ID then
@@ -3508,6 +3512,18 @@ implementation
                      end
                     else
                      begin
+                       if not (m_delphi in current_settings.modeswitches) and
+                           (block_type in inline_specialization_block_types) and
+                           (token=_ID) and
+                           (idtoken=_SPECIALIZE) then
+                         begin
+                           consume(_ID);
+                           if token<>_ID then
+                             message(parser_e_methode_id_expected);
+                           isspecialize:=true;
+                         end
+                       else
+                         isspecialize:=false;
                        hs:=pattern;
                        hsorg:=orgpattern;
                        consume(_ID);
@@ -3517,14 +3533,31 @@ implementation
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
                        else
                          searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
+                       if isspecialize and assigned(srsym) then
+                         begin
+                           if not handle_specialize_inline_specialization(srsym,srsymtable,spezcontext) then
+                             srsym:=nil;
+                         end;
                      end;
                     if assigned(srsym) then
                      begin
-                       check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
+                       mightbegeneric:=(m_delphi in current_settings.modeswitches) and
+                                         (token in [_LT,_LSHARPBRACKET]) and
+                                         (sp_generic_dummy in srsym.symoptions);
                        { load the procdef from the inherited class and
                          not from self }
                        case srsym.typ of
+                         typesym,
                          procsym:
+                           begin
+                             { typesym is only a valid choice if we're dealing
+                               with a potential generic }
+                             if (srsym.typ=typesym) and not mightbegeneric then
+                               begin
+                                 Message(parser_e_methode_id_expected);
+                                 p1:=cerrornode.create;
+                               end
+                             else
                                begin
                                  useself:=false;
                                  if is_objectpascal_helper(current_structdef) then
@@ -3566,6 +3599,7 @@ implementation
                                      ttypenode(p1).helperallowed:=true;
                                    end;
                                end;
+                           end;
                          propertysym:
                            ;
                          else
@@ -3574,11 +3608,22 @@ implementation
                              p1:=cerrornode.create;
                            end;
                        end;
+                       if mightbegeneric then
+                         begin
+                           p1:=cspecializenode.create_inherited(p1,getaddr,srsym,hclassdef);
+                         end
+                       else
+                         begin
+                           if not isspecialize then
+                             check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                            callflags:=[cnf_inherited];
                            include(current_procinfo.flags,pi_has_inherited);
                            if anon_inherited then
                              include(callflags,cnf_anon_inherited);
-                       do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,nil);
+                           do_member_read(hclassdef,getaddr,srsym,p1,again,callflags,spezcontext);
+                         end;
+                       if p1.nodetype=errorn then
+                         spezcontext.free;
                      end
                     else
                      begin
@@ -3622,6 +3667,7 @@ implementation
                      again:=false;
                      p1:=cerrornode.create;
                    end;
+                 if p1.nodetype<>specializen then
                    postfixoperators(p1,again,getaddr);
                end;
 
@@ -4045,18 +4091,22 @@ implementation
           getaddr : boolean;
           pload : tnode;
           spezcontext : tspecializationcontext;
-          structdef : tabstractrecorddef;
+          structdef,
+          inheriteddef : tabstractrecorddef;
+          callflags : tcallnodeflags;
         begin
           if n.nodetype=specializen then
             begin
               getaddr:=tspecializenode(n).getaddr;
               pload:=tspecializenode(n).left;
+              inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
               tspecializenode(n).left:=nil;
             end
           else
             begin
               getaddr:=false;
               pload:=nil;
+              inheriteddef:=nil;
             end;
 
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
@@ -4104,7 +4154,8 @@ implementation
             begin
               result:=pload;
               typecheckpass(result);
-              structdef:=nil;
+              structdef:=inheriteddef;
+              if not assigned(structdef) then
                 case result.resultdef.typ of
                   objectdef,
                   recorddef:
@@ -4118,7 +4169,16 @@ implementation
                   else
                     internalerror(2015092703);
                 end;
-              do_member_read(structdef,getaddr,gensym,result,again,[],spezcontext);
+              if not (structdef.typ in [recorddef,objectdef]) then
+                internalerror(2018092101);
+              if assigned(inheriteddef) then
+                begin
+                  callflags:=[cnf_inherited];
+                  include(current_procinfo.flags,pi_has_inherited);
+                end
+              else
+                callflags:=[];
+              do_member_read(structdef,getaddr,gensym,result,again,callflags,spezcontext);
               spezcontext:=nil;
             end
           else

tests/webtbs/tw34287.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tw34287;
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+uses
+  Classes,
+  uw34287a,
+  uw34287b;
+
+var
+  fooa: uw34287a.TFoo;
+  foob: uw34287b.TFoo;
+begin
+  fooa := uw34287a.TFoo.Create(nil);
+  fooa.Bar('');
+  foob := uw34287b.TFoo.Create(nil);
+  foob.Bar('');
+end.

tests/webtbs/uw34287a.pp

@@ -0,0 +1,37 @@
+unit uw34287a;
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes;
+
+type
+  TBase = class(TComponent)
+  public
+    function Bar<T: TComponent>(const P1: string; out P2: T): Boolean;
+  end;
+
+  TFoo = class(TBase)
+  public
+    function Bar(const P1: string): Boolean;
+  end;
+
+implementation
+
+function TBase.Bar<T>(const P1: string; out P2: T): Boolean;
+begin
+  Result := False;
+end;
+
+function TFoo.Bar(const P1: string): Boolean;
+var
+  C: TComponent;
+begin
+  Result := inherited Bar<TComponent>(P1, C);
+end;
+
+end.

tests/webtbs/uw34287b.pp

@@ -0,0 +1,37 @@
+unit uw34287b;
+
+{$IFDEF FPC}
+ {$MODE OBJFPC}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes;
+
+type
+  TBase = class(TComponent)
+  public
+    generic function Bar<T: TComponent>(const P1: string; out P2: T): Boolean;
+  end;
+
+  TFoo = class(TBase)
+  public
+    function Bar(const P1: string): Boolean;
+  end;
+
+implementation
+
+generic function TBase.Bar<T>(const P1: string; out P2: T): Boolean;
+begin
+  Result := False;
+end;
+
+function TFoo.Bar(const P1: string): Boolean;
+var
+  C: TComponent;
+begin
+  Result := inherited specialize Bar<TComponent>(P1, C);
+end;
+
+end.