2012-01-31 Tobias Burnus <burnus@net-b.de>

        PR fortran/52013
        * class.c (get_unique_hashed_string): Adapt trim length.
        (gfc_build_class_symbol) Encode also corank in the container name.

2012-01-31  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52013

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183769 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e836c0af382bf1be146a3fb7a86c9e33ddf4728e..b39e03798f4328fafc924ea05c15234f0ace5ae7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-01-31  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/52013
+       * class.c (get_unique_hashed_string): Adapt trim length.
+       (gfc_build_class_symbol) Encode also corank in the container name.
+
 2012-01-31  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/52012

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 52c5a61047ffeebb3e2b0f8bff81f50233cd622f..3ff6a0bd1c1aceb450f1a67580bbad0d5a791424 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -294,8 +294,10 @@ get_unique_hashed_string (char *string, gfc_symbol *derived)
   char tmp[2*GFC_MAX_SYMBOL_LEN+2];
   get_unique_type_string (&tmp[0], derived);
   /* If string is too long, use hash value in hex representation (allow for
-     extra decoration, cf. gfc_build_class_symbol & gfc_find_derived_vtab).  */
-  if (strlen (tmp) > GFC_MAX_SYMBOL_LEN - 11)
+     extra decoration, cf. gfc_build_class_symbol & gfc_find_derived_vtab).
+     We need space to for 15 characters "__class_" + symbol name + "_%d_%da",
+     where %d is the (co)rank which can be up to n = 15.  */
+  if (strlen (tmp) > GFC_MAX_SYMBOL_LEN - 15)
     {
       int h = gfc_hash_value (derived);
       sprintf (string, "%X", h);
@@ -360,10 +362,10 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 
   /* Determine the name of the encapsulating type.  */
   get_unique_hashed_string (tname, ts->u.derived);
-  if ((*as) && (*as)->rank && attr->allocatable)
-    sprintf (name, "__class_%s_%d_a", tname, (*as)->rank);
-  else if ((*as) && (*as)->rank)
-    sprintf (name, "__class_%s_%d", tname, (*as)->rank);
+  if ((*as) && attr->allocatable)
+    sprintf (name, "__class_%s_%d_%da", tname, (*as)->rank, (*as)->corank);
+  else if ((*as))
+    sprintf (name, "__class_%s_%d_%d", tname, (*as)->rank, (*as)->corank);
   else if (attr->pointer)
     sprintf (name, "__class_%s_p", tname);
   else if (attr->allocatable)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 820175c5d4824ca98fda92b3a1be54805c8fec0a..3e0ca1e4ab89dd5152357395943cc7e2a60b43a7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-31  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/52013
+       * gfortran.dg/elemental_args_check_6.f90: New.
+
 2012-01-31  Jason Merrill  <jason@redhat.com>
 
        PR c++/52043

diff --git a/gcc/testsuite/gfortran.dg/elemental_args_check_6.f90 b/gcc/testsuite/gfortran.dg/elemental_args_check_6.f90
new file mode 100644 (file)
index 0000000..f5ae59a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_args_check_6.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/52013
+!
+type t
+end type t
+contains
+  elemental subroutine f(x) 
+    class(t), intent(inout) :: x ! Valid
+  end subroutine
+  elemental subroutine g(y) ! { dg-error "Coarray dummy argument 'y' at .1. to elemental procedure" }
+    class(t), intent(inout) :: y[*]
+  end subroutine
+end