Explorar o código

* made TDebugInfoDwarf3 inherit from TDebugInfoDwarf2 instead of from
TDebugInfoDwarf, so DWARFv2 and DWARFv3 generators can share protected
methods.
* fixed the debug info for sets whose language-level lower bound is not
equal to the actual set base used when storing the data (e.g., a "set
of 1..5" is actually stored as a "set of 0..7" or "set of 0..31")
(mantis #13984)
+ interactive test for the above

git-svn-id: trunk@13302 -

Jonas Maebe %!s(int64=16) %!d(string=hai) anos
pai
achega
80864ebf31
Modificáronse 4 ficheiros con 105 adicións e 39 borrados
  1. 1 0
      .gitattributes
  2. 27 30
      compiler/dbgdwarf.pas
  3. 46 9
      compiler/dbgstabs.pas
  4. 31 0
      tests/webtbs/tw13984.pp

+ 1 - 0
.gitattributes

@@ -9162,6 +9162,7 @@ tests/webtbs/tw13872.pp svneol=native#text/plain
 tests/webtbs/tw13890.pp svneol=native#text/plain
 tests/webtbs/tw13948.pp svneol=native#text/plain
 tests/webtbs/tw1398.pp svneol=native#text/plain
+tests/webtbs/tw13984.pp svneol=native#text/plain
 tests/webtbs/tw13992a.pp svneol=native#text/plain
 tests/webtbs/tw1401.pp svneol=native#text/plain
 tests/webtbs/tw1407.pp svneol=native#text/plain

+ 27 - 30
compiler/dbgdwarf.pas

@@ -308,6 +308,8 @@ interface
       TDebugInfoDwarf2 = class(TDebugInfoDwarf)
       private
       protected
+        procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean);
+
         procedure appenddef_file(list:TAsmList;def:tfiledef); override;
         procedure appenddef_formal(list:TAsmList;def:tformaldef); override;
         procedure appenddef_object(list:TAsmList;def:tobjectdef); override;
@@ -320,7 +322,7 @@ interface
 
       { TDebugInfoDwarf3 }
 
-      TDebugInfoDwarf3 = class(TDebugInfoDwarf)
+      TDebugInfoDwarf3 = class(TDebugInfoDwarf2)
       private
       protected
         procedure appenddef_array(list:TAsmList;def:tarraydef); override;
@@ -3026,11 +3028,12 @@ implementation
         end;
       end;
 
-    procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
+    procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean);
       var
         lab: tasmlabel;
       begin
-        if (ds_dwarf_sets in current_settings.debugswitches) then
+        if force_tag_set or
+           (ds_dwarf_sets in current_settings.debugswitches) then
           begin
             { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types }
 
@@ -3045,21 +3048,21 @@ implementation
                 ]);
             if assigned(def.elementdef) then
               begin
-                if (def.elementdef.typ=enumdef) then
-                  begin
-                    { gdb 6.7 - 6.8 is broken for regular enum sets }
-                    if not(tf_dwarf_only_local_labels in target_info.flags) then
-                      current_asmdata.getdatalabel(lab)
-                    else
-                      current_asmdata.getaddrlabel(lab);
-                    append_labelentry_ref(DW_AT_type,lab);
-                    finish_entry;
-                    current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
-                    append_entry(DW_TAG_subrange_type,false,[
-                      DW_AT_lower_bound,DW_FORM_sdata,tenumdef(def.elementdef).minval,
-                      DW_AT_upper_bound,DW_FORM_sdata,tenumdef(def.elementdef).maxval
-                      ]);
-                  end;
+                if not(tf_dwarf_only_local_labels in target_info.flags) then
+                  current_asmdata.getdatalabel(lab)
+                else
+                  current_asmdata.getaddrlabel(lab);
+                append_labelentry_ref(DW_AT_type,lab);
+                finish_entry;
+                current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0));
+                { Sets of e.g. [1..5] are actually stored as a set of [0..7],
+                  so write the exact boundaries of the set here. Let's hope no
+                  debugger ever rejects this because this "subrange" type can
+                  actually have a larger range than the original one.  }
+                append_entry(DW_TAG_subrange_type,false,[
+                  DW_AT_lower_bound,DW_FORM_sdata,def.setbase,
+                  DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue
+                  ]);
                 append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef))
               end
           end
@@ -3082,6 +3085,11 @@ implementation
         finish_entry;
       end;
 
+    procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef);
+      begin
+        appenddef_set_intern(list,def,false);
+      end;
+
     procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef);
       begin
         { gdb 6.4 doesn't support DW_TAG_unspecified_type so we
@@ -3401,18 +3409,7 @@ implementation
 
     procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef);
       begin
