[binutils-gdb] Convert Fortran printing to value-based API

[binutils-gdb] Convert Fortran printing to value-based API

[Tom Tromey]

https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=6a95a1f58dd9dabcade13f7a332eed601baf25f8

commit 6a95a1f58dd9dabcade13f7a332eed601baf25f8
Author: Tom Tromey <tom@tromey.com>
Date:   Fri Mar 13 17:39:52 2020 -0600

    Convert Fortran printing to value-based API
    
    This finishes the conversion of the Fortran printing code to the
    value-based API.  The body of f_val_print is copied into
    f_value_print_innner, and then modified as needed to use the value
    API.
    
    Note that not all calls must be updated.  For example, f77_print_array
    remains "val-like", because it does not result in any calls to
    val_print (f77_print_array_1 calls common_val_print, which is
    nominally value-based).
    
    gdb/ChangeLog
    2020-03-13  Tom Tromey  <tom@tromey.com>
    
            * f-valprint.c (f_value_print_innner): Rewrite.

Diff:
---
 gdb/ChangeLog    |   4 ++
 gdb/f-valprint.c | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 169 insertions(+), 2 deletions(-)

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 04657f2cd50..75ac39c82f2 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,7 @@
+2020-03-13  Tom Tromey  <tom@tromey.com>
+
+	* f-valprint.c (f_value_print_innner): Rewrite.
+
 2020-03-13  Tom Tromey  <tom@tromey.com>
 
 	* m2-valprint.c (m2_print_unbounded_array): New overload.
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 10593eebc0c..f927214ae65 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -400,8 +400,171 @@ void
 f_value_print_innner (struct value *val, struct ui_file *stream, int recurse,
 		      const struct value_print_options *options)
 {
-  f_val_print (value_type (val), value_embedded_offset (val),
-	       value_address (val), stream, recurse, val, options);
+  struct type *type = check_typedef (value_type (val));
+  struct gdbarch *gdbarch = get_type_arch (type);
+  int printed_field = 0; /* Number of fields printed.  */
+  struct type *elttype;
+  CORE_ADDR addr;
+  int index;
+  const gdb_byte *valaddr = value_contents_for_printing (val);
+  const CORE_ADDR address = value_address (val);
+
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_STRING:
+      f77_get_dynamic_length_of_aggregate (type);
+      LA_PRINT_STRING (stream, builtin_type (gdbarch)->builtin_char,
+		       valaddr, TYPE_LENGTH (type), NULL, 0, options);
+      break;
+
+    case TYPE_CODE_ARRAY:
+      if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_CHAR)
+	{
+	  fprintf_filtered (stream, "(");
+	  f77_print_array (type, valaddr, 0,
+			   address, stream, recurse, val, options);
+	  fprintf_filtered (stream, ")");
+	}
+      else
+	{
+	  struct type *ch_type = TYPE_TARGET_TYPE (type);
+
+	  f77_get_dynamic_length_of_aggregate (type);
+	  LA_PRINT_STRING (stream, ch_type, valaddr,
+			   TYPE_LENGTH (type) / TYPE_LENGTH (ch_type),
+			   NULL, 0, options);
+	}
+      break;
+
+    case TYPE_CODE_PTR:
+      if (options->format && options->format != 's')
+	{
+	  value_print_scalar_formatted (val, options, 0, stream);
+	  break;
+	}
+      else
+	{
+	  int want_space = 0;
+
+	  addr = unpack_pointer (type, valaddr);
+	  elttype = check_typedef (TYPE_TARGET_TYPE (type));
+
+	  if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
+	    {
+	      /* Try to print what function it points to.  */
+	      print_function_pointer_address (options, gdbarch, addr, stream);
+	      return;
+	    }
+
+	  if (options->symbol_print)
+	    want_space = print_address_demangle (options, gdbarch, addr,
+						 stream, demangle);
+	  else if (options->addressprint && options->format != 's')
+	    {
+	      fputs_filtered (paddress (gdbarch, addr), stream);
+	      want_space = 1;
+	    }
+
+	  /* For a pointer to char or unsigned char, also print the string
+	     pointed to, unless pointer is null.  */
+	  if (TYPE_LENGTH (elttype) == 1
+	      && TYPE_CODE (elttype) == TYPE_CODE_INT
+	      && (options->format == 0 || options->format == 's')
+	      && addr != 0)
+	    {
+	      if (want_space)
+		fputs_filtered (" ", stream);
+	      val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
+				stream, options);
+	    }
+	  return;
+	}
+      break;
+
+    case TYPE_CODE_INT:
+      if (options->format || options->output_format)
+	{
+	  struct value_print_options opts = *options;
+
+	  opts.format = (options->format ? options->format
+			 : options->output_format);
+	  value_print_scalar_formatted (val, &opts, 0, stream);
+	}
+      else
+	value_print_scalar_formatted (val, options, 0, stream);
+      break;
+
+    case TYPE_CODE_STRUCT:
+    case TYPE_CODE_UNION:
+      /* Starting from the Fortran 90 standard, Fortran supports derived
+         types.  */
+      fprintf_filtered (stream, "( ");
+      for (index = 0; index < TYPE_NFIELDS (type); index++)
+        {
+	  struct value *field = value_field (val, index);
+
+	  struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, index));
+
+
+	  if (TYPE_CODE (field_type) != TYPE_CODE_FUNC)
+	    {
+	      const char *field_name;
+
+	      if (printed_field > 0)
+		fputs_filtered (", ", stream);
+
+	      field_name = TYPE_FIELD_NAME (type, index);
+	      if (field_name != NULL)
+		{
+		  fputs_styled (field_name, variable_name_style.style (),
+				stream);
+		  fputs_filtered (" = ", stream);
+		}
+
+	      common_val_print (field, stream, recurse + 1,
+				options, current_language);
+
+	      ++printed_field;
+	    }
+	 }
+      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);
+	  value_print_scalar_formatted (val, &opts, 0, stream);
+	}
+      else
+	{
+	  LONGEST longval = value_as_long (val);
+	  /* The Fortran standard doesn't specify how logical types are
+	     represented.  Different compilers use different non zero
+	     values to represent logical true.  */
+	  if (longval == 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:
+    case TYPE_CODE_FLT:
+    case TYPE_CODE_VOID:
+    case TYPE_CODE_ERROR:
+    case TYPE_CODE_RANGE:
+    case TYPE_CODE_UNDEF:
+    case TYPE_CODE_COMPLEX:
+    case TYPE_CODE_CHAR:
+    default:
+      generic_value_print (val, stream, recurse, options, &f_decorations);
+      break;
+    }
 }
 
 static void