From dce9b3849b4de3b705f907b6e61fe152950f4f98 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 10 Oct 2009 10:53:18 +0000 Subject: [PATCH] * fixed mantis #14729: 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 - --- .gitattributes | 1 + compiler/dbgdwarf.pas | 104 ++++++++++++++++++++++++++++++++-------- tests/webtbs/tw14729.pp | 44 +++++++++++++++++ 3 files changed, 130 insertions(+), 19 deletions(-) create mode 100644 tests/webtbs/tw14729.pp diff --git a/.gitattributes b/.gitattributes index d03f5bde3b..6b34685046 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 1d29d8ea69..d8e862b255 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -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, diff --git a/tests/webtbs/tw14729.pp b/tests/webtbs/tw14729.pp new file mode 100644 index 0000000000..a5d990ea63 --- /dev/null +++ b/tests/webtbs/tw14729.pp @@ -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. +