Add ptype support for DWARF-based fixed-point types

Note that the ptype information printed for types described
via pure DWARF debug info is slightly less informative as
the one printed when the information is encoded in the type's
name, via the GNAT encoding. As a result, the output in
the case of DWARF-described fixed point types is slightly
different. In pratice, this is no real loss because the information
not available in DWARF has no bearing on how the type is actually
stored in memory.

gdb/ChangeLog:

        * ada-typeprint.c (ada_print_type): Add handing of fixed-point
        range types.
        * c-typeprint.c (c_type_print_varspec_prefix)
        (c_type_print_varspec_suffix, c_type_print_base_1): Add
        TYPE_CODE_FIXED_POINT handling.
        * p-typeprint.c (pascal_type_print_varspec_prefix)
        (pascal_type_print_varspec_suffix): Likewise.
        * typeprint.c (print_type_fixed_point): New function.
        * typeprint.h (print_type_fixed_point): Add declaration.

gdb/testsuite/ChangeLog:

        * gdb.ada/fixed_points.exp: Add ptype tests.
        * gdb.dwarf2/dw2-fixed-point.exp: Likewise.

9 files changed, 128 insertions, 0 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 0d322da..56e54d3 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,5 +1,17 @@
 2020-11-15  Joel Brobecker  <brobecker@adacore.com>
 
+	* ada-typeprint.c (ada_print_type): Add handing of fixed-point
+	range types.
+	* c-typeprint.c (c_type_print_varspec_prefix)
+	(c_type_print_varspec_suffix, c_type_print_base_1): Add
+	TYPE_CODE_FIXED_POINT handling.
+	* p-typeprint.c (pascal_type_print_varspec_prefix)
+	(pascal_type_print_varspec_suffix): Likewise.
+	* typeprint.c (print_type_fixed_point): New function.
+	* typeprint.h (print_type_fixed_point): Add declaration.
+
+2020-11-15  Joel Brobecker  <brobecker@adacore.com>
+
 	* printcmd.c (print_scalar_formatted): Add fixed-point type
 	handling when options->format is set.
 
