From 5e5d66b6a46c7b0353308bfb508b96a59f1addbf Mon Sep 17 00:00:00 2001 From: Andrew Burgess Date: Mon, 2 Mar 2020 18:08:49 +0000 Subject: [PATCH] gdb/fortran: Fix printing of logical true values for Flang GDB is not able to print logical true values for Flang compiler. Actual result: (gdb) p l $1 = 4294967295 Expected result: (gdb) p l $1 = .TRUE. This is due to GDB expecting representation of true value being 1. The Fortran standard doesnt specify how LOGICAL types are represented. Different compilers use different non-zero values to represent logical true. The gfortran compiler uses 1 to represent logical true and the flang compiler uses -1. GDB should accept all the non-zero values as true. This is achieved by handling TYPE_CODE_BOOL in f_val_print and printing any non-zero value as true. gdb/ChangeLog: * f-valprint.c (f_val_print): Handle TYPE_CODE_BOOL, any non-zero value should be printed as true. gdb/testsuite/ChangeLog: * gdb.fortran/logical.exp: Add tests that any non-zero value is printed as true. --- gdb/ChangeLog | 6 ++++++ gdb/f-valprint.c | 25 ++++++++++++++++++++++++- gdb/testsuite/ChangeLog | 5 +++++ gdb/testsuite/gdb.fortran/logical.exp | 18 ++++++++++++++++++ 4 files changed, 53 insertions(+), 1 deletion(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 2a1f3be79af..2ab26d2ead9 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,9 @@ +2020-03-03 Andrew Burgess + Alok Kumar Sharma + + * f-valprint.c (f_val_print): Handle TYPE_CODE_BOOL, any non-zero + value should be printed as true. + 2020-03-03 Hannes Domani * windows-tdep.c (windows_solib_create_inferior_hook): New function. diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index a25e6147322..0393ddfa8ab 100644 --- a/gdb/f-valprint.c +++ b/gdb/f-valprint.c @@ -357,6 +357,30 @@ f_val_print (struct type *type, int embedded_offset, fprintf_filtered (stream, " )"); break; + case TYPE_CODE_BOOL: + if (options->format || options->output_format) + { + struct value_print_options opts = *options; + opts.format = (options->format ? options->format + : options->output_format); + val_print_scalar_formatted (type, embedded_offset, + original_value, &opts, 0, stream); + } + else + { + int unit_size = gdbarch_addressable_memory_unit_size (gdbarch); + LONGEST val + = unpack_long (type, valaddr + embedded_offset * unit_size); + /* The Fortran standard doesn't specify how logical types are + represented. Different compilers use different non zero + values to represent logical true. */ + if (val == 0) + fputs_filtered (f_decorations.false_name, stream); + else + fputs_filtered (f_decorations.true_name, stream); + } + break; + case TYPE_CODE_REF: case TYPE_CODE_FUNC: case TYPE_CODE_FLAGS: @@ -366,7 +390,6 @@ f_val_print (struct type *type, int embedded_offset, case TYPE_CODE_RANGE: case TYPE_CODE_UNDEF: case TYPE_CODE_COMPLEX: - case TYPE_CODE_BOOL: case TYPE_CODE_CHAR: default: generic_val_print (type, embedded_offset, address, diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 28726b8fcb3..3912a1c6091 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-03-03 Andrew Burgess + + * gdb.fortran/logical.exp: Add tests that any non-zero value is + printed as true. + 2020-03-03 Sergio Durigan Junior * gdb.base/printcmds.exp: Add test to verify printf of a diff --git a/gdb/testsuite/gdb.fortran/logical.exp b/gdb/testsuite/gdb.fortran/logical.exp index f0028159e59..96e6f8f9559 100644 --- a/gdb/testsuite/gdb.fortran/logical.exp +++ b/gdb/testsuite/gdb.fortran/logical.exp @@ -33,3 +33,21 @@ gdb_test "p l1" " = \\.TRUE\\." gdb_test "p l2" " = \\.TRUE\\." gdb_test "p l4" " = \\.TRUE\\." gdb_test "p l8" " = \\.TRUE\\." + +# Different Fortran compilers use different values for logical true. +# Check how GDB handles this by modifying the underlying value for our +# logical variables and check they still print as true. +foreach_with_prefix var { l l1 l2 l4 l8 } { + set len [get_integer_valueof "sizeof (${var})" "get sizeof ${var}"] + set addr [get_hexadecimal_valueof "&l" "get address of ${var}"] + + for { set i 0 } { $i < $len } { incr i } { + with_test_prefix "byte $i" { + gdb_test_no_output "set *((uint8_t *) ${addr}) = 0xff" \ + "set contents of byte at offset $i" + gdb_test "p l" " = \\.TRUE\\." + incr addr + set addr [format "0x%x" $addr] + } + } +} -- 2.30.2