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 3374778..f898075 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -1140,11 +1140,6 @@
}
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 @@
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
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
