[gcc/devel/omp/gcc-10] Use CHARACTER(kind) string for calculating the type hash.

[gcc/devel/omp/gcc-10] Use CHARACTER(kind) string for calculating the type hash.

[Tobias Burnus]

https://gcc.gnu.org/g:858b288d2a6afc2f71f817344be3af4b7c3d4b3f

commit 858b288d2a6afc2f71f817344be3af4b7c3d4b3f
Author: Thomas Koenig <tkoenig@gcc.gnu.org>
Date:   Tue Jun 30 13:01:36 2020 +0200

    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/95366
            * 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.
    
    (cherry picked from commit 5958b926dcc3332aec0a2e34653c4394d2613401)

Diff:
---
 gcc/fortran/class.c                          |  2 +-
 gcc/fortran/gfortran.h                       |  2 +-
 gcc/fortran/misc.c                           |  8 +++++-
 gcc/testsuite/gfortran.dg/select_type_49.f90 | 43 ++++++++++++++++++++++++++++
 4 files changed, 52 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 2b760efe8d7..08705c7e95d 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -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);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 836e0b3063d..24c5101c4cb 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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);
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 0fc25df8a22..caf32dfd095 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/select_type_49.f90 b/gcc/testsuite/gfortran.dg/select_type_49.f90
new file mode 100644
index 00000000000..31203cd18fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_49.f90
@@ -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" } }