paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 20:49:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* turned getpropaccesslist, add_parameters and add_index_parameter into

Browse Source 
methods of tpropertysym (refactoring)
  * turned code to copy the contents of a property into another one
    into a method of tpropertysym (refactoring)

git-svn-id: trunk@22955 -
This commit is contained in:
Jonas Maebe 2012-11-08 20:17:48 +00:00
parent cf717c4b75
commit 5929ec5592
6 changed files with 97 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/nflw.pas
View File

@ -749,7 +749,7 @@ implementation
loopbody:=internalstatements(loopbodystatement); loopbody:=internalstatements(loopbodystatement);
{ for-in loop variable := enumerator.current } { for-in loop variable := enumerator.current }
if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then if enumerator_current.getpropaccesslist(palt_read,propaccesslist) then
begin begin
case propaccesslist.firstsym^.sym.typ of case propaccesslist.firstsym^.sym.typ of
fieldvarsym : fieldvarsym :

20
compiler/nutils.pas
View File

@ -94,7 +94,6 @@ interface
containing no code } containing no code }
function has_no_code(n : tnode) : boolean; function has_no_code(n : tnode) : boolean;
function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist); procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
function node_to_propaccesslist(p1:tnode):tpropaccesslist; function node_to_propaccesslist(p1:tnode):tpropaccesslist;
@ -886,25 +885,6 @@ implementation
end; end;
function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean;
var
hpropsym : tpropertysym;
begin
result:=false;
{ find property in the overridden list }
hpropsym:=propsym;
repeat
propaccesslist:=hpropsym.propaccesslist[pap];
if not propaccesslist.empty then
begin
result:=true;
exit;
end;
hpropsym:=hpropsym.overriddenpropsym;
until not assigned(hpropsym);
end;
procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist); procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist);
var var
plist : ppropaccesslistitem; plist : ppropaccesslistitem;

46
compiler/pdecvar.pas
View File

@ -325,32 +325,6 @@ implementation
end; end;
end; end;
procedure add_parameters(p: tpropertysym; readprocdef, writeprocdef: tprocdef);
var
i: integer;
orig, hparavs: tparavarsym;
begin
for i := 0 to p.parast.SymList.Count - 1 do
begin
orig:=tparavarsym(p.parast.SymList[i]);
hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
readprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
writeprocdef.parast.insert(hparavs);
end;
end;
procedure add_index_parameter(var paranr: word; p: tpropertysym; readprocdef, writeprocdef: tprocdef);
var
hparavs: tparavarsym;
begin
inc(paranr);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
readprocdef.parast.insert(hparavs);
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]);
writeprocdef.parast.insert(hparavs);
end;
var var
sym : tsym; sym : tsym;
srsymtable: tsymtable; srsymtable: tsymtable;
@ -457,7 +431,7 @@ implementation
index parameter doesn't count (PFV) } index parameter doesn't count (PFV) }
if paranr>0 then if paranr>0 then
begin begin
add_parameters(p,readprocdef,writeprocdef); p.add_accessor_parameters(readprocdef,writeprocdef);
include(p.propoptions,ppo_hasparameters); include(p.propoptions,ppo_hasparameters);
end; end;
end; end;
@ -499,7 +473,7 @@ implementation
p.indexdef:=pt.resultdef; p.indexdef:=pt.resultdef;
include(p.propoptions,ppo_indexed); include(p.propoptions,ppo_indexed);
{ concat a longint to the para templates } { concat a longint to the para templates }
add_index_parameter(paranr,p,readprocdef,writeprocdef); p.add_index_parameter(paranr,readprocdef,writeprocdef);
pt.free; pt.free;
end; end;
end end
@ -514,21 +488,9 @@ implementation
(overridden.typ=propertysym) and (overridden.typ=propertysym) and
not(is_dispinterface(astruct)) then not(is_dispinterface(astruct)) then
begin begin
tpropertysym(overridden).makeduplicate(p,readprocdef,writeprocdef,paranr);
p.overriddenpropsym:=tpropertysym(overridden); p.overriddenpropsym:=tpropertysym(overridden);
{ inherit all type related entries } include(p.propoptions,ppo_overrides);
p.indexdef:=tpropertysym(overridden).indexdef;
p.propdef:=tpropertysym(overridden).propdef;
p.index:=tpropertysym(overridden).index;
p.default:=tpropertysym(overridden).default;
p.propoptions:=tpropertysym(overridden).propoptions + [ppo_overrides];
if ppo_hasparameters in p.propoptions then
begin
p.parast:=tpropertysym(overridden).parast.getcopy;
add_parameters(p,readprocdef,writeprocdef);
paranr:=p.parast.SymList.Count;
end;
if ppo_indexed in p.propoptions then
add_index_parameter(paranr,p,readprocdef,writeprocdef);
end end
else else
begin begin

