[PATCH v1] Improve user experience in printing Fortran derived types.

Luis Machado lgustavo@codesourcery.com
Thu Mar 17 14:15:00 GMT 2016


On 03/09/2016 11:28 AM, Walfred Tedeschi wrote:
> Output for Fortran derived classes is like:
>
>    "( 9, 'abc')"
>
> with this changes the output is changed to:
>
>    "( lucky_number = 9, letters = 'abc')"
>
>
> 2016-03-08  Walfred Tedeschi  <walfred.tedeschi@intel.com>
>
> 	* f-valprint.c (f_val_print): Add field names for printing
> 	derived types fields.
>
> gdb/testsuite:
>
> 	* gdb.fortran/derived-type.exp (print q): Add fields to the output.
>
> ---
>   gdb/f-valprint.c                           | 32 +++++++++++++++++++++---------
>   gdb/testsuite/gdb.fortran/derived-type.exp |  6 +++---
>   2 files changed, 26 insertions(+), 12 deletions(-)
>
> diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
> index 1438fc6..1e4ef66 100644
> --- a/gdb/f-valprint.c
> +++ b/gdb/f-valprint.c
> @@ -260,6 +260,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
>     struct gdbarch *gdbarch = get_type_arch (type);
>     enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
>     unsigned int i = 0;	/* Number of characters printed.  */
> +  int printed_field = 0; /* Number of fields printed.  */
>     struct type *elttype;
>     CORE_ADDR addr;
>     int index;
> @@ -375,15 +376,28 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
>         fprintf_filtered (stream, "( ");
>         for (index = 0; index < TYPE_NFIELDS (type); index++)
>           {
> -          int offset = TYPE_FIELD_BITPOS (type, index) / 8;
> -
> -          val_print (TYPE_FIELD_TYPE (type, index), valaddr,
> -		     embedded_offset + offset,
> -		     address, stream, recurse + 1,
> -		     original_value, options, current_language);
> -          if (index != TYPE_NFIELDS (type) - 1)
> -            fputs_filtered (", ", stream);
> -        }
> +	  struct value *field = value_field
> +	    ((struct value *)original_value, index);
> +	  struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, index));
> +
> +
> +	  if (TYPE_CODE (field_type) != TYPE_CODE_FUNC)
> +	    {
> +	      if (printed_field > 0)
> +		fputs_filtered (", ", stream);
> +
> +	      fputs_filtered (TYPE_FIELD_NAME (type, index), stream);

Would there be a case where name is not available?

> +	      fputs_filtered (" = ", stream);
> +
> +	      val_print (value_type (field),
> +			 value_contents_for_printing (field),
> +			 value_embedded_offset (field),
> +			 value_address (field), stream, recurse + 1,
> +			 field, options, current_language);
> +
> +	      ++printed_field;
> +	    }
> +	 }
>         fprintf_filtered (stream, " )");
>         break;
>
> diff --git a/gdb/testsuite/gdb.fortran/derived-type.exp b/gdb/testsuite/gdb.fortran/derived-type.exp
> index f7f10b5..f650352 100644
> --- a/gdb/testsuite/gdb.fortran/derived-type.exp
> +++ b/gdb/testsuite/gdb.fortran/derived-type.exp
> @@ -54,7 +54,7 @@ gdb_test_multiple "ptype q" $test {
>   gdb_breakpoint [gdb_get_line_number "print"]
>   gdb_continue_to_breakpoint "print"
>
> -gdb_test "print p" "\\$\[0-9\]+ = \\( 1, 2\\.375 \\)"
> +gdb_test "print p" "\\$\[0-9\]+ = \\( c = 1, d = 2\\.375 \\)"
>   gdb_test "print p%c" "\\$\[0-9\]+ = 1"
>   gdb_test "print p%d" "\\$\[0-9\]+ = 2\\.375"
>   gdb_test "print q%a" "\\$\[0-9\]+ = 3\\.125"
> @@ -76,10 +76,10 @@ gdb_test "print q%x%d" "\\$\[0-9\]+ = 2\\.375"
>
>   set test "print q"
>   gdb_test_multiple $test $test {
> -    -re "\\$\[0-9\]+ = \\( 3.125, \\( 1, 2\\.375 \\), 'abcdefg' \\)\r\n$gdb_prompt $" {
> +    -re "\\$\[0-9\]+ = \\( a = 3.125, x = \\( c = 1, d = 2\\.375 \\), b = 'abcdefg' \\)\r\n$gdb_prompt $" {
>   	pass $test
>       }
> -    -re "\\$\[0-9\]+ = \\( 3.125, \\( 1, 2\\.375 \\), \\(97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g'\\) \\)\r\n$gdb_prompt $" {
> +    -re "\\$\[0-9\]+ = \\( a = 3.125, x = \\( 1, 2\\.375 \\), b = \\('abcdefg'\\) \\)\r\n$gdb_prompt $" {
>   	# Compiler should produce string, not an array of characters.
>   	setup_xfail "*-*-*"
>   	fail $test
>

This looks good to me.



More information about the Gdb-patches mailing list