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

* update self parameter only for methodpointer and methods

Browse Source
This commit is contained in:
peter 2003-01-02 19:49:00 +00:00
parent b316d02f8d
commit cf5d395f0a
3 changed files with 57 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
compiler/pdecsub.pas
View File

@ -41,6 +41,7 @@ interface
function is_proc_directive(tok:ttoken):boolean; function is_proc_directive(tok:ttoken):boolean;
procedure check_self_para(aktprocdef:tabstractprocdef);
procedure parameter_dec(aktprocdef:tabstractprocdef); procedure parameter_dec(aktprocdef:tabstractprocdef);
procedure parse_proc_directives(var pdflags:word); procedure parse_proc_directives(var pdflags:word);
@ -154,6 +155,32 @@ implementation
end; end;
procedure check_self_para(aktprocdef:tabstractprocdef);
var
hpara : tparaitem;
begin
hpara:=aktprocdef.selfpara;
if assigned(hpara) and
(
((aktprocdef.deftype=procvardef) and
(po_methodpointer in aktprocdef.procoptions)) or
((aktprocdef.deftype=procdef) and
assigned(tprocdef(aktprocdef)._class))
) then
begin
include(aktprocdef.procoptions,po_containsself);
if hpara.paratyp <> vs_value then
CGMessage(parser_e_self_call_by_value);
if (aktprocdef.deftype=procdef) then
begin
inc(procinfo.selfpointer_offset,tvarsym(hpara.parasym).address);
if compare_defs(hpara.paratype.def,tprocdef(aktprocdef)._class,nothingn)=te_incompatible then
CGMessage2(type_e_incompatible_types,hpara.paratype.def.typename,tprocdef(aktprocdef)._class.typename);
end;
end;
end;
procedure parameter_dec(aktprocdef:tabstractprocdef); procedure parameter_dec(aktprocdef:tabstractprocdef);
{ {
handle_procvar needs the same changes handle_procvar needs the same changes
@ -161,7 +188,6 @@ implementation
var var
is_procvar : boolean; is_procvar : boolean;
sc : tsinglelist; sc : tsinglelist;
htype,
tt : ttype; tt : ttype;
arrayelementtype : ttype; arrayelementtype : ttype;
hvs, hvs,
@ -169,6 +195,7 @@ implementation
srsym : tsym; srsym : tsym;
hs1 : string; hs1 : string;
varspez : Tvarspez; varspez : Tvarspez;
hpara : tparaitem;
inserthigh : boolean; inserthigh : boolean;
tdefaultvalue : tconstsym; tdefaultvalue : tconstsym;
defaultrequired : boolean; defaultrequired : boolean;
@ -218,41 +245,6 @@ implementation
inserthigh:=false; inserthigh:=false;
tdefaultvalue:=nil; tdefaultvalue:=nil;
tt.reset; tt.reset;
{ self is only allowed in procvars and class methods }
if (idtoken=_SELF) and
(is_procvar or
(assigned(procinfo._class) and is_class(procinfo._class))) then
begin
if varspez <> vs_value then
CGMessage(parser_e_self_call_by_value);
if not is_procvar then
begin
htype.setdef(procinfo._class);
vs:=tvarsym.create('@',htype);
vs.varspez:=vs_var;
{ insert the sym in the parasymtable }
tprocdef(aktprocdef).parast.insert(vs);
inc(procinfo.selfpointer_offset,vs.address);
end
else
vs:=nil;
{ must also be included for procvars to allow the proc2procvar }
{ type conversions (po_containsself is in po_comp) (JM) }
include(aktprocdef.procoptions,po_containsself);
consume(idtoken);
consume(_COLON);
single_type(tt,hs1,false);
{ this must be call-by-value, but we generate already an }
{ an error above if that's not the case (JM) }
aktprocdef.concatpara(tt,vs,varspez,nil);
{ check the types for procedures only }
if not is_procvar then
begin
if compare_defs(tt.def,procinfo._class,nothingn)=te_incompatible then
CGMessage2(type_e_incompatible_types,tt.def.typename,procinfo._class.typename);
end;
end
else
begin begin
{ read identifiers and insert with error type } { read identifiers and insert with error type }
sc.reset; sc.reset;
@ -371,7 +363,9 @@ implementation
currparast.insert(hvs); currparast.insert(hvs);
vs.highvarsym:=hvs; vs.highvarsym:=hvs;
end; end;
aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue); hpara:=aktprocdef.concatpara(tt,vs,varspez,tdefaultvalue);
if vs.name='SELF' then
aktprocdef.selfpara:=hpara;
vs:=tvarsym(vs.listnext); vs:=tvarsym(vs.listnext);
end; end;
end end
@ -382,7 +376,9 @@ implementation
begin begin
{ don't insert a parasym, the varsyms will be { don't insert a parasym, the varsyms will be
disposed } disposed }
aktprocdef.concatpara(tt,nil,varspez,tdefaultvalue); hpara:=aktprocdef.concatpara(tt,nil,varspez,tdefaultvalue);
if vs.name='SELF' then
aktprocdef.selfpara:=hpara;
vs:=tvarsym(vs.listnext); vs:=tvarsym(vs.listnext);
end; end;
end; end;
@ -393,6 +389,10 @@ implementation
if is_procvar then if is_procvar then
dummyst.free; dummyst.free;
sc.free; sc.free;
{ check for a self parameter, only for normal procedures. For
procvars we need to wait until the 'of object' is parsed }
if not is_procvar then
check_self_para(aktprocdef);
{ reset object options } { reset object options }
dec(testcurobject); dec(testcurobject);
current_object_option:=old_object_option; current_object_option:=old_object_option;
@ -2120,7 +2120,10 @@ const
end. end.
{ {
$Log$ $Log$
Revision 1.99 2003-01-01 22:51:03 peter Revision 1.100 2003-01-02 19:49:00 peter
* update self parameter only for methodpointer and methods
Revision 1.99 2003/01/01 22:51:03 peter
* high value insertion changed so it works also when 2 parameters * high value insertion changed so it works also when 2 parameters
are passed are passed

6
compiler/ptype.pas
View File

@ -615,6 +615,7 @@ implementation
consume(_OF); consume(_OF);
consume(_OBJECT); consume(_OBJECT);
include(tprocvardef(tt.def).procoptions,po_methodpointer); include(tprocvardef(tt.def).procoptions,po_methodpointer);
check_self_para(tprocvardef(tt.def));
end; end;
end; end;
_FUNCTION: _FUNCTION:
@ -642,7 +643,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.47 2002-12-21 13:07:34 peter Revision 1.48 2003-01-02 19:49:00 peter
* update self parameter only for methodpointer and methods
Revision 1.47 2002/12/21 13:07:34 peter
* type redefine fix for tb0437 * type redefine fix for tb0437
Revision 1.46 2002/11/25 17:43:23 peter Revision 1.46 2002/11/25 17:43:23 peter

13
compiler/symdef.pas
View File

@ -416,6 +416,7 @@ interface
{ saves a definition to the return type } { saves a definition to the return type }
rettype : ttype; rettype : ttype;
para : tparalinkedlist; para : tparalinkedlist;
selfpara : tparaitem;
proctypeoption : tproctypeoption; proctypeoption : tproctypeoption;
proccalloption : tproccalloption; proccalloption : tproccalloption;
procoptions : tprocoptions; procoptions : tprocoptions;
@ -428,7 +429,7 @@ interface
destructor destroy;override; destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure deref;override; procedure deref;override;
procedure concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym); function concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
function para_size(alignsize:longint) : longint; function para_size(alignsize:longint) : longint;
function typename_paras : string; function typename_paras : string;
procedure test_if_fpu_result; procedure test_if_fpu_result;
@ -3017,6 +3018,7 @@ implementation
begin begin
inherited create; inherited create;
para:=TParaLinkedList.Create; para:=TParaLinkedList.Create;
selfpara:=nil;
minparacount:=0; minparacount:=0;
maxparacount:=0; maxparacount:=0;
proctypeoption:=potype_none; proctypeoption:=potype_none;
@ -3036,7 +3038,7 @@ implementation
end; end;
procedure tabstractprocdef.concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym); function tabstractprocdef.concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym):tparaitem;
var var
hp : TParaItem; hp : TParaItem;
begin begin
@ -3053,6 +3055,7 @@ implementation
inc(minparacount); inc(minparacount);
inc(maxparacount); inc(maxparacount);
end; end;
concatpara:=hp;
end; end;
@ -3094,6 +3097,7 @@ implementation
begin begin
inherited ppuloaddef(ppufile); inherited ppuloaddef(ppufile);
Para:=TParaLinkedList.Create; Para:=TParaLinkedList.Create;
selfpara:=nil;
minparacount:=0; minparacount:=0;
maxparacount:=0; maxparacount:=0;
ppufile.gettype(rettype); ppufile.gettype(rettype);
@ -5553,7 +5557,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.119 2002-12-29 18:25:59 peter Revision 1.120 2003-01-02 19:49:00 peter
* update self parameter only for methodpointer and methods
Revision 1.119 2002/12/29 18:25:59 peter
* tprocdef.gettypename implemented * tprocdef.gettypename implemented
Revision 1.118 2002/12/27 15:23:09 peter Revision 1.118 2002/12/27 15:23:09 peter