Browse Source

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

svenbarth 6 years ago
parent
commit
9a99ab9dda
5 changed files with 216 additions and 57 deletions
  1. 3 0
      .gitattributes
  2. 117 57
      compiler/pexpr.pas
  3. 22 0
      tests/webtbs/tw34287.pp
  4. 37 0
      tests/webtbs/uw34287a.pp
  5. 37 0
      tests/webtbs/uw34287b.pp

+ 3 - 0
.gitattributes

@@ -16249,6 +16249,7 @@ tests/webtbs/tw34124.pp svneol=native#text/pascal
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
 tests/webtbs/tw34239.pp svneol=native#text/pascal
 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/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.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/uw3353.pp svneol=native#text/plain
 tests/webtbs/uw3356.pp svneol=native#text/plain
 tests/webtbs/uw3356.pp svneol=native#text/plain
 tests/webtbs/uw33839.pp -text svneol=native#text/pascal
 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/uw3429.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474a.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain
 tests/webtbs/uw3474b.pp svneol=native#text/plain

+ 117 - 57
compiler/pexpr.pas

@@ -3362,6 +3362,9 @@ implementation
          filepos    : tfileposinfo;
          filepos    : tfileposinfo;
          callflags  : tcallnodeflags;
          callflags  : tcallnodeflags;
          idstr      : tidstring;
          idstr      : tidstring;
+         spezcontext : tspecializationcontext;
+         isspecialize,
+         mightbegeneric,
          useself,
          useself,
          dopostfix,
          dopostfix,
          again,
          again,
@@ -3483,6 +3486,7 @@ implementation
                       hclassdef:=java_fpcbaserecordtype
                       hclassdef:=java_fpcbaserecordtype
                     else
                     else
                       internalerror(2012012401);
                       internalerror(2012012401);
+                    spezcontext:=nil;
                     { if inherited; only then we need the method with
                     { if inherited; only then we need the method with
                       the same name }
                       the same name }
                     if token <> _ID then
                     if token <> _ID then
@@ -3508,6 +3512,18 @@ implementation
                      end
                      end
                     else
                     else
                      begin
                      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;
                        hs:=pattern;
                        hsorg:=orgpattern;
                        hsorg:=orgpattern;
                        consume(_ID);
                        consume(_ID);
@@ -3517,53 +3533,71 @@ implementation
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,[ssf_has_inherited])
                        else
                        else
                          searchsym_in_class(hclassdef,current_structdef,hs,srsym,srsymtable,[ssf_search_helper]);
                          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;
                      end;
                     if assigned(srsym) then
                     if assigned(srsym) then
                      begin
                      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
                        { load the procdef from the inherited class and
                          not from self }
                          not from self }
                        case srsym.typ of
                        case srsym.typ of
+                         typesym,
                          procsym:
                          procsym:
                            begin
                            begin
-                             useself:=false;
-                             if is_objectpascal_helper(current_structdef) then
-                               begin
-                                 { for a helper load the procdef either from the
-                                   extended type, from the parent helper or from
-                                   the extended type of the parent helper
-                                   depending on the def the found symbol belongs
-                                   to }
-                                 if (srsym.Owner.defowner.typ=objectdef) and
-                                     is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
-                                   if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
-                                       assigned(tobjectdef(current_structdef).childof) then
-                                     hdef:=tobjectdef(current_structdef).childof
-                                   else
-                                     begin
-                                       hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
-                                       useself:=true;
-                                     end
-                                 else
-                                   begin
-                                     hdef:=tdef(srsym.Owner.defowner);
-                                     useself:=true;
-                                   end;
-                               end
-                             else
-                               hdef:=hclassdef;
-                             if (po_classmethod in current_procinfo.procdef.procoptions) or
-                                (po_staticmethod in current_procinfo.procdef.procoptions) then
-                               hdef:=cclassrefdef.create(hdef);
-                             if useself then
+                             { typesym is only a valid choice if we're dealing
+                               with a potential generic }
+                             if (srsym.typ=typesym) and not mightbegeneric then
                                begin
                                begin
-                                 p1:=ctypeconvnode.create_internal(load_self_node,hdef);
+                                 Message(parser_e_methode_id_expected);
+                                 p1:=cerrornode.create;
                                end
                                end
                              else
                              else
                                begin
                                begin
