diff options
| -rw-r--r-- | gdb/dwarf2/read.c | 47 | ||||
| -rw-r--r-- | gdb/f-typeprint.c | 6 | ||||
| -rw-r--r-- | gdb/f-valprint.c | 26 | ||||
| -rw-r--r-- | gdb/gdbtypes.h | 13 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/namelist.exp | 50 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/namelist.f90 | 27 | ||||
| -rw-r--r-- | include/dwarf2.def | 2 |
7 files changed, 155 insertions, 16 deletions
diff --git a/gdb/dwarf2/read.c b/gdb/dwarf2/read.c index c063e7b..1055033 100644 --- 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 6fd3d51..3b26bf7 100644 --- 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 e8d8627..6a199f1 100644 --- 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 7238873..5072dc2 100644 --- 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 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 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 4214c80..530c6f8 100644 --- 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) |