* 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

@@ -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

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 }
+        { we can only write the start/end if this procedure is implemented in
-        current_asmdata.getlabel(procendlabel,alt_dbgtype);
+          this module
-        current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai);
+        }
+        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
+            if (target_info.system = system_powerpc64_linux) then
-          procentry := '.' + def.mangledname
+              procentry := '.' + def.mangledname
-        else
+            else
-          procentry := def.mangledname;
+              procentry := def.mangledname;
 
-        append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
+            append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry));
-        append_labelentry(DW_AT_high_pc,procendlabel);
+            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);
+                    { Happens when writing debug info for paras of procdefs not
-                    templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg));
+                      implemented in the current module. Can't add a general check
-                    templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset));
+                      for LOC_INVALID above, because staticvarsyms may also have it.
-                    blocksize:=1+Lengthsleb128(sym.localloc.reference.offset);
+                    }
+                    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,

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.
+