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

* support for queueing an access to a series of fieldvarsyms by name in the

Browse Source 
typed const builder

git-svn-id: trunk@31251 -
This commit is contained in:
Jonas Maebe 2015-07-30 16:58:04 +00:00
parent 6f4fe415e9
commit 0e42559047
1 changed files with 40 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
compiler/aasmcnst.pas
View File

@ -338,6 +338,9 @@ type
procedure queue_vecn(def: tdef; const index: tconstexprint); virtual; procedure queue_vecn(def: tdef; const index: tconstexprint); virtual;
{ queue a subscripting operation } { queue a subscripting operation }
procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual; procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); virtual;
{ queue indexing a record recursively via several field names. The fields
are specified in the inner to outer order (i.e., def.field1.field2) }
function queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
{ queue a type conversion operation } { queue a type conversion operation }
procedure queue_typeconvn(fromdef, todef: tdef); virtual; procedure queue_typeconvn(fromdef, todef: tdef); virtual;
{ queue an address taking operation } { queue an address taking operation }
@ -446,7 +449,7 @@ implementation
procedure taggregateinformation.setnextfieldname(AValue: TIDString); procedure taggregateinformation.setnextfieldname(AValue: TIDString);
begin begin
if assigned(fnextfieldname) or if (fnextfieldname<>'') or
not anonrecord then not anonrecord then
internalerror(2015071503); internalerror(2015071503);
fnextfieldname:=AValue; fnextfieldname:=AValue;
@ -1490,6 +1493,42 @@ implementation
end; end;
function ttai_typedconstbuilder.queue_subscriptn_multiple_by_name(def: tabstractrecorddef; const fields: array of TIDString): tdef;
var
syms,
parentdefs: tfplist;
sym: tsym;
curdef: tdef;
i: longint;
begin
result:=nil;
if length(fields)=0 then
internalerror(2015071601);
syms:=tfplist.Create;
syms.count:=length(fields);
parentdefs:=tfplist.create;
parentdefs.Count:=length(fields);
curdef:=def;
for i:=low(fields) to high(fields) do
begin
sym:=search_struct_member_no_helper(tabstractrecorddef(curdef),fields[i]);
if not assigned(sym) or
(sym.typ<>fieldvarsym) or
((i<>high(fields)) and
not(tfieldvarsym(sym).vardef.typ in [objectdef,recorddef])) then
internalerror(2015071505);
syms[i]:=sym;
parentdefs[i]:=curdef;
curdef:=tfieldvarsym(sym).vardef;
result:=curdef;
end;
for i:=high(fields) downto low(fields) do
queue_subscriptn(tabstractrecorddef(parentdefs[i]),tfieldvarsym(syms[i]));
syms.free;
parentdefs.free;
end;
procedure ttai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef); procedure ttai_typedconstbuilder.queue_typeconvn(fromdef, todef: tdef);
begin begin
{ do nothing } { do nothing }