paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:28:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

- removed tabstractrecorddef.get_unit_symtable, which did not always return the unit

Browse Source 
symtable (when you had a local recorddef in a procdef)
  * modified tdef.get_top_level_symtable() so you can specify whether you want to
    skip procdefs or not
  * changed tobjectdef.vmt_def() to no longer require a typesym for the tobjectdef
    (based on patch by Blaise)

git-svn-id: trunk@45361 -
This commit is contained in:
Jonas Maebe 2020-05-13 21:46:29 +00:00
parent 7a60e044e3
commit a2174753c1
4 changed files with 8 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/symcreat.pas
View File

@ -1397,7 +1397,7 @@ implementation
if df_generic in tdef(recst.defowner).defoptions then
tabstractrecordsymtable(recst).insert(hstaticvs)
else
tabstractrecordsymtable(recst).get_unit_symtable.insert(hstaticvs);
tdef(tabstractrecordsymtable(recst).defowner).get_top_level_symtable(false).insert(hstaticvs);
{$endif jvm}
{ generate the symbol for the access }
sl:=tpropaccesslist.create;

9
compiler/symdef.pas
View File

@ -7855,14 +7855,11 @@ implementation
function tobjectdef.vmt_def: trecorddef;
var
where: tsymtable;
vmttypesym: tsymentry;
begin
if not(typesym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
vmttypesym:=typesym.owner.Find('vmtdef$'+mangledparaname)
else
{ Use common parent of trecordsymtable and tobjectsymtable
to avoid invalid typecast error when compiled with -CR option }
vmttypesym:=tabstractrecordsymtable(typesym.owner).get_unit_symtable.Find('vmtdef$'+mangledparaname);
where:=get_top_level_symtable(true);
vmttypesym:=where.Find('vmtdef$'+mangledparaname);
if not assigned(vmttypesym) or
(vmttypesym.typ<>symconst.typesym) or
(ttypesym(vmttypesym).typedef.typ<>recorddef) then

9
compiler/symtable.pas
View File

@ -125,7 +125,6 @@ interface
procedure insertdef(def:TDefEntry);override;
function is_packed: boolean;
function has_single_field(out def:tdef): boolean;
function get_unit_symtable: tsymtable;
{ collects all management operators of the specified type in list (which
is not cleared); the entries are copies and thus must be freed by the
caller }
@ -1677,14 +1676,6 @@ implementation
until false;
end;
function tabstractrecordsymtable.get_unit_symtable: tsymtable;
begin
result:=defowner.owner;
while assigned(result) and (result.symtabletype in [ObjectSymtable,recordsymtable]) do
result:=result.defowner.owner;
end;
procedure tabstractrecordsymtable.do_get_managementoperator_offset_list(data:tobject;arg:pointer);
var
sym : tsym absolute data;

7
compiler/symtype.pas
View File

@ -97,7 +97,7 @@ interface
procedure ChangeOwner(st:TSymtable);
function getreusablesymtab: tsymtable;
procedure register_created_object_type;virtual;
function get_top_level_symtable: tsymtable;
function get_top_level_symtable(skipprocdefs: boolean): tsymtable;
{ only valid for registered defs and defs for which a unique id string
has been requested; otherwise, first call register_def }
function deflist_index: longint;
@ -442,11 +442,12 @@ implementation
end;
function tdef.get_top_level_symtable: tsymtable;
function tdef.get_top_level_symtable(skipprocdefs: boolean): tsymtable;
begin
result:=owner;
while assigned(result) and
assigned(result.defowner) do
assigned(result.defowner) and
(skipprocdefs or (result.symtabletype in [ObjectSymtable,recordsymtable])) do
result:=tdef(result.defowner).owner;
end;