4
compiler/pexpr.pas
View File

@ -1090,7 +1090,7 @@ implementation
{ if not(afterassignment) and not(in_args) then } { if not(afterassignment) and not(in_args) then }
if token=_ASSIGNMENT then if token=_ASSIGNMENT then
begin begin
if getpropaccesslist(propsym,palt_write,propaccesslist) then if propsym.getpropaccesslist(palt_write,propaccesslist) then
begin begin
sym:=propaccesslist.firstsym^.sym; sym:=propaccesslist.firstsym^.sym;
case sym.typ of case sym.typ of
@ -1142,7 +1142,7 @@ implementation
end end
else else
begin begin
if getpropaccesslist(propsym,palt_read,propaccesslist) then if propsym.getpropaccesslist(palt_read,propaccesslist) then
begin begin
sym := propaccesslist.firstsym^.sym; sym := propaccesslist.firstsym^.sym;
case sym.typ of case sym.typ of

86
compiler/symsym.pas
View File

@ -286,6 +286,12 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override; procedure buildderef;override;
procedure deref;override; procedure deref;override;
function getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
{ copies the settings of the current propertysym to p; a bit like
a form of getcopy, but without the name }
procedure makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
procedure add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
procedure add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
end; end;
tconstvalue = record tconstvalue = record
@ -1187,6 +1193,86 @@ implementation
end; end;
function tpropertysym.getpropaccesslist(pap:tpropaccesslisttypes;out plist:tpropaccesslist):boolean;
var
hpropsym : tpropertysym;
begin
result:=false;
{ find property in the overridden list }
hpropsym:=self;
repeat
plist:=hpropsym.propaccesslist[pap];
if not plist.empty then
begin
result:=true;
exit;
end;
hpropsym:=hpropsym.overriddenpropsym;
until not assigned(hpropsym);
end;
procedure tpropertysym.add_accessor_parameters(readprocdef, writeprocdef: tprocdef);
var
i: integer;
orig, hparavs: tparavarsym;
begin
for i := 0 to parast.SymList.Count - 1 do
begin
orig:=tparavarsym(parast.SymList[i]);
if assigned(readprocdef) then
begin
hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
readprocdef.parast.insert(hparavs);
end;
if assigned(writeprocdef) then
begin
hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]);
writeprocdef.parast.insert(hparavs);
end;
end;
end;
procedure tpropertysym.add_index_parameter(var paranr: word; readprocdef, writeprocdef: tprocdef);
var
hparavs: tparavarsym;
begin
inc(paranr);
if assigned(readprocdef) then
begin
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
readprocdef.parast.insert(hparavs);
end;
if assigned(writeprocdef) then
begin
hparavs:=tparavarsym.create('$index',10*paranr,vs_value,indexdef,[]);
writeprocdef.parast.insert(hparavs);
end;
end;
procedure tpropertysym.makeduplicate(p: tpropertysym; readprocdef, writeprocdef: tprocdef; out paranr: word);
begin
{ inherit all type related entries }
p.indexdef:=indexdef;
p.propdef:=propdef;
p.index:=index;
p.default:=default;
p.propoptions:=propoptions;
paranr:=0;
if ppo_hasparameters in propoptions then
begin
p.parast:=parast.getcopy;
p.add_accessor_parameters(readprocdef,writeprocdef);
paranr:=p.parast.SymList.Count;
end;
if ppo_indexed in p.propoptions then
p.add_index_parameter(paranr,readprocdef,writeprocdef);
end;
function tpropertysym.getsize : asizeint; function tpropertysym.getsize : asizeint;
begin begin
getsize:=0; getsize:=0;

8
compiler/utils/ppudump.pp
View File

@ -1590,10 +1590,10 @@ const
(mask:vo_is_msgsel;str:'MsgSel'), (mask:vo_is_msgsel;str:'MsgSel'),
(mask:vo_is_weak_external;str:'WeakExternal'), (mask:vo_is_weak_external;str:'WeakExternal'),
(mask:vo_is_first_field;str:'IsFirstField'), (mask:vo_is_first_field;str:'IsFirstField'),
(mask:vo_volatile;str:'Volatile'), (mask:vo_volatile; str:'Volatile'),
(mask:vo_has_section;str:'HasSection'), (mask:vo_has_section; str:'HasSection'),
(mask:vo_force_finalize;str:'ForceFinalize'), (mask:vo_force_finalize; str:'ForceFinalize'),
(mask:vo_is_default_var;str:'DefaultIntrinsicVar') (mask:vo_is_default_var; str:'DefaultIntrinsicVar')
); );
var var
i : longint; i : longint;