Hi,

in the bugtracker for PR60255 janus proposed to fix the bug by removing
the error and additionally checking if the character array length
declaration is deferred, which leaves the the charlen to be 0
(gcc/fortran/class.c (find_intrinsic_vtab) 2418-2420). 

My contribution to that patch is the testcase and to mark the vtab-entry more
clearly to stem from a deferred array init, because I did not like the array
size being 0. This may lead to confusions with a character array of length 0.
Therefore I changed the symbol name generation to enable easier identification
of problems.

The symbol before my change was computed to be:

symbolname_0_kind

I would have used the colon (:) to indicate the deferred state, but that
is not allowed in the assembler, so I spelled it out and the symbol is now
marked by:

symbolname_DEFERRED_kind

This way the vtab entry can not be confused with an entry for an entry for a
zero length array and the word DEFERRED has as many characters as MAXINT
printed in the decimal system, i.e., if no check is needed, if MAXINT does fit
into the space reserved for the vtab symbol, then no check is needed for the 8
character word, too.

Changelog and extended patch proposal attached.

Bootstrapped and regtested on x86_64-linux-gnu

Please comment!

Regards,
        Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 
*** gcc/fortran/Changelog ***
2014-08-07  Andre Vehreschild  <ve...@gmx.de>

        PR fortran/60255
        * class.c (find_intrinsic_vtab): vtab symbol for deferred length
        character arrays now composed to be typename_DEFERRED_kind.

2014-02-18    <ja...@gcc.gnu.org>

        PR fortran/60255
        * class.c (find_intrinsic_vtab): Fix ICE on deferred length
        character arrays.

*** gcc/fortran/Changelog ***

*** gcc/testsuite/Changelog ***
2014-08-07  Andre Vehreschild  <ve...@gmx.de>

        * gfortran.dg/unlimited_polymorphism_19.f90: Check according to
        PR fortran/60255
        * gfortran.dg/unlimited_polymorphism_2.f03: Removed error fixed now.

*** gcc/testsuite/Changelog ***
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 346aee6..493c4c8 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2415,18 +2415,9 @@ find_intrinsic_vtab (gfc_typespec *ts)
   gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
   int charlen = 0;
 
-  if (ts->type == BT_CHARACTER)
-    {
-      if (ts->deferred)
-	{
-	  gfc_error ("TODO: Deferred character length variable at %C cannot "
-		     "yet be associated with unlimited polymorphic entities");
-	  return NULL;
-	}
-      else if (ts->u.cl && ts->u.cl->length
-	       && ts->u.cl->length->expr_type == EXPR_CONSTANT)
-	charlen = mpz_get_si (ts->u.cl->length->value.integer);
-    }
+  if (ts->type == BT_CHARACTER && !ts->deferred && ts->u.cl && ts->u.cl->length
+      && ts->u.cl->length->expr_type == EXPR_CONSTANT)
+    charlen = mpz_get_si (ts->u.cl->length->value.integer);
 
   /* Find the top-level namespace.  */
   for (ns = gfc_current_ns; ns; ns = ns->parent)
@@ -2437,10 +2428,16 @@ find_intrinsic_vtab (gfc_typespec *ts)
     {
       char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
 
-      if (ts->type == BT_CHARACTER)
-	sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type),
-		 charlen, ts->kind);
-      else
+      if (ts->type == BT_CHARACTER) {
+        if (!ts->deferred)
+          sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type),
+                   charlen, ts->kind);
+        else
+          /* The type is deferred here. Ensure that this is easily seen in the 
+             vtable. */
+          sprintf (tname, "%s_DEFERRED_%d", gfc_basic_typename (ts->type),
+                   ts->kind);
+      } else
 	sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
 
       sprintf (name, "__vtab_%s", tname);
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90
new file mode 100644
index 0000000..f18d44d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_19.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Testing fix for 
+! PR fortran/60255 
+!
+program test
+    character(LEN=:), allocatable :: S
+    call subP(S)
+contains
+
+subroutine subP(P)
+        class(*) :: P
+end subroutine
+ 
+end program
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03
index 8e80386..30e4797 100644
--- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_2.f03
@@ -5,7 +5,7 @@
 ! Contributed by Paul Thomas  <pa...@gcc.gnu.org>
 !            and Tobias Burnus <bur...@gcc.gnu.org>
 !
-  CHARACTER(:), allocatable, target :: chr ! { dg-error "TODO: Deferred character length variable" }
+  CHARACTER(:), allocatable, target :: chr 
 ! F2008: C5100
   integer :: i(2)
   logical :: flag

Reply via email to