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

* fixed mantis #14729:

Browse Source 
o add accessibility info for fields and methods (public/protected/private)
    o write method type info for methods not implemented in the current module
      (for tf_dwarf_only_local_labels systems)

git-svn-id: trunk@13833 -
This commit is contained in:
Jonas Maebe 2009-10-10 10:53:18 +00:00
parent b8a83fd997
commit dce9b3849b
3 changed files with 130 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9319,6 +9319,7 @@ tests/webtbs/tw14553.pp svneol=native#text/pascal
tests/webtbs/tw14617.pp svneol=native#text/plain
tests/webtbs/tw1470.pp svneol=native#text/plain
tests/webtbs/tw1472.pp svneol=native#text/plain
tests/webtbs/tw14729.pp svneol=native#text/plain
tests/webtbs/tw14740.pp svneol=native#text/plain
tests/webtbs/tw14743.pp svneol=native#text/pascal
tests/webtbs/tw1477.pp svneol=native#text/plain

104
compiler/dbgdwarf.pas
View File

@ -42,7 +42,7 @@ interface
uses
cclasses,globtype,
aasmbase,aasmtai,aasmdata,
symbase,symtype,symdef,symsym,
symconst,symbase,symtype,symdef,symsym,
finput,
DbgBase;
@ -287,6 +287,7 @@ interface
procedure appendsym_property(list:TAsmList;sym:tpropertysym);override;
function symname(sym:tsym): String; virtual;
procedure append_visibility(vis: tvisibility);
procedure enum_membersyms_callback(p:TObject;arg:pointer);
@ -346,7 +347,7 @@ implementation
version,globals,verbose,systems,
cpubase,cgbase,paramgr,
fmodule,
defutil,symconst,symtable,ppu
defutil,symtable,ppu
;
const
@ -1701,7 +1702,11 @@ implementation
i : longint;
vmtindexnr : pint;
begin
if not assigned(def.procstarttai) then
{ only write debug info for procedures defined in the current module,
except in case of methods (gcc-compatible)
}
if not assigned(def.procstarttai) and
(def.owner.symtabletype<>objectsymtable) then
exit;
{ Procdefs are not handled by the regular def writing code, so
@ -1763,21 +1768,31 @@ implementation
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtindexnr));
end;
{ accessibility: public/private/protected }
if (def.owner.symtabletype=objectsymtable) then
append_visibility(def.visibility);
{ Return type. }
if not(is_void(tprocdef(def).returndef)) then
append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef));
{ mark end of procedure }
current_asmdata.getlabel(procendlabel,alt_dbgtype);
current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
{ we can only write the start/end if this procedure is implemented in
this module
}
if assigned(def.procstarttai) then
begin
{ mark end of procedure }
current_asmdata.getlabel(procendlabel,alt_dbgtype);
current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
if (target_info.system = system_powerpc64_linux) then
procentry := '.' + def.mangledname
else
procentry := def.mangledname;
if (target_info.system = system_powerpc64_linux) then
procentry := '.' + def.mangledname
else
procentry := def.mangledname;
append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
append_labelentry(DW_AT_high_pc,procendlabel);
append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
append_labelentry(DW_AT_high_pc,procendlabel);
end;
{ Don't write the funcretsym explicitly, it's also in the
localsymtable and/or parasymtable.
@ -1804,14 +1819,17 @@ implementation
end;
{ local type defs and vars should not be written
inside the main proc }
if assigned(def.localst) and
if assigned(def.procstarttai)
and assigned(def.localst) and
(def.localst.symtabletype=localsymtable) then
write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst);
{ last write the types from this procdef }
if assigned(def.parast) then
write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast);
if assigned(def.localst) and
{ only try to write the localst if the routine is implemented here }
if assigned(def.procstarttai) and
assigned(def.localst) and
(def.localst.symtabletype=localsymtable) then
begin
write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst);
@ -1966,10 +1984,17 @@ implementation
paravarsym,
localvarsym:
begin
dreg:=dwarf_reg(sym.localloc.reference.base);
templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
{ Happens when writing debug info for paras of procdefs not
implemented in the current module. Can't add a general check
for LOC_INVALID above, because staticvarsyms may also have it.
}
if sym.localloc.loc<> LOC_INVALID then
begin
dreg:=dwarf_reg(sym.localloc.reference.base);
templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
end;
end
else
internalerror(200601288);
@ -1988,7 +2013,23 @@ implementation
else
tag:=DW_TAG_variable;
if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
{ must be parasym of externally implemented procdef, but
the parasymtable can con also contain e.g. absolutevarsyms
-> check symtabletype}
if (sym.owner.symtabletype=parasymtable) and
(sym.localloc.loc=LOC_INVALID) then
begin
if (sym.owner.symtabletype<>parasymtable) then
internalerror(2009101001);
append_entry(tag,false,[
DW_AT_name,DW_FORM_string,name+#0
{
DW_AT_decl_file,DW_FORM_data1,0,
DW_AT_decl_line,DW_FORM_data1,
}
])
end
else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,
LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and
((sym.owner.symtabletype = globalsymtable) or
(sp_static in sym.symoptions) or
@ -2134,6 +2175,8 @@ implementation
end;
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
if (sym.owner.symtabletype=objectsymtable) then
append_visibility(sym.visibility);
append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
finish_entry;
@ -2142,6 +2185,14 @@ implementation
procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym);
begin
{ These are default values of parameters. These should be encoded
via DW_AT_default_value, not as a separate sym. Moreover, their
type is not available when writing the debug info for external
procedures.
}
if (sym.owner.symtabletype=parasymtable) then
exit;
append_entry(DW_TAG_constant,false,[
DW_AT_name,DW_FORM_string,symname(sym)+#0
]);
@ -2719,6 +2770,21 @@ implementation
end;
procedure tdebuginfodwarf.append_visibility(vis: tvisibility);
begin
case vis of
vis_private,
vis_strictprivate:
append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]);
vis_protected,
vis_strictprotected:
append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]);
vis_public:
{ default };
end;
end;
procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList);
var
currfileinfo,

44
tests/webtbs/tw14729.pp Normal file
View File

@ -0,0 +1,44 @@
{ %opt=-gw}
{ %interactive }
{$mode objfpc}
{
1) check that all fields/procedures are shown in the correct visibility section
when doing "ptype TC"
2) check that "ptype TOBJECT" shows TOBJECT's methods even if the system
unit is not compiled with debuginfo
}
type
tc = class
private
f: longint;
procedure priv(a: longint);
protected
d: byte;
procedure prot; virtual;
public
c: longint;
procedure pub;
end;
procedure tc.priv(a: longint);
begin
end;
procedure tc.prot;
begin
end;
procedure tc.pub;
begin
end;
procedure myproc(a,b,c: longint);
begin
end;
begin
end.