Re: [PATCH] Fix ptype and print commands for namelist variables(a fortran feature)

[Andrew Burgess <aburgess@redhat.com>]

* Kumar N, Bhuvanendra via Gdb-patches <gdb-patches@sourceware.org> [2022-02-07 14:41:09 +0000]:

> [AMD Official Use Only]
> 
> Hi Andrew,
> 
> Thanks for the revised patch and suggestions, I looked at your code changes (rearranging the code in f-valprint.c), the changes looks fine and also unit and regression tested the changes. Also tested with -D_GLIBCXX_DEBUG=1, even though we are not calling value_field() for namelist now.
> 
> Please let me know how to proceed further, thanks again

Thanks, I pushed this patch.

Andrew



> 
> Regards,
> bhuvan
> 
> -----Original Message-----
> From: Andrew Burgess <aburgess@redhat.com> 
> Sent: Friday, February 4, 2022 12:14 AM
> To: Kumar N, Bhuvanendra <Bhuvanendra.KumarN@amd.com>
> Cc: Joel Brobecker <brobecker@adacore.com>; George, Jini Susan <JiniSusan.George@amd.com>; Achra, Nitika <Nitika.Achra@amd.com>; Sharma, Alok Kumar <AlokKumar.Sharma@amd.com>; gdb-patches@sourceware.org; E, Nagajyothi <Nagajyothi.E@amd.com>
> Subject: Re: [PATCH] Fix ptype and print commands for namelist variables(a fortran feature)
> 
> [CAUTION: External Email]
> 
> * Kumar N, Bhuvanendra via Gdb-patches <gdb-patches@sourceware.org> [2022-01-20 16:20:46 +0000]:
> 
> > [AMD Official Use Only]
> >
> > Hi all,
> >
> > Sorry for the delay in sharing the revised patch, I was occupied with some other work. Please find the revised patch with all the details and also patch is inlined below.
> >
> > Reason for the assert failure when GDB is built with
> > -D_GLIBCXX_DEBUG=1 is, the size or length(TYPE_LENGTH) of the namelist 
> > variable type was not populated, it was zero, hence assert was failing 
> > in gdbsupport/array-view.h. Now this is fixed and I could test with 
> > -D_GLIBCXX_DEBUG=1
> >
> > Compiler is not emitting the size of the namelist variable type, hence 
> > GDB is calculating it. In similar types like DW_TAG_structure_type, 
> > DW_AT_byte_size attribute is emitted by compiler and GDB uses it with 
> > TYPE_LENGTH. It's not the case with DW_TAG_namelist. Hence size of the 
> > namelist variable type is calculated in GDB. Also unlike 
> > DW_TAG_structure_type, namelist items are not allocated in continuous 
> > memory, they are spread across, hence for each namelist item symbol 
> > table lookup is done before printing its value. This way making sure 
> > namelist items printing is intact.
> 
> Hi Bhuvan,
> 
> Thanks for continuing to work on this feature, and sorry for the slow turn around on reviews.
> 
> I took a look at the changes you made in the latest version, and I wasn't completely convinced.  Setting the type length seems like a bad idea, given that these namelists don't have a valid address, and don't actually live in memory in a contiguous block.  I assume this is why you ended up adding the change in value.c too.
> 
> I think if we just reorder the code in f-valprint.c a little, then we can avoid the need to compute the type length.  Could you test the patch below please, and let me know if you see any problems.
> 
> This is basically your work with some whitespace clean up in dwarf2/read.c, the value.c change reverted, and f-valprint.c reworked a little.  Oh, and I updated the copyright year in the testsuite files.
> 
> Let me know what you think.
> 
> Thanks,
> Andrew
> 
> ---
> 
> commit 3b365631ef31051210b7ad26463aaccd3501cbfd
> Author: Bhuvanendra Kumar N <Bhuvanendra.KumarN@amd.com>
> Date:   Wed Feb 2 17:52:27 2022 +0000
> 
>     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 1a749eac334..056ba97ee91 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:
> -         SYMBOL_ACLASS_INDEX (sym) = LOC_TYPEDEF;
> -         SYMBOL_DOMAIN (sym) = STRUCT_DOMAIN;
> -
> +       case DW_TAG_namelist:
> +         if (die->tag == DW_TAG_namelist)
> +           {
> +             SYMBOL_ACLASS_INDEX (sym) = LOC_STATIC;
> +             SYMBOL_DOMAIN (sym) = VAR_DOMAIN;
> +           }
> +         else
> +           {
> +             SYMBOL_ACLASS_INDEX (sym) = LOC_TYPEDEF;
> +             SYMBOL_DOMAIN (sym) = 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 6fd3d519c86..3b26bf74b61 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 3d13eb11fb0..10dfcaf7c41 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 7238873e4db..5072dc24bfa 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 00000000000..d6263e12fec
> --- /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 <https://nam11.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.gnu.org%2Flicenses%2F&amp;data=04%7C01%7Cbhuvanendra.kumarn%40amd.com%7C61b9987b80a841d7bf8e08d9e745279b%7C3dd8961fe4884e608e11a82d994e183d%7C0%7C0%7C637795106480474874%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&amp;sdata=U2mggF3i%2BjaettHJ9HjvyEFyj5%2B334T0VE56jqmS6oc%3D&amp;reserved=0>.
> +
> +# 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 00000000000..9e2ba0489d2
> --- /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 <https://nam11.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.gnu.org%2Flicenses%2F&amp;data=04%7C01%7Cbhuvanendra.kumarn%40amd.com%7C61b9987b80a841d7bf8e08d9e745279b%7C3dd8961fe4884e608e11a82d994e183d%7C0%7C0%7C637795106480474874%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&amp;sdata=U2mggF3i%2BjaettHJ9HjvyEFyj5%2B334T0VE56jqmS6oc%3D&amp;reserved=0>.
> +!
> +! 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 4214c80907a..530c6f849f9 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)