浏览代码

* when calling an inherited methode by msg, any var parameters are compatible,
if somebody knows how to implement it better, feel free to do so

git-svn-id: trunk@4889 -

florian 19 年之前
父节点
当前提交
32c7ba29ea
共有 2 个文件被更改,包括 19 次插入8 次删除
  1. 15 5
      compiler/pexpr.pas
  2. 4 3
      compiler/symtable.pas

+ 15 - 5
compiler/pexpr.pas

@@ -88,8 +88,8 @@ implementation
     const
     const
        { true, if the inherited call is anonymous }
        { true, if the inherited call is anonymous }
        anon_inherited : boolean = false;
        anon_inherited : boolean = false;
-
-
+       { last def found, only used by anon. inherited calls to insert proper type casts }
+       srdef : tdef = nil;
 
 
     procedure string_dec(var t: ttype);
     procedure string_dec(var t: ttype);
     { reads a string type with optional length }
     { reads a string type with optional length }
@@ -990,7 +990,17 @@ implementation
                   begin
                   begin
                     currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
                     currpara:=tparavarsym(current_procinfo.procdef.paras[i]);
                     if not(vo_is_hidden_para in currpara.varoptions) then
                     if not(vo_is_hidden_para in currpara.varoptions) then
-                      para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
+                      begin
+                        { inheritance by msgint? }
+                        if assigned(srdef) then
+                          { anonymous inherited via msgid calls only require a var parameter for
+                            both methods, so we need some type casting here }
+                          para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal(
+                            cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vartype),
+                          para)
+                        else
+                          para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para);
+                      end;
                  end;
                  end;
               end
               end
              else
              else
@@ -1181,7 +1191,6 @@ implementation
 
 
     { the ID token has to be consumed before calling this function }
     { the ID token has to be consumed before calling this function }
     procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
     procedure do_member_read(classh:tobjectdef;getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean;callflags:tcallnodeflags);
-
       var
       var
          static_name : string;
          static_name : string;
          isclassref  : boolean;
          isclassref  : boolean;
@@ -2131,8 +2140,9 @@ implementation
                      { For message methods we need to search using the message
                      { For message methods we need to search using the message
                        number or string }
                        number or string }
                      pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
                      pd:=tprocsym(current_procinfo.procdef.procsym).first_procdef;
+                     srdef:=nil;
                      if (po_msgint in pd.procoptions) then
                      if (po_msgint in pd.procoptions) then
-                       searchsym_in_class_by_msgint(classh,pd.messageinf.i,srsym,srsymtable)
+                       searchsym_in_class_by_msgint(classh,pd.messageinf.i,srdef,srsym,srsymtable)
                      else
                      else
                       if (po_msgstr in pd.procoptions) then
                       if (po_msgstr in pd.procoptions) then
                         searchsym_in_class_by_msgstr(classh,pd.messageinf.str^,srsym,srsymtable)
                         searchsym_in_class_by_msgstr(classh,pd.messageinf.str^,srsym,srsymtable)

+ 4 - 3
compiler/symtable.pas

@@ -221,7 +221,7 @@ interface
     function  searchsym_type(const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_type(const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : stringid;out srsym:tsym;out srsymtable:tsymtable):boolean;
-    function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint;out srsym:tsym;out srsymtable:tsymtable):boolean;
+    function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint;out srdef : tdef;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:tsymtable):boolean;
     function  search_system_type(const s: stringid): ttypesym;
     function  search_system_type(const s: stringid): ttypesym;
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
@@ -994,7 +994,7 @@ implementation
           varalign:=size_2_align(l);
           varalign:=size_2_align(l);
         if (usefieldalignment<> bit_alignment) then
         if (usefieldalignment<> bit_alignment) then
           varalignfield:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
           varalignfield:=used_align(varalign,aktalignment.recordalignmin,fieldalignment);
-            
+
         sym.fieldoffset:=align(_datasize,varalignfield);
         sym.fieldoffset:=align(_datasize,varalignfield);
         if (int64(l)+sym.fieldoffset)>high(aint) then
         if (int64(l)+sym.fieldoffset)>high(aint) then
           begin
           begin
@@ -1853,7 +1853,7 @@ implementation
       end;
       end;
 
 
 
 
-    function searchsym_in_class_by_msgint(classh:tobjectdef;i:longint;out srsym:tsym;out srsymtable:tsymtable):boolean;
+    function searchsym_in_class_by_msgint(classh:tobjectdef;i:longint;out srdef : tdef;out srsym:tsym;out srsymtable:tsymtable):boolean;
       var
       var
         def        : tdef;
         def        : tdef;
       begin
       begin
@@ -1870,6 +1870,7 @@ implementation
                    (po_msgint in tprocdef(def).procoptions) and
                    (po_msgint in tprocdef(def).procoptions) and
                    (tprocdef(def).messageinf.i=i) then
                    (tprocdef(def).messageinf.i=i) then
                   begin
                   begin
+                    srdef:=def;
                     srsym:=tprocdef(def).procsym;
                     srsym:=tprocdef(def).procsym;
                     srsymtable:=classh.symtable;
                     srsymtable:=classh.symtable;
                     result:=true;
                     result:=true;