Use CHARACTER(kind) string for calculating the type hash.
This regression came about because of a change in the way types are displayed in error messages. The character representation is also used to calculate the hashes for our types, so this patch restores the old behavior if we are indeed calculating a hash. The test case also checks for the specific hash value because changing that would be an ABI change, which we should not be doing unintentionally. gcc/fortran/ChangeLog: 2020-06-30 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/95355 * gfortran.h (gfc_typename): Add optional argument for_hash. * misc.c (gfc_typename): When for_hash is true, just retur CHARACTER(kind). * class.c (gfc_intrinsic_hash_value): Call gfc_typename with for_hash = true.
This commit is contained in:
parent
8dc933c12f
commit
5958b926dc
@ -564,7 +564,7 @@ unsigned int
|
||||
gfc_intrinsic_hash_value (gfc_typespec *ts)
|
||||
{
|
||||
unsigned int hash = 0;
|
||||
const char *c = gfc_typename (ts);
|
||||
const char *c = gfc_typename (ts, true);
|
||||
int i, len;
|
||||
|
||||
len = strlen (c);
|
||||
|
@ -2931,7 +2931,7 @@ void gfc_clear_ts (gfc_typespec *);
|
||||
FILE *gfc_open_file (const char *);
|
||||
const char *gfc_basic_typename (bt);
|
||||
const char *gfc_dummy_typename (gfc_typespec *);
|
||||
const char *gfc_typename (gfc_typespec *);
|
||||
const char *gfc_typename (gfc_typespec *, bool for_hash = false);
|
||||
const char *gfc_typename (gfc_expr *);
|
||||
const char *gfc_op2string (gfc_intrinsic_op);
|
||||
const char *gfc_code2string (const mstring *, int);
|
||||
|
@ -122,7 +122,7 @@ gfc_basic_typename (bt type)
|
||||
the argument list of a single statement. */
|
||||
|
||||
const char *
|
||||
gfc_typename (gfc_typespec *ts)
|
||||
gfc_typename (gfc_typespec *ts, bool for_hash)
|
||||
{
|
||||
static char buffer1[GFC_MAX_SYMBOL_LEN + 7]; /* 7 for "TYPE()" + '\0'. */
|
||||
static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
|
||||
@ -149,6 +149,12 @@ gfc_typename (gfc_typespec *ts)
|
||||
sprintf (buffer, "LOGICAL(%d)", ts->kind);
|
||||
break;
|
||||
case BT_CHARACTER:
|
||||
if (for_hash)
|
||||
{
|
||||
sprintf (buffer, "CHARACTER(%d)", ts->kind);
|
||||
break;
|
||||
}
|
||||
|
||||
if (ts->u.cl && ts->u.cl->length)
|
||||
length = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
|
||||
if (ts->kind == gfc_default_character_kind)
|
||||
|
43
gcc/testsuite/gfortran.dg/select_type_49.f90
Normal file
43
gcc/testsuite/gfortran.dg/select_type_49.f90
Normal file
@ -0,0 +1,43 @@
|
||||
! { dg-do run }
|
||||
! { dg-additional-options "-fdump-tree-original" }
|
||||
! PR 95366 - this did not work due the wrong hashes
|
||||
! being generated for CHARACTER variables.
|
||||
MODULE mod1
|
||||
implicit none
|
||||
integer :: tst(3)
|
||||
CONTAINS
|
||||
subroutine showpoly(poly)
|
||||
CLASS(*), INTENT(IN) :: poly(:)
|
||||
SELECT TYPE (poly)
|
||||
TYPE IS(INTEGER)
|
||||
tst(1) = tst(1) + 1
|
||||
TYPE IS(character(*))
|
||||
tst(2) = tst(2) + 1
|
||||
class default
|
||||
tst(3) = tst(3) + 1
|
||||
end select
|
||||
end subroutine showpoly
|
||||
END MODULE mod1
|
||||
MODULE mod2
|
||||
implicit none
|
||||
CONTAINS
|
||||
subroutine polytest2()
|
||||
use mod1
|
||||
integer :: a(1)
|
||||
character(len=42) :: c(1)
|
||||
call showpoly(a)
|
||||
if (any(tst /= [1,0,0])) stop 1
|
||||
call showpoly(c)
|
||||
if (any(tst /= [1,1,0])) stop 2
|
||||
end subroutine polytest2
|
||||
END MODULE mod2
|
||||
PROGRAM testpoly
|
||||
use mod2
|
||||
CALL polytest2()
|
||||
END PROGRAM testpoly
|
||||
! The value of the hashes are also checked. If you get
|
||||
! a failure here, be aware that changing that value is
|
||||
! an ABI change.
|
||||
|
||||
! { dg-final { scan-tree-dump-times "== 17759" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "== 85893463" 1 "original" } }
|
Loading…
Reference in New Issue
Block a user