fortran: Fix debug info for unsigned(kind=1) and unsigned(kind=4) [PR120193]

As the following testcase shows, debug info for unsigned(kind=1)
and unsigned(kind=4) vars is wrong while unsigned(kind=2), unsigned(kind=8)
and unsigned(kind=16) look right.
Instead of objects having unsigned(kind=1) type they have character(kind=1)
and instead of unsigned(kind=4) they have character(kind=4).
This means in gdb e.g. unsigned(kind=1) :: a(2) variable initialized to
97 will print as 'aa' rather than (97, 97) etc.
While there can be just one unsigned_char_type_node and one
unsigned_type_node type, each can have arbitrary number of variants
(e.g. consider C
typedef unsigned char uc;
where uc is a variant type to unsigned char) or even distinct types
with different TYPE_MAIN_VARIANT.

The following patch uses a variant of the character(kind=4) type
for unsigned(kind=4) and a distinct type based on character(kind=1)
type for unsigned(kind=1).  The reason for the latter is that
unsigned_char_type_node has TYPE_STRING_FLAG set on it, so it has
DW_AT_encoding DW_ATE_unsigned_char rather than DW_ATE_unsigned and
so the debugger then likes to print it as characters rather than numbers.
That is IMHO in Fortran desirable for character(kind=1) but not for
unsigned(kind=1).  I've made sure TYPE_CANONICAL of the unsigned(kind=1)
type is still character(kind=1), so they are considered compatible by
the middle-end also e.g. for aliasing etc.

2025-05-10  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/120193
	* trans-types.cc (gfc_init_types): For flag_unsigned use
	build_distinct_type_copy or build_variant_type_copy from
	gfc_character_types[index_char] if index_char > -1 instead of
	gfc_character_types[index_char] or
	gfc_build_unsigned_type (&gfc_unsigned_kinds[index]).

	* gfortran.dg/guality/pr120193.f90: New test.

(cherry picked from commit 512371d786e70d27dbaef38d60e9036c11f458c6)

diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 3374778cb6500a7b6e77ac6b413c1a0a10973c6c..f898075468568648280a3927f5a71a1d762cb726 100644 (file)
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1140,11 +1140,6 @@ gfc_init_types (void)
     }
   gfc_character1_type_node = gfc_character_types[0];
 
-  /* The middle end only recognizes a single unsigned type.  For
-     compatibility of existing test cases, let's just use the
-     character type.  The reader of tree dumps is expected to be able
-     to deal with this.  */
-
   if (flag_unsigned)
     {
       for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index)
@@ -1159,18 +1154,26 @@ gfc_init_types (void)
                  break;
                }
            }
-         if (index_char > 0)
+         if (index_char > -1)
            {
-             gfc_unsigned_types[index] = gfc_character_types[index_char];
+             type = gfc_character_types[index_char];
+             if (TYPE_STRING_FLAG (type))
+               {
+                 type = build_distinct_type_copy (type);
+                 TYPE_CANONICAL (type)
+                   = TYPE_CANONICAL (gfc_character_types[index_char]);
+               }
+             else
+               type = build_variant_type_copy (type);
+             TYPE_NAME (type) = NULL_TREE;
+             TYPE_STRING_FLAG (type) = 0;
            }
          else
-           {
-             type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]);
-             gfc_unsigned_types[index] = type;
-             snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)",
-                       gfc_integer_kinds[index].kind);
-             PUSH_TYPE (name_buf, type);
-           }
+           type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]);
+         gfc_unsigned_types[index] = type;
+         snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)",
+                   gfc_integer_kinds[index].kind);
+         PUSH_TYPE (name_buf, type);
        }
     }
 

diff --git a/gcc/testsuite/gfortran.dg/guality/pr120193.f90 b/gcc/testsuite/gfortran.dg/guality/pr120193.f90
new file mode 100644 (file)
index 0000000..e65febf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/guality/pr120193.f90
@@ -0,0 +1,26 @@
+! PR fortran/120193
+! { dg-do run }
+! { dg-options "-g -funsigned" }
+! { dg-skip-if "" { *-*-* }  { "*" } { "-O0" } }
+
+program foo
+  unsigned(kind=1) :: a(2), e
+  unsigned(kind=2) :: b(2), f
+  unsigned(kind=4) :: c(2), g
+  unsigned(kind=8) :: d(2), h
+  character(kind=1, len=1) :: i(2), j
+  character(kind=4, len=1) :: k(2), l
+  a = 97u_1    ! { dg-final { gdb-test 24 "a" "d" } }
+  b = 97u_2    ! { dg-final { gdb-test 24 "b" "c" } }
+  c = 97u_4    ! { dg-final { gdb-test 24 "c" "b" } }
+  d = 97u_8    ! { dg-final { gdb-test 24 "d" "a" } }
+  e = 97u_1    ! { dg-final { gdb-test 24 "e" "97" } }
+  f = 97u_2    ! { dg-final { gdb-test 24 "f" "97" } }
+  g = 97u_4    ! { dg-final { gdb-test 24 "g" "97" } }
+  h = 97u_8    ! { dg-final { gdb-test 24 "h" "97" } }
+  i = 'a'      ! { dg-final { gdb-test 24 "i" "('a', 'a')" } }
+  j = 'b'      ! { dg-final { gdb-test 24 "j" "'b'" } }
+  k = 'c'
+  l = 'd'
+  print *, a
+end program