gdb/fortran: support ptype and print commands for namelist variables

Gfortran supports namelists (a Fortran feature); it emits
DW_TAG_namelist and DW_TAG_namelist_item dies. But gdb does not
process these dies and does not support 'print' or 'ptype' commands on
namelist variables.

An attempt to print namelist variables results in gdb bailing out with
the error message as shown below.

  (gdb) print nml
  No symbol "nml" in current context.

This commit is to make the print and ptype commands work for namelist
variables and its items. Sample output of these commands is shared
below, with fixed gdb.

  (gdb) ptype nml
  type = Type nml
      integer(kind=4) :: a
      integer(kind=4) :: b
  End Type nml
  (gdb) print nml
  $1 = ( a = 10, b = 20 )

diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c
index c063e7baa2b5cf75411b41ffaebd673cefa90890..10550336063f51545063885281dd587a8e1774f0 100644 (file)
--- a/gdb/dwarf2/read.c
+++ b/gdb/dwarf2/read.c
@@ -9694,6 +9694,7 @@ process_die (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_interface_type:
     case DW_TAG_structure_type:
     case DW_TAG_union_type:
+    case DW_TAG_namelist:
       process_structure_scope (die, cu);
       break;
     case DW_TAG_enumeration_type:
@@ -14556,8 +14557,21 @@ dwarf2_add_field (struct field_info *fip, struct die_info *die,
 
   fp = &new_field->field;
 
-  if (die->tag == DW_TAG_member && ! die_is_declaration (die, cu))
-    {
+  if ((die->tag == DW_TAG_member || die->tag == DW_TAG_namelist_item)
+      && !die_is_declaration (die, cu))
+    {
+      if (die->tag == DW_TAG_namelist_item)
+        {
+         /* Typically, DW_TAG_namelist_item are references to namelist items.
+            If so, follow that reference.  */
+         struct attribute *attr1 = dwarf2_attr (die, DW_AT_namelist_item, cu);
+         struct die_info *item_die = nullptr;
+         struct dwarf2_cu *item_cu = cu;
+          if (attr1->form_is_ref ())
+           item_die = follow_die_ref (die, attr1, &item_cu);
+         if (item_die != nullptr)
+           die = item_die;
+        }
       /* Data member other than a C++ static data member.  */
 
       /* Get type of field.  */
@@ -15615,6 +15629,10 @@ read_structure_type (struct die_info *die, struct dwarf2_cu *cu)
     {
       type->set_code (TYPE_CODE_UNION);
     }
+  else if (die->tag == DW_TAG_namelist)
+    {
+      type->set_code (TYPE_CODE_NAMELIST);
+    }
   else
     {
       type->set_code (TYPE_CODE_STRUCT);
@@ -15817,7 +15835,8 @@ handle_struct_member_die (struct die_info *child_die, struct type *type,
                          struct dwarf2_cu *cu)
 {
   if (child_die->tag == DW_TAG_member
-      || child_die->tag == DW_TAG_variable)
+      || child_die->tag == DW_TAG_variable
+      || child_die->tag == DW_TAG_namelist_item)
     {
       /* NOTE: carlton/2002-11-05: A C++ static data member
         should be a DW_TAG_member that is a declaration, but
@@ -15860,8 +15879,10 @@ handle_struct_member_die (struct die_info *child_die, struct type *type,
     handle_variant (child_die, type, fi, template_args, cu);
 }
 
-/* Finish creating a structure or union type, including filling in
-   its members and creating a symbol for it.  */
+/* Finish creating a structure or union type, including filling in its
+   members and creating a symbol for it. This function also handles Fortran
+   namelist variables, their items or members and creating a symbol for
+   them.  */
 
 static void
 process_structure_scope (struct die_info *die, struct dwarf2_cu *cu)
@@ -21963,9 +21984,17 @@ new_symbol (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
        case DW_TAG_union_type:
        case DW_TAG_set_type:
        case DW_TAG_enumeration_type:
-         sym->set_aclass_index (LOC_TYPEDEF);
-         sym->set_domain (STRUCT_DOMAIN);
-
+       case DW_TAG_namelist:
+         if (die->tag == DW_TAG_namelist)
+           {
+             sym->set_aclass_index (LOC_STATIC);
+             sym->set_domain (VAR_DOMAIN);
+           }
+         else
+           {
+             sym->set_aclass_index (LOC_TYPEDEF);
+             sym->set_domain (STRUCT_DOMAIN);
+           }
          {
            /* NOTE: carlton/2003-11-10: C++ class symbols shouldn't
               really ever be static objects: otherwise, if you try
@@ -22902,6 +22931,7 @@ dwarf2_name (struct die_info *die, struct dwarf2_cu *cu)
       && die->tag != DW_TAG_class_type
       && die->tag != DW_TAG_interface_type
       && die->tag != DW_TAG_structure_type
+      && die->tag != DW_TAG_namelist
       && die->tag != DW_TAG_union_type)
     return NULL;
 
@@ -22926,6 +22956,7 @@ dwarf2_name (struct die_info *die, struct dwarf2_cu *cu)
     case DW_TAG_interface_type:
     case DW_TAG_structure_type:
     case DW_TAG_union_type:
+    case DW_TAG_namelist:
       /* Some GCC versions emit spurious DW_AT_name attributes for unnamed
         structures or unions.  These were of the form "._%d" in GCC 4.1,
         or simply "<anonymous struct>" or "<anonymous union>" in GCC 4.3

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 6fd3d519c86b5541686af4d04483e43e8fd06d3f..3b26bf74b612e709d03ff44fd6c4f13c8d504f07 100644 (file)
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -121,6 +121,7 @@ f_language::f_type_print_varspec_prefix (struct type *type,
     case TYPE_CODE_UNDEF:
     case TYPE_CODE_STRUCT:
     case TYPE_CODE_UNION:
+    case TYPE_CODE_NAMELIST:
     case TYPE_CODE_ENUM:
     case TYPE_CODE_INT:
     case TYPE_CODE_FLT:
@@ -261,6 +262,7 @@ f_language::f_type_print_varspec_suffix (struct type *type,
     case TYPE_CODE_UNDEF:
     case TYPE_CODE_STRUCT:
     case TYPE_CODE_UNION:
+    case TYPE_CODE_NAMELIST:
     case TYPE_CODE_ENUM:
     case TYPE_CODE_INT:
     case TYPE_CODE_FLT:
@@ -305,7 +307,8 @@ f_language::f_type_print_base (struct type *type, struct ui_file *stream,
       const char *prefix = "";
       if (type->code () == TYPE_CODE_UNION)
        prefix = "Type, C_Union :: ";
-      else if (type->code () == TYPE_CODE_STRUCT)
+      else if (type->code () == TYPE_CODE_STRUCT
+               || type->code () == TYPE_CODE_NAMELIST)
        prefix = "Type ";
       fprintf_filtered (stream, "%*s%s%s", level, "", prefix, type->name ());
       return;
@@ -391,6 +394,7 @@ f_language::f_type_print_base (struct type *type, struct ui_file *stream,
 
     case TYPE_CODE_STRUCT:
     case TYPE_CODE_UNION:
+    case TYPE_CODE_NAMELIST:
       if (type->code () == TYPE_CODE_UNION)
        fprintf_filtered (stream, "%*sType, C_Union :: ", level, "");
       else

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index e8d8627bfca4a739ed1a61354be61825a2e6cbd2..6a199f17c1e1bcf09fab58da92f607d74d254ee3 100644 (file)
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -512,24 +512,38 @@ f_language::value_print_inner (struct value *val, struct ui_file *stream,
 
     case TYPE_CODE_STRUCT:
     case TYPE_CODE_UNION:
+    case TYPE_CODE_NAMELIST:
       /* Starting from the Fortran 90 standard, Fortran supports derived
         types.  */
       fprintf_filtered (stream, "( ");
       for (index = 0; index < type->num_fields (); index++)
        {
-         struct value *field = value_field (val, index);
-
-         struct type *field_type = check_typedef (type->field (index).type ());
-
+         struct type *field_type
+           = check_typedef (type->field (index).type ());
 
          if (field_type->code () != TYPE_CODE_FUNC)
            {
-             const char *field_name;
+             const char *field_name = type->field (index).name ();
+             struct value *field;
+
+             if (type->code () == TYPE_CODE_NAMELIST)
+               {
+                 /* While printing namelist items, fetch the appropriate
+                    value field before printing its value.  */
+                 struct block_symbol sym
+                   = lookup_symbol (field_name, get_selected_block (nullptr),
+                                    VAR_DOMAIN, nullptr);
+                 if (sym.symbol == nullptr)
+                   error (_("failed to find symbol for name list component %s"),
+                          field_name);
+                 field = value_of_variable (sym.symbol, sym.block);
+               }
+             else
+               field = value_field (val, index);
 
              if (printed_field > 0)
                fputs_filtered (", ", stream);
 
-             field_name = type->field (index).name ();
              if (field_name != NULL)
                {
                  fputs_styled (field_name, variable_name_style.style (),

diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 7238873e4db1286f811c341c3e4ed912015b4044..5072dc24bfabac2ab8ce48a254401dd2074f052c 100644 (file)
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -196,6 +196,19 @@ enum type_code
 
     /* * Fixed Point type.  */
     TYPE_CODE_FIXED_POINT,
+
+    /* * Fortran namelist is a group of variables or arrays that can be
+       read or written.
+
+       Namelist syntax: NAMELIST / groupname / namelist_items ...
+       NAMELIST statement assign a group name to a collection of variables
+       called as namelist items. The namelist items can be of any data type
+       and can be variables or arrays.
+
+       Compiler emit DW_TAG_namelist for group name and DW_TAG_namelist_item
+       for each of the namelist items. GDB process these namelist dies
+       and print namelist variables during print and ptype commands.  */
+    TYPE_CODE_NAMELIST,
   };
 
 /* * Some bits for the type's instance_flags word.  See the macros

diff --git a/gdb/testsuite/gdb.fortran/namelist.exp b/gdb/testsuite/gdb.fortran/namelist.exp
new file mode 100644 (file)
index 0000000..d6263e1
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/namelist.exp
@@ -0,0 +1,50 @@
+# Copyright (C) 2021-2022 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the gdb testsuite.  It contains tests for fortran
+# namelist.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+load_lib "fortran.exp"
+
+if {[prepare_for_testing "failed to prepare" $testfile $srcfile {debug f90}]} {
+    return -1
+}
+
+if ![fortran_runto_main] then {
+    perror "couldn't run to main"
+    continue
+}
+
+# Depending on the compiler being used, the type names can be printed
+# differently.
+set int [fortran_int4]
+
+gdb_breakpoint [gdb_get_line_number "Display namelist"]
+gdb_continue_to_breakpoint "Display namelist"
+
+if {[test_compiler_info {gcc-*}]} {
+    gdb_test "ptype nml" \
+        "type = Type nml\r\n *$int :: a\r\n *$int :: b\r\n *End Type nml"
+    gdb_test "print nml" \
+        "\\$\[0-9\]+ = \\( a = 10, b = 20 \\)"
+} else {
+    gdb_test "ptype nml" \
+        "No symbol \"nml\" in current context\\."
+    gdb_test "print nml" \
+        "No symbol \"nml\" in current context\\."
+}

diff --git a/gdb/testsuite/gdb.fortran/namelist.f90 b/gdb/testsuite/gdb.fortran/namelist.f90
new file mode 100644 (file)
index 0000000..9e2ba04
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/namelist.f90
@@ -0,0 +1,27 @@
+! Copyright (C) 2021-2022 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+!
+! This file is the Fortran source file for namelist.exp.
+
+program main
+
+  integer :: a, b
+  namelist /nml/ a, b
+
+  a = 10
+  b = 20
+  Write(*,nml) ! Display namelist
+
+end program main

diff --git a/include/dwarf2.def b/include/dwarf2.def
index 4214c80907a09ca32342870f0127d49c6a811bd9..530c6f849f984acc2d619c5dbe6447e1734895d7 100644 (file)
--- a/include/dwarf2.def
+++ b/include/dwarf2.def
@@ -289,7 +289,7 @@ DW_AT (DW_AT_frame_base, 0x40)
 DW_AT (DW_AT_friend, 0x41)
 DW_AT (DW_AT_identifier_case, 0x42)
 DW_AT (DW_AT_macro_info, 0x43)
-DW_AT (DW_AT_namelist_items, 0x44)
+DW_AT (DW_AT_namelist_item, 0x44)
 DW_AT (DW_AT_priority, 0x45)
 DW_AT (DW_AT_segment, 0x46)
 DW_AT (DW_AT_specification, 0x47)