Browse Source

* fix for Mantis #30761: always return the symbol found in the helper instead of doing this dependant on the presence of the overload attribute; for this the collection of all suitable overloads is done in tcallcandidates instead.
+ added test

git-svn-id: trunk@35024 -

svenbarth 8 years ago
parent
commit
d9ea6aae4d
4 changed files with 67 additions and 49 deletions
  1. 1 0
      .gitattributes
  2. 19 1
      compiler/htypechk.pas
  3. 9 48
      compiler/symtable.pas
  4. 38 0
      tests/webtbs/tw30761.pp

+ 1 - 0
.gitattributes

@@ -15262,6 +15262,7 @@ tests/webtbs/tw3064.pp svneol=native#text/plain
 tests/webtbs/tw30666.pp svneol=native#text/plain
 tests/webtbs/tw30706.pp svneol=native#text/plain
 tests/webtbs/tw3073.pp svneol=native#text/plain
+tests/webtbs/tw30761.pp svneol=native#text/pascal
 tests/webtbs/tw3082.pp svneol=native#text/plain
 tests/webtbs/tw3083.pp svneol=native#text/plain
 tests/webtbs/tw30830a.pp svneol=native#text/pascal

+ 19 - 1
compiler/htypechk.pas

@@ -2172,6 +2172,9 @@ implementation
 
     procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean;spezcontext:tspecializationcontext);
 
+      var
+        changedhierarchy : boolean;
+
       function processprocsym(srsym:tprocsym; out foundanything: boolean):boolean;
         var
           j  : integer;
@@ -2216,7 +2219,9 @@ implementation
                 FProcsym:=tprocsym(srsym);
               if po_overload in pd.procoptions then
                 result:=true;
-              ProcdefOverloadList.Add(pd);
+              { if the hierarchy had been changed we need to check for duplicates }
+              if not changedhierarchy or (ProcdefOverloadList.IndexOf(pd)<0) then
+                ProcdefOverloadList.Add(pd);
             end;
         end;
 
@@ -2225,6 +2230,7 @@ implementation
         hashedid   : THashedIDString;
         hasoverload,
         foundanything : boolean;
+        extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
       begin
         if FOperator=NOTOKEN then
@@ -2232,6 +2238,8 @@ implementation
         else
           hashedid.id:=overloaded_names[FOperator];
         hasoverload:=false;
+        extendeddef:=nil;
+        changedhierarchy:=false;
         while assigned(structdef) do
          begin
            { first search in helpers for this type }
@@ -2275,6 +2283,9 @@ implementation
            if is_objectpascal_helper(structdef) and
               (tobjectdef(structdef).extendeddef.typ in [recorddef,objectdef]) then
              begin
+               { remember the first extendeddef of the hierarchy }
+               if not assigned(extendeddef) then
+                 extendeddef:=tabstractrecorddef(tobjectdef(structdef).extendeddef);
                { search methods in the extended type as well }
                srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid));
                if assigned(srsym) and
@@ -2293,6 +2304,13 @@ implementation
              structdef:=tobjectdef(structdef).childof
            else
              structdef:=nil;
+           { switch over to the extended def's hierarchy }
+           if not assigned(structdef) and assigned(extendeddef) then
+             begin
+               structdef:=extendeddef;
+               extendeddef:=nil;
+               changedhierarchy:=true;
+             end;
          end;
       end;
 

+ 9 - 48
compiler/symtable.pas

@@ -3355,8 +3355,6 @@ implementation
         hashedid : THashedIDString;
         orgclass : tobjectdef;
         i        : longint;
-        hlpsrsym : tsym;
-        hlpsrsymtable : tsymtable;
       begin
         orgclass:=classh;
         { in case this is a formal class, first find the real definition }
@@ -3410,31 +3408,18 @@ implementation
           end
         else
           begin
-            hlpsrsym:=nil;
-            hlpsrsymtable:=nil;
             while assigned(classh) do
               begin
                 { search for a class helper method first if this is an Object
                   Pascal class and we haven't yet found a helper symbol }
                 if is_class(classh) and
-                    (ssf_search_helper in flags) and
-                    not assigned(hlpsrsym) then
+                    (ssf_search_helper in flags) then
                   begin
                     result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
+                    { an eventual overload inside the extended type's hierarchy
+                      will be found by tcallcandidates }
                     if result then
-                      { if the procsym is overloaded we need to use the
-                        "original" symbol; the helper symbol will be found when
-                        searching for overloads }
-                      if (srsym.typ<>procsym) or
-                          not (sp_has_overloaded in tprocsym(srsym).symoptions) then
-                        exit
-                      else
-                        begin
-                          { remember the found symbol if the class hierarchy
-                            should not contain the a method with that name }
-                          hlpsrsym:=srsym;
-                          hlpsrsymtable:=srsymtable;
-                        end;
+                      exit;
                   end;
                 srsymtable:=classh.symtable;
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
@@ -3448,15 +3433,6 @@ implementation
                   end;
                 classh:=classh.childof;
               end;
-            { did we find a helper symbol, but no symbol with the same name in
-              the extended object's hierarchy? }
-            if assigned(hlpsrsym) then
-              begin
-                srsym:=hlpsrsym;
-                srsymtable:=hlpsrsymtable;
-                result:=true;
-                exit;
-              end;
           end;
         if is_objcclass(orgclass) then
           result:=search_objc_helper(orgclass,s,srsym,srsymtable)
@@ -3470,29 +3446,15 @@ implementation
     function  searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
         hashedid : THashedIDString;
-        hlpsrsym : tsym;
-        hlpsrsymtable : tsymtable;
       begin
         result:=false;
-        hlpsrsym:=nil;
-        hlpsrsymtable:=nil;
         hashedid.id:=s;
         { search for a record helper method first }
         result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
         if result then
-          { if the procsym is overloaded we need to use the
-            "original" symbol; the helper symbol will be found when
-            searching for overloads }
-          if (srsym.typ<>procsym) or
-              not (sp_has_overloaded in tprocsym(srsym).symoptions) then
-            exit
-          else
-            begin
-              { remember the found symbol if we should not find a symbol with
-                the same name in the extended record }
-              hlpsrsym:=srsym;
-              hlpsrsymtable:=srsymtable;
-            end;
+          { an eventual overload inside the extended type's hierarchy
+            will be found by tcallcandidates }
+          exit;
         srsymtable:=recordh.symtable;
         srsym:=tsym(srsymtable.FindWithHash(hashedid));
         if assigned(srsym) and is_visible_for_object(srsym,recordh) then
@@ -3501,9 +3463,8 @@ implementation
             result:=true;
             exit;
           end;
-        srsym:=hlpsrsym;
-        srsymtable:=hlpsrsymtable;
-        result:=assigned(srsym);
+        srsym:=nil;
+        srsymtable:=nil;
       end;
 
     function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;

+ 38 - 0
tests/webtbs/tw30761.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+program tw30761;
+
+{$mode objfpc}
+
+type
+  Ta = class
+    public
+      procedure Test;
+  end;
+
+  Tb = class(Ta)
+  end;
+
+  TbHelper = class helper for Tb
+    public
+      procedure Test(i: integer); overload;
+  end;
+
+procedure Ta.Test;
+begin
+end;
+
+procedure TbHelper.Test(i: integer);
+begin
+  //Self.Test;
+end;
+
+var
+  b: Tb;
+
+begin
+  b:=Tb.Create;
+  b.Test(1); // Error: Wrong number of parameters specified for call to "Test"
+  b.Test;
+end.
+