浏览代码

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

git-svn-id: trunk@21582 -
svenbarth 13 年之前
父节点
当前提交
7dfaec7a05
共有 5 个文件被更改,包括 48 次插入7 次删除
  1. 1 0
      .gitattributes
  2. 7 3
      compiler/pdecobj.pas
  3. 5 2
      compiler/pdecsub.pas
  4. 11 2
      compiler/psub.pas
  5. 24 0
      tests/webtbs/tw21457.pp

+ 1 - 0
.gitattributes

@@ -12601,6 +12601,7 @@ tests/webtbs/tw2129b.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
 tests/webtbs/tw2131.pp svneol=native#text/plain
 tests/webtbs/tw21443.pp svneol=native#text/plain
 tests/webtbs/tw21443.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
 tests/webtbs/tw2145.pp svneol=native#text/plain
+tests/webtbs/tw21457.pp svneol=native#text/pascal
 tests/webtbs/tw21472.pp svneol=native#text/pascal
 tests/webtbs/tw21472.pp svneol=native#text/pascal
 tests/webtbs/tw21550.pp svneol=native#text/pascal
 tests/webtbs/tw21550.pp svneol=native#text/pascal
 tests/webtbs/tw21551.pp svneol=native#text/plain
 tests/webtbs/tw21551.pp svneol=native#text/plain

+ 7 - 3
compiler/pdecobj.pas

@@ -133,16 +133,20 @@ implementation
         consume(_SEMICOLON);
         consume(_SEMICOLON);
         include(current_structdef.objectoptions,oo_has_constructor);
         include(current_structdef.objectoptions,oo_has_constructor);
         { Set return type, class and record constructors return the
         { 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
         if is_class(pd.struct) or
            is_record(pd.struct) or
            is_record(pd.struct) or
            is_javaclass(pd.struct) then
            is_javaclass(pd.struct) then
           pd.returndef:=pd.struct
           pd.returndef:=pd.struct
         else
         else
+          if is_objectpascal_helper(pd.struct) then
+            pd.returndef:=tobjectdef(pd.struct).extendeddef
+          else
 {$ifdef CPU64bitaddr}
 {$ifdef CPU64bitaddr}
-          pd.returndef:=bool64type;
+            pd.returndef:=bool64type;
 {$else CPU64bitaddr}
 {$else CPU64bitaddr}
-          pd.returndef:=bool32type;
+            pd.returndef:=bool32type;
 {$endif CPU64bitaddr}
 {$endif CPU64bitaddr}
         constr_destr_finish_head(pd,pd.struct);
         constr_destr_finish_head(pd,pd.struct);
         result:=pd;
         result:=pd;

+ 5 - 2
compiler/pdecsub.pas

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

+ 11 - 2
compiler/psub.pas

@@ -404,6 +404,7 @@ implementation
         para         : tcallparanode;
         para         : tcallparanode;
         call         : tcallnode;
         call         : tcallnode;
         newstatement : tstatementnode;
         newstatement : tstatementnode;
+        def          : tabstractrecorddef;
       begin
       begin
         result:=internalstatements(newstatement);
         result:=internalstatements(newstatement);
 
 
@@ -412,9 +413,17 @@ implementation
             { a constructor needs a help procedure }
             { a constructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_constructor) then
             if (current_procinfo.procdef.proctypeoption=potype_constructor) then
               begin
               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
                   begin
-                    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
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                        (srsym.typ=procsym) then
                       begin
                       begin

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