Browse Source

Fix for Mantis #22329.

symtable.pas, searchsym_in_class:
* if we found a helper method that has overload defined we should not forget the symbol as there can be a case that no method with that name is defined in the extended class hierarchy
symtable.pas, searchsym_in_record:
* analogous to the above

+ added test given in the issue
+ added analogous test for record helpers

git-svn-id: trunk@21764 -
svenbarth 13 năm trước cách đây
mục cha
commit
71c13190e1
4 tập tin đã thay đổi với 103 bổ sung6 xóa
  1. 2 0
      .gitattributes
  2. 38 6
      compiler/symtable.pas
  3. 31 0
      tests/test/trhlp44.pp
  4. 32 0
      tests/webtbs/tw22329.pp

+ 2 - 0
.gitattributes

@@ -11092,6 +11092,7 @@ tests/test/trhlp40.pp svneol=native#text/pascal
 tests/test/trhlp41.pp svneol=native#text/pascal
 tests/test/trhlp42.pp svneol=native#text/pascal
 tests/test/trhlp43.pp svneol=native#text/pascal
+tests/test/trhlp44.pp svneol=native#text/pascal
 tests/test/trhlp5.pp svneol=native#text/pascal
 tests/test/trhlp6.pp svneol=native#text/pascal
 tests/test/trhlp7.pp svneol=native#text/pascal
@@ -12666,6 +12667,7 @@ tests/webtbs/tw2226.pp svneol=native#text/plain
 tests/webtbs/tw2229.pp svneol=native#text/plain
 tests/webtbs/tw22320.pp svneol=native#text/plain
 tests/webtbs/tw22326.pp svneol=native#text/plain
+tests/webtbs/tw22329.pp svneol=native#text/pascal
 tests/webtbs/tw2233.pp svneol=native#text/plain
 tests/webtbs/tw22331.pp svneol=native#text/plain
 tests/webtbs/tw2242.pp svneol=native#text/plain

+ 38 - 6
compiler/symtable.pas

@@ -2402,6 +2402,8 @@ 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 }
@@ -2454,11 +2456,13 @@ 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 }
-                if is_class(classh) and searchhelper then
+                  Pascal class and we haven't yet found a helper symbol }
+                if is_class(classh) and searchhelper and not assigned(hlpsrsym) then
                   begin
                     result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
                     if result then
@@ -2467,7 +2471,14 @@ implementation
                         searching for overloads }
                       if (srsym.typ<>procsym) or
                           not (sp_has_overloaded in tprocsym(srsym).symoptions) then
-                        exit;
+                        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;
                   end;
                 srsymtable:=classh.symtable;
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
@@ -2480,6 +2491,15 @@ 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)
@@ -2493,8 +2513,12 @@ 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);
@@ -2504,7 +2528,14 @@ implementation
             searching for overloads }
           if (srsym.typ<>procsym) or
               not (sp_has_overloaded in tprocsym(srsym).symoptions) then
-            exit;
+            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;
         srsymtable:=recordh.symtable;
         srsym:=tsym(srsymtable.FindWithHash(hashedid));
         if assigned(srsym) and is_visible_for_object(srsym,recordh) then
@@ -2513,8 +2544,9 @@ implementation
             result:=true;
             exit;
           end;
-        srsym:=nil;
-        srsymtable:=nil;
+        srsym:=hlpsrsym;
+        srsymtable:=hlpsrsymtable;
+        result:=assigned(srsym);
       end;
 
     function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;

+ 31 - 0
tests/test/trhlp44.pp

@@ -0,0 +1,31 @@
+{ %NORUN }
+
+program trhlp44;
+
+{$mode delphi}
+
+type
+  TTest = record
+
+  end;
+
+  TTestHelper = record helper for TTest
+    procedure SayHello(const I: Integer); overload;
+    procedure SayHello(const S: string); overload;
+  end;
+
+procedure TTestHelper.SayHello(const I: Integer); overload;
+begin
+  Writeln('Hello ', I);
+end;
+
+procedure TTestHelper.SayHello(const S: string); overload;
+begin
+  Writeln('Hello ', S);
+end;
+
+var
+  Obj: TTest;
+begin
+  Obj.SayHello('FPC');
+end.

+ 32 - 0
tests/webtbs/tw22329.pp

@@ -0,0 +1,32 @@
+{ %NORUN }
+
+program tw22329;
+
+{$mode delphi}
+
+type
+  TObjectHelper = class helper for TObject
+    procedure SayHello(const I: Integer); overload;
+    procedure SayHello(const S: string); overload;
+  end;
+
+procedure TObjectHelper.SayHello(const I: Integer); overload;
+begin
+  Writeln('Hello ', I);
+end;
+
+procedure TObjectHelper.SayHello(const S: string); overload;
+begin
+  Writeln('Hello ', S);
+end;
+
+var
+  Obj: TObject;
+begin
+  Obj := TObject.Create;
+  try
+    Obj.SayHello('FPC');
+  finally
+    Obj.Free;
+  end;
+end.