-                                 p1:=ctypenode.create(hdef);
-                                 { we need to allow helpers here }
-                                 ttypenode(p1).helperallowed:=true;
+                                 useself:=false;
+                                 if is_objectpascal_helper(current_structdef) then
+                                   begin
+                                     { for a helper load the procdef either from the
+                                       extended type, from the parent helper or from
+                                       the extended type of the parent helper
+                                       depending on the def the found symbol belongs
+                                       to }
+                                     if (srsym.Owner.defowner.typ=objectdef) and
+                                         is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
+                                       if def_is_related(current_structdef,tdef(srsym.Owner.defowner)) and
+                                           assigned(tobjectdef(current_structdef).childof) then
+                                         hdef:=tobjectdef(current_structdef).childof
+                                       else
+                                         begin
+                                           hdef:=tobjectdef(srsym.Owner.defowner).extendeddef;
+                                           useself:=true;
+                                         end
+                                     else
+                                       begin
+                                         hdef:=tdef(srsym.Owner.defowner);
+                                         useself:=true;
+                                       end;
+                                   end
+                                 else
+                                   hdef:=hclassdef;
+                                 if (po_classmethod in current_procinfo.procdef.procoptions) or
+                                    (po_staticmethod in current_procinfo.procdef.procoptions) then
+                                   hdef:=cclassrefdef.create(hdef);
+                                 if useself then
+                                   begin
+                                     p1:=ctypeconvnode.create_internal(load_self_node,hdef);
+                                   end
+                                 else
+                                   begin
+                                     p1:=ctypenode.create(hdef);
+                                     { we need to allow helpers here }
+                                     ttypenode(p1).helperallowed:=true;
+                                   end;
                                end;
                                end;
                            end;
                            end;
                          propertysym:
                          propertysym:
@@ -3574,11 +3608,22 @@ implementation
                              p1:=cerrornode.create;
                              p1:=cerrornode.create;
                            end;
                            end;
                        end;
                        end;
-                       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);
+                       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,spezcontext);
+                         end;
+                       if p1.nodetype=errorn then
+                         spezcontext.free;
                      end
                      end
                     else
                     else
                      begin
                      begin
@@ -3622,7 +3667,8 @@ implementation
                      again:=false;
                      again:=false;
                      p1:=cerrornode.create;
                      p1:=cerrornode.create;
                    end;
                    end;
-                 postfixoperators(p1,again,getaddr);
+                 if p1.nodetype<>specializen then
+                   postfixoperators(p1,again,getaddr);
                end;
                end;
 
 
              _INTCONST :
              _INTCONST :
@@ -4045,18 +4091,22 @@ implementation
           getaddr : boolean;
           getaddr : boolean;
           pload : tnode;
           pload : tnode;
           spezcontext : tspecializationcontext;
           spezcontext : tspecializationcontext;
-          structdef : tabstractrecorddef;
+          structdef,
+          inheriteddef : tabstractrecorddef;
+          callflags : tcallnodeflags;
         begin
         begin
           if n.nodetype=specializen then
           if n.nodetype=specializen then
             begin
             begin
               getaddr:=tspecializenode(n).getaddr;
               getaddr:=tspecializenode(n).getaddr;
               pload:=tspecializenode(n).left;
               pload:=tspecializenode(n).left;
+              inheriteddef:=tabstractrecorddef(tspecializenode(n).inheriteddef);
               tspecializenode(n).left:=nil;
               tspecializenode(n).left:=nil;
             end
             end
           else
           else
             begin
             begin
               getaddr:=false;
               getaddr:=false;
               pload:=nil;
               pload:=nil;
+              inheriteddef:=nil;
             end;
             end;
 
 
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
           if assigned(parseddef) and assigned(gensym) and assigned(p2) then
@@ -4104,21 +4154,31 @@ implementation
             begin
             begin
               result:=pload;
               result:=pload;
               typecheckpass(result);
               typecheckpass(result);
-              structdef:=nil;
-              case result.resultdef.typ of
-                objectdef,
-                recorddef:
-                  begin
-                    structdef:=tabstractrecorddef(result.resultdef);
-                  end;
-                classrefdef:
-                  begin
-                    structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
-                  end;
-                else
-                  internalerror(2015092703);
-              end;
-              do_member_read(structdef,getaddr,gensym,result,again,[],spezcontext);
+              structdef:=inheriteddef;
+              if not assigned(structdef) then
+                case result.resultdef.typ of
+                  objectdef,
+                  recorddef:
+                    begin
+                      structdef:=tabstractrecorddef(result.resultdef);
+                    end;
+                  classrefdef:
+                    begin
+                      structdef:=tabstractrecorddef(tclassrefdef(result.resultdef).pointeddef);
+                    end;
+                  else
+                    internalerror(2015092703);
+                end;
+              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;
               spezcontext:=nil;
             end
             end
           else
           else

+ 22 - 0
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.

+ 37 - 0
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.

+ 37 - 0
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.