diff --git a/gdb/ada-typeprint.c b/gdb/ada-typeprint.c
index 5388247..8abb65b 100644
--- a/gdb/ada-typeprint.c
+++ b/gdb/ada-typeprint.c
@@ -1046,6 +1046,12 @@ ada_print_type (struct type *type0, const char *varstring,
       case TYPE_CODE_RANGE:
 	if (ada_is_gnat_encoded_fixed_point_type (type))
 	  print_gnat_encoded_fixed_point_type (type, stream);
+	else if (is_fixed_point_type (type))
+	  {
+	    fprintf_filtered (stream, "<");
+	    print_type_fixed_point (type, stream);
+	    fprintf_filtered (stream, ">");
+	  }
 	else if (ada_is_modular_type (type))
 	  fprintf_filtered (stream, "mod %s", 
 			    int_string (ada_modulus (type), 10, 0, 0, 1));
diff --git a/gdb/c-typeprint.c b/gdb/c-typeprint.c
index e72fdaa..10631ff 100644
--- a/gdb/c-typeprint.c
+++ b/gdb/c-typeprint.c
@@ -465,6 +465,7 @@ c_type_print_varspec_prefix (struct type *type,
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_NAMESPACE:
     case TYPE_CODE_DECFLOAT:
+    case TYPE_CODE_FIXED_POINT:
       /* These types need no prefix.  They are listed here so that
 	 gcc -Wall will reveal any types that haven't been handled.  */
       break;
@@ -844,6 +845,7 @@ c_type_print_varspec_suffix (struct type *type,
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_NAMESPACE:
     case TYPE_CODE_DECFLOAT:
+    case TYPE_CODE_FIXED_POINT:
       /* These types do not need a suffix.  They are listed so that
 	 gcc -Wall will report types that may not have been
 	 considered.  */
@@ -1683,6 +1685,10 @@ c_type_print_base_1 (struct type *type, struct ui_file *stream,
       fprintf_styled (stream, metadata_style.style (), _("<range type>"));
       break;
 
+    case TYPE_CODE_FIXED_POINT:
+      print_type_fixed_point (type, stream);
+      break;
+
     case TYPE_CODE_NAMESPACE:
       fputs_filtered ("namespace ", stream);
       fputs_filtered (type->name (), stream);
diff --git a/gdb/p-typeprint.c b/gdb/p-typeprint.c
index ef0f254..c2c182a 100644
--- a/gdb/p-typeprint.c
+++ b/gdb/p-typeprint.c
@@ -296,6 +296,7 @@ pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
     case TYPE_CODE_STRING:
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_TYPEDEF:
+    case TYPE_CODE_FIXED_POINT:
       /* These types need no prefix.  They are listed here so that
 	 gcc -Wall will reveal any types that haven't been handled.  */
       break;
@@ -429,6 +430,7 @@ pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
     case TYPE_CODE_STRING:
     case TYPE_CODE_COMPLEX:
     case TYPE_CODE_TYPEDEF:
+    case TYPE_CODE_FIXED_POINT:
       /* These types do not need a suffix.  They are listed so that
 	 gcc -Wall will report types that may not have been considered.  */
       break;
diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog
index 9b9ffe5..2c7b5c5 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2020-11-15  Joel Brobecker  <brobecker@adacore.com>
 
+	* gdb.ada/fixed_points.exp: Add ptype tests.
+	* gdb.dwarf2/dw2-fixed-point.exp: Likewise.
+
+2020-11-15  Joel Brobecker  <brobecker@adacore.com>
+
 	* gdb.dwarf2/dw2-fixed-point.exp: Add "print /x" tests.
 
 2020-11-15  Joel Brobecker  <brobecker@adacore.com>
diff --git a/gdb/testsuite/gdb.ada/fixed_points.exp b/gdb/testsuite/gdb.ada/fixed_points.exp
index 655ee95..1fe2eb2 100644
--- a/gdb/testsuite/gdb.ada/fixed_points.exp
+++ b/gdb/testsuite/gdb.ada/fixed_points.exp
@@ -55,8 +55,44 @@ gdb_test "ptype Overprecise_Object" \
 gdb_test "print fp1_var" \
          " = 0.25"
 
+gdb_test_multiple "ptype fp1_var" "" {
+    -re "type = <1-byte fixed point \\(small = 0\\.0625\\)>\r\n$gdb_prompt $" {
+        pass $gdb_test_name
+    }
+    -re "type = delta 0\\.1 <'small = 0\\.0625>\r\n$gdb_prompt $" {
+        # The (legacy) output we obtain when the compiler described
+        # our fixed point types using the GNAT encodings rather than
+        # standard DWARF.  OK as well.
+        pass $gdb_test_name
+    }
+}
+
 gdb_test "print fp2_var" \
          " = -0.01"
 
+gdb_test_multiple "ptype fp2_var" "" {
+    -re "type = <8-byte fixed point \\(small = 0\\.01\\)>\r\n$gdb_prompt $" {
+        pass $gdb_test_name
+    }
+    -re "type = delta 0\\.01\r\n$gdb_prompt $" {
+        # The (legacy) output we obtain when the compiler described
+        # our fixed point types using the GNAT encodings rather than
+        # standard DWARF.  OK as well.
+        pass $gdb_test_name
+    }
+}
+
 gdb_test "print fp3_var" \
          " = 0.1"
+
+gdb_test_multiple "ptype fp3_var" "" {
+    -re "type = <1-byte fixed point \\(small = 0\\.0333333\\)>\r\n$gdb_prompt $" {
+        pass $gdb_test_name
+    }
+    -re "type = delta 0\\.1 <'small = 0\\.0333333>\r\n$gdb_prompt $" {
+        # The (legacy) output we obtain when the compiler described
+        # our fixed point types using the GNAT encodings rather than
+        # standard DWARF.  OK as well.
+        pass $gdb_test_name
+    }
+}
diff --git a/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp
index 27c549c..33a7e74 100644
--- a/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp
+++ b/gdb/testsuite/gdb.dwarf2/dw2-fixed-point.exp
@@ -142,3 +142,47 @@ gdb_test "print pck.fp1_range_var" \
 
 gdb_test "print /x pck.fp1_range_var" \
          " = 0x1"
+
+# Set the language to LANG and do a ptype test on pck__fp1_var,
+# pck__fp2_var and pck__fp3_var, verifying that the output matches
+# FP1_RE, FP2_RE, FP2_RE (resp.).
+
+proc do_ptype_test {lang fp1_re fp2_re fp3_re fp1_range_re} {
+    with_test_prefix "lang=$lang" {
+        gdb_test_no_output "set language $lang" \
+            "set language to $lang for ptype test"
+
+        gdb_test "ptype pck__fp1_var" $fp1_re
+
+        gdb_test "ptype pck__fp2_var" $fp2_re
+
+        gdb_test "ptype pck__fp3_var" $fp3_re
+
+        if { $lang == "modula-2" || $lang == "pascal" } {
+            setup_xfail "*-*-*" "not supported by language"
+        }
+        gdb_test "ptype pck__fp1_range_var" $fp1_range_re
+    }
+}
+
+do_ptype_test "ada" \
+              " = <1-byte fixed point \\(small = 1/16\\)>" \
+              " = <1-byte fixed point \\(small = 1/100\\)>" \
+              " = <1-byte fixed point \\(small = 1/30\\)>" \
+              " = <1-byte fixed point \\(small = 1/16\\)>"
+
+foreach lang [list "c" "d" "go" "objective-c" "opencl" ] {
+    do_ptype_test $lang \
+                  " = 1-byte fixed point \\(small = 1/16\\)" \
+                  " = 1-byte fixed point \\(small = 1/100\\)" \
+                  " = 1-byte fixed point \\(small = 1/30\\)" \
+                  " = <range type>"
+}
+
+foreach lang [list "fortran" "modula-2" "pascal" ] {
+    do_ptype_test $lang \
+                  " = pck__fp1_type" \
+                  " = pck__fp2_type" \
+                  " = pck__fp3_type" \
+                  " = <range type>"
+}
diff --git a/gdb/typeprint.c b/gdb/typeprint.c
index acaee44..f947faf 100644
--- a/gdb/typeprint.c
+++ b/gdb/typeprint.c
@@ -662,6 +662,18 @@ print_type_scalar (struct type *type, LONGEST val, struct ui_file *stream)
     }
 }
 
+/* See typeprint.h.  */
+
+void
+print_type_fixed_point (struct type *type, struct ui_file *stream)
+{
+  gdb::unique_xmalloc_ptr<char> small_img
+    = fixed_point_scaling_factor (type).str ();
+
+  fprintf_filtered (stream, "%s-byte fixed point (small = %s)",
+		    pulongest (TYPE_LENGTH (type)), small_img.get ());
+}
+
 /* Dump details of a type specified either directly or indirectly.
    Uses the same sort of type lookup mechanism as ptype_command()
    and whatis_command().  */
diff --git a/gdb/typeprint.h b/gdb/typeprint.h
index 8936b9a..d595cbe 100644
--- a/gdb/typeprint.h
+++ b/gdb/typeprint.h
@@ -151,6 +151,11 @@ private:
 
 void print_type_scalar (struct type * type, LONGEST, struct ui_file *);
 
+/* Assuming the TYPE is a fixed point type, print its type description
+   on STREAM.  */
+
+void print_type_fixed_point (struct type *type, struct ui_file *stream);
+
 void c_type_print_args (struct type *, struct ui_file *, int, enum language,
 			const struct type_print_options *);