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.

4 files changed, 53 insertions, 1 deletions

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  <andrew.burgess@embecosm.com>
+	    Alok Kumar Sharma  <AlokKumar.Sharma@amd.com>
+
+	* f-valprint.c (f_val_print): Handle TYPE_CODE_BOOL, any non-zero
+	value should be printed as true.
+
 2020-03-03  Hannes Domani  <ssbssa@yahoo.de>
 
 	* 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  <andrew.burgess@embecosm.com>
+
+	* gdb.fortran/logical.exp: Add tests that any non-zero value is
+	printed as true.
+
 2020-03-03  Sergio Durigan Junior  <sergiodj@redhat.com>
 
 	* 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]
+	}
+    }
+}