paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-07 03:19:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

* when calling an inherited methode by msg, any var parameters are compatible,

Browse Source 
if somebody knows how to implement it better, feel free to do so

git-svn-id: trunk@4889 -
This commit is contained in:
florian 2006-10-13 19:15:00 +00:00
parent 9e7b60ec42
commit 32c7ba29ea
2 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/pexpr.pas
View File

@ -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)

7
compiler/symtable.pas
View File

@ -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;