--- Merging r21582 into '.':

A    tests/webtbs/tw21457.pp
U    compiler/pdecsub.pas
U    compiler/pdecobj.pas
C    compiler/psub.pas
--- Merging r21764 into '.':
A    tests/test/trhlp44.pp
A    tests/webtbs/tw22329.pp
U    compiler/symtable.pas
Summary of conflicts:
  Text conflicts: 1

# revisions: 21582,21764
r21582 | svenbarth | 2012-06-12 11:42:22 +0200 (Tue, 12 Jun 2012) | 6 lines
Changed paths:
   M /trunk/compiler/pdecobj.pas
   M /trunk/compiler/pdecsub.pas
   M /trunk/compiler/psub.pas
   A /trunk/tests/webtbs/tw21457.pp

Fix for Mantis #21457

* pdecsub.pas, parse_proc_dec & pdecobj.pas, constructor_head: 
    correctly set the return type of the constructor of a class helper to the extended def
* psub.pas, generate_bodyentry_block:
    call the NEWINSTANCE of the extended class for constructors of class helpers
r21764 | svenbarth | 2012-07-03 18:27:03 +0200 (Tue, 03 Jul 2012) | 9 lines
Changed paths:
   M /trunk/compiler/symtable.pas
   A /trunk/tests/test/trhlp44.pp
   A /trunk/tests/webtbs/tw22329.pp

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: branches/fixes_2_6@22384 -

.gitattributes

@@ -10538,6 +10538,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
@@ -11917,6 +11918,7 @@ tests/webtbs/tw2129.pp svneol=native#text/plain
 tests/webtbs/tw2129b.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
+tests/webtbs/tw21457.pp svneol=native#text/pascal
 tests/webtbs/tw21551.pp svneol=native#text/plain
 tests/webtbs/tw2158.pp svneol=native#text/plain
 tests/webtbs/tw2159.pp svneol=native#text/plain
@@ -11935,6 +11937,7 @@ tests/webtbs/tw2214.pp svneol=native#text/plain
 tests/webtbs/tw2220.pp svneol=native#text/plain
 tests/webtbs/tw2226.pp svneol=native#text/plain
 tests/webtbs/tw2229.pp svneol=native#text/plain
+tests/webtbs/tw22329.pp svneol=native#text/pascal
 tests/webtbs/tw2233.pp svneol=native#text/plain
 tests/webtbs/tw2242.pp svneol=native#text/plain
 tests/webtbs/tw2250.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -101,14 +101,18 @@ implementation
         consume(_SEMICOLON);
         include(current_structdef.objectoptions,oo_has_constructor);
         { Set return type, class and record constructors return the
-          created instance, object constructors return boolean }
+          created instance, helper types return the extended type,
+          object constructors return boolean }
         if is_class(pd.struct) or is_record(pd.struct) then
           pd.returndef:=pd.struct
         else
+          if is_objectpascal_helper(pd.struct) then
+            pd.returndef:=tobjectdef(pd.struct).extendeddef
+          else
 {$ifdef CPU64bitaddr}
-          pd.returndef:=bool64type;
+            pd.returndef:=bool64type;
 {$else CPU64bitaddr}
-          pd.returndef:=bool32type;
+            pd.returndef:=bool32type;
 {$endif CPU64bitaddr}
         result:=pd;
       end;

compiler/pdecsub.pas

@@ -1401,10 +1401,13 @@ implementation
                   if is_class(pd.struct) or is_record(pd.struct) then
                     pd.returndef:=pd.struct
                   else
+                    if is_objectpascal_helper(pd.struct) then
+                      pd.returndef:=tobjectdef(pd.struct).extendeddef
+                    else
 {$ifdef CPU64bitaddr}
-                    pd.returndef:=bool64type;
+                      pd.returndef:=bool64type;
 {$else CPU64bitaddr}
-                    pd.returndef:=bool32type;
+                      pd.returndef:=bool32type;
 {$endif CPU64bitaddr}
                 end
               else

compiler/psub.pas

@@ -293,6 +293,7 @@ implementation
         srsym        : tsym;
         para         : tcallparanode;
         newstatement : tstatementnode;
+        def          : tabstractrecorddef;
       begin
         result:=internalstatements(newstatement);
 
@@ -301,10 +302,18 @@ implementation
             { a constructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_constructor) then
               begin
-                if is_class(current_structdef) then
+                if is_class(current_structdef) or
+                    (
+                      is_objectpascal_helper(current_structdef) and
+                      is_class(tobjectdef(current_structdef).extendeddef)
+                    ) then
                   begin
                     include(current_procinfo.flags,pi_needs_implicit_finally);
-                    srsym:=search_struct_member(current_structdef,'NEWINSTANCE');
+                    if is_objectpascal_helper(current_structdef) then
+                      def:=tabstractrecorddef(tobjectdef(current_structdef).extendeddef)
+                    else
+                      def:=current_structdef;
+                    srsym:=search_struct_member(def,'NEWINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                       begin

compiler/symtable.pas

@@ -2180,6 +2180,8 @@ implementation
         hashedid : THashedIDString;
         orgclass : tobjectdef;
         i        : longint;
+        hlpsrsym : tsym;
+        hlpsrsymtable : tsymtable;
       begin
         orgclass:=classh;
         { in case this is a formal objcclass, first find the real definition }
@@ -2230,11 +2232,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
@@ -2243,7 +2247,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));
@@ -2256,6 +2267,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)
@@ -2269,8 +2289,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);
@@ -2280,7 +2304,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
@@ -2289,8 +2320,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;

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.

tests/webtbs/tw21457.pp

@@ -0,0 +1,24 @@
+unit tw21457;
+{$mode objfpc}
+interface
+uses Classes;
+
+Type
+  TFileStreamHelper = class helper for TFileStream
+  public
+    constructor CreateRetry(const AFileName: string; Mode: Word; Rights: Cardinal);
+  end;
+
+
+implementation
+
+{ TFileStreamHelper }
+
+constructor TFileStreamHelper.CreateRetry(const AFileName:string; Mode:Word; Rights: Cardinal);
+begin
+  //TODO
+  //=> internal error 200305103
+end;
+
+
+end.

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.