-        if assigned(def.typesym) then
-          append_entry(DW_TAG_set_type,false,[
-            DW_AT_name,DW_FORM_string,symname(def.typesym)+#0,
-            DW_AT_byte_size,DW_FORM_data2,def.size
-            ])
-        else
-          append_entry(DW_TAG_set_type,false,[
-            DW_AT_byte_size,DW_FORM_data2,def.size
-            ]);
-        if assigned(tsetdef(def).elementdef) then
-          append_labelentry_ref(DW_AT_type,def_dwarf_lab(tsetdef(def).elementdef));
-        finish_entry;
+        appenddef_set_intern(list,def,true);
       end;
 
     procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef);

+ 46 - 9
compiler/dbgstabs.pas

@@ -73,6 +73,7 @@ interface
         procedure field_add_stabstr(p:TObject;arg:pointer);
         procedure method_add_stabstr(p:TObject;arg:pointer);
         procedure field_write_defs(p:TObject;arg:pointer);
+        function  get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
       protected
         procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
         procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override;
@@ -561,25 +562,36 @@ implementation
       end;
 
 
-    procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
+    function TDebugInfoStabs.get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring;
       var
-        st : ansistring;
-        p  : Tenumsym;
+        i: longint;
+        p: tenumsym;
       begin
         { we can specify the size with @s<size>; prefix PM }
         if def.size <> std_param_align then
-          st:='@s'+tostr(def.size*8)+';e'
+          result:='@s'+tostr(def.size*8)+';e'
         else
-          st:='e';
+          result:='e';
         p := tenumsym(def.firstenum);
+        { the if-test is required because pred(def.minval) might overflow;
+          the longint() typecast should be safe because stabs is not
+          supported for 64 bit targets }
+        if (def.minval<>lowerbound) then
+          for i:=lowerbound to pred(longint(def.minval)) do
+            result:=result+'<invalid>:'+tostr(i)+',';
+
         while assigned(p) do
           begin
-            st:=st+GetSymName(p)+':'+tostr(p.value)+',';
+            result:=result+GetSymName(p)+':'+tostr(p.value)+',';
             p:=p.nextenum;
           end;
         { the final ',' is required to have a valid stabs }
-        st:=st+';';
-        write_def_stabstr(list,def,st);
+        result:=result+';';
+      end;
+
+    procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef);
+      begin
+        write_def_stabstr(list,def,get_enum_defstr(def,def.minval));
       end;
 
 
@@ -787,9 +799,34 @@ implementation
 
     procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef);
       var
+        st,
         ss : ansistring;
+        p: pchar;
+        elementdefstabnr: string;
       begin
-        ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementdef)]);
+        { ugly hack: create a temporary subrange type if the lower bound of
+          the set's element type is not a multiple of 8 (because we store them
+          as if the lower bound is a multiple of 8) }
+        if (def.setbase<>get_min_value(def.elementdef)) then
+          begin
+            { allocate a def number }
+            inc(global_stab_number);
+            elementdefstabnr:=tostr(global_stab_number);
+            { anonymous subrange def }
+            st:='":t'+elementdefstabnr+'=';
+            if (def.elementdef.typ = enumdef) then
+              st:=st+get_enum_defstr(tenumdef(def.elementdef),def.setbase)
+            else
+              st:=st+def_stabstr_evaluate(def.elementdef,'r'+elementdefstabnr+';$1;$2;',[tostr(longint(def.setbase)),tostr(longint(get_max_value(def.elementdef).svalue))]);
+            st:=st+'",'+tostr(N_LSYM)+',0,0,0';
+            { add to list }
+            getmem(p,length(st)+1);
+            move(pchar(st)^,p^,length(st)+1);
+            list.concat(Tai_stab.create(stab_stabs,p));
+          end
+        else
+          elementdefstabnr:=def_stab_number(def.elementdef);
+        ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),elementdefstabnr]);
         write_def_stabstr(list,def,ss);
       end;
 

+ 31 - 0
tests/webtbs/tw13984.pp

@@ -0,0 +1,31 @@
+{ %interactive }
+
+{ check that the contents of xyc and yxd are printed
+  correctly by gdb at the end of the program, resp.
+  [1..2, 9] and [1..3, 9]
+}
+
+program test;
+{$R+}
+{$coperators on}
+const
+  empty = [];
+
+type
+  menum = (mea = 1, meb, mec);
+
+var
+  xyc : set of 1..9;
+  yxd : set of 0..9;
+  mset: set of menum;
+begin
+  xyc := empty;
+  xyc += [1];
+  xyc += [2];
+  xyc += [9];
+  yxd := [1,2,3];
+  yxd := yxd + [9];
+
+  mset:=[meb];
+  include(mset,mec);
+end.