mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-02 18:37:18 +01:00
* update self parameter only for methodpointer and methods
This commit is contained in:
peter
parent
b316d02f8d
commit
cf5d395f0a
@ -41,6 +41,7 @@ interface
|
||||
|
||||
function is_proc_directive(tok:ttoken):boolean;
|
||||
|
||||
procedure check_self_para(aktprocdef:tabstractprocdef);
|
||||
procedure parameter_dec(aktprocdef:tabstractprocdef);
|
||||
|
||||
procedure parse_proc_directives(var pdflags:word);
|
||||
@ -154,6 +155,32 @@ implementation
|
||||
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);
|
||||
{
|
||||
handle_procvar needs the same changes
|
||||
@ -161,7 +188,6 @@ implementation
|
||||
var
|
||||
is_procvar : boolean;
|
||||
sc : tsinglelist;
|
||||
htype,
|
||||
tt : ttype;
|
||||
arrayelementtype : ttype;
|
||||
hvs,
|
||||
@ -169,6 +195,7 @@ implementation
|
||||
srsym : tsym;
|
||||
hs1 : string;
|
||||
varspez : Tvarspez;
|
||||
hpara : tparaitem;
|
||||
inserthigh : boolean;
|
||||
tdefaultvalue : tconstsym;
|
||||
defaultrequired : boolean;
|
||||
@ -218,41 +245,6 @@ implementation
|
||||
inserthigh:=false;
|
||||
tdefaultvalue:=nil;
|
||||
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
|
||||
{ read identifiers and insert with error type }
|
||||
sc.reset;
|
||||
@ -371,7 +363,9 @@ implementation
|
||||
currparast.insert(hvs);
|
||||
vs.highvarsym:=hvs;
|
||||
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);
|
||||
end;
|
||||
end
|
||||
@ -382,7 +376,9 @@ implementation
|
||||
begin
|
||||
{ don't insert a parasym, the varsyms will be
|
||||
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);
|
||||
end;
|
||||
end;
|
||||
@ -393,6 +389,10 @@ implementation
|
||||
if is_procvar then
|
||||
dummyst.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 }
|
||||
dec(testcurobject);
|
||||
current_object_option:=old_object_option;
|
||||
@ -2120,7 +2120,10 @@ const
|
||||
end.
|
||||
{
|
||||
$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
|
||||
are passed
|
||||
|
||||
|
||||
@ -615,6 +615,7 @@ implementation
|
||||
consume(_OF);
|
||||
consume(_OBJECT);
|
||||
include(tprocvardef(tt.def).procoptions,po_methodpointer);
|
||||
check_self_para(tprocvardef(tt.def));
|
||||
end;
|
||||
end;
|
||||
_FUNCTION:
|
||||
@ -642,7 +643,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.46 2002/11/25 17:43:23 peter
|
||||
|
||||
@ -416,6 +416,7 @@ interface
|
||||
{ saves a definition to the return type }
|
||||
rettype : ttype;
|
||||
para : tparalinkedlist;
|
||||
selfpara : tparaitem;
|
||||
proctypeoption : tproctypeoption;
|
||||
proccalloption : tproccalloption;
|
||||
procoptions : tprocoptions;
|
||||
@ -428,7 +429,7 @@ interface
|
||||
destructor destroy;override;
|
||||
procedure ppuwrite(ppufile:tcompilerppufile);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 typename_paras : string;
|
||||
procedure test_if_fpu_result;
|
||||
@ -3017,6 +3018,7 @@ implementation
|
||||
begin
|
||||
inherited create;
|
||||
para:=TParaLinkedList.Create;
|
||||
selfpara:=nil;
|
||||
minparacount:=0;
|
||||
maxparacount:=0;
|
||||
proctypeoption:=potype_none;
|
||||
@ -3036,7 +3038,7 @@ implementation
|
||||
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
|
||||
hp : TParaItem;
|
||||
begin
|
||||
@ -3053,6 +3055,7 @@ implementation
|
||||
inc(minparacount);
|
||||
inc(maxparacount);
|
||||
end;
|
||||
concatpara:=hp;
|
||||
end;
|
||||
|
||||
|
||||
@ -3094,6 +3097,7 @@ implementation
|
||||
begin
|
||||
inherited ppuloaddef(ppufile);
|
||||
Para:=TParaLinkedList.Create;
|
||||
selfpara:=nil;
|
||||
minparacount:=0;
|
||||
maxparacount:=0;
|
||||
ppufile.gettype(rettype);
|
||||
@ -5553,7 +5557,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.118 2002/12/27 15:23:09 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user