diff mbox

[Fortran,pr78053,v1,OOP] SELECT TYPE on CLASS(*) component for deferred length char arrays ICEs for -O > 0

Message ID 20161024184809.470a1dc7@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Oct. 24, 2016, 4:48 p.m. UTC 
Hi all,

attached patch fixes an ICE in gfortran when an unlimited polymorphic entity
was used to store a char array of deferred/assumed length. The patch typedefs
the necessary type now copying the behavior from
trans-array.c::gfc_trans_create_temp_array(). 

Furthermore does the patch now consequently set the _vptr->_size to the
character kind of the char array and the _len component to the length of the
string independent of whether the char array was declared deferred or with a
len given.

Bootstraps and regtests ok on x86_64-linux/F23. Ok for trunk?

Regards,
	Andre

Comments

Paul Richard Thomas Oct. 25, 2016, 3:57 p.m. UTC | #1 
Hi Andre,

This patch is fine, apart from
s/whose length is no consistently/whose length is not consistently/
in the comment.

The testcase in comment #1 of PR78053 is invalid and now give the
correct message:

     type is (character(len=:))
             1
Error: The type-spec at (1) shall specify that each length type
parameter is assumed

Is this tested anywhere?

OK for trunk and, although not a regression, for 6-branch.

Cheers

Paul

On 24 October 2016 at 18:48, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> attached patch fixes an ICE in gfortran when an unlimited polymorphic entity
> was used to store a char array of deferred/assumed length. The patch typedefs
> the necessary type now copying the behavior from
> trans-array.c::gfc_trans_create_temp_array().
>
> Furthermore does the patch now consequently set the _vptr->_size to the
> character kind of the char array and the _len component to the length of the
> string independent of whether the char array was declared deferred or with a
> len given.
>
> Bootstraps and regtests ok on x86_64-linux/F23. Ok for trunk?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
Andre Vehreschild Oct. 25, 2016, 5:07 p.m. UTC | #2 
Hi Paul,

thanks for the review. The typo is corrected and another in the sentences
before that, too. Committed as r241528. I will see whether it make sense and is
possible to backport to gcc-6.

Note the PR78053 is considered a duplicate of pr72770 which now used for
tracking.

About the testcase for "type is (character(len=:))" there seems to be some
difference of where the type is occurs. I think we should investigate further
and check whether a bit more is needed. In my trivial testcase:

  type :: t1
    integer :: i = 42
    class(t1),pointer :: cp
  end type

  class(t1), allocatable :: a

  select type (a)
    type is (character(len=:))
      ;
  end select
end

I get a totally different error message, then the one expected:

select_type_1.f03:10:30: ! 

     type is (character(len=:))
                              1
Error: Entity '__tmp_CHARACTER_0_1' at (1) has a deferred type parameter and
requires either the POINTER or ALLOCATABLE attribute

So a bit more of investigation is needed.

Again thanks for the review.

Regards,
	Andre

On Tue, 25 Oct 2016 17:57:25 +0200
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Hi Andre,
> 
> This patch is fine, apart from
> s/whose length is no consistently/whose length is not consistently/
> in the comment.
> 
> The testcase in comment #1 of PR78053 is invalid and now give the
> correct message:
> 
>      type is (character(len=:))
>              1
> Error: The type-spec at (1) shall specify that each length type
> parameter is assumed
> 
> Is this tested anywhere?
> 
> OK for trunk and, although not a regression, for 6-branch.
> 
> Cheers
> 
> Paul
> 
> On 24 October 2016 at 18:48, Andre Vehreschild <vehre@gmx.de> wrote:
> > Hi all,
> >
> > attached patch fixes an ICE in gfortran when an unlimited polymorphic entity
> > was used to store a char array of deferred/assumed length. The patch
> > typedefs the necessary type now copying the behavior from
> > trans-array.c::gfc_trans_create_temp_array().
> >
> > Furthermore does the patch now consequently set the _vptr->_size to the
> > character kind of the char array and the _len component to the length of the
> > string independent of whether the char array was declared deferred or with a
> > len given.
> >
> > Bootstraps and regtests ok on x86_64-linux/F23. Ok for trunk?
> >
> > Regards,
> >         Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de  
> 
> 
>
diff mbox

Patch

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 6ac543c..549cc91 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2515,11 +2515,6 @@  find_intrinsic_vtab (gfc_typespec *ts)
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL;
   gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
-  int charlen = 0;
-
-  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)
@@ -2530,12 +2525,10 @@  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
-	sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
-
+      /* Encode all type as TYPENAME_KIND_ including especially character
+	 arrays, whose length is no consistently stored in the _len component
+	 of the class-variable.  */
+      sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
       sprintf (name, "__vtab_%s", tname);
 
       /* Look for the vtab symbol in the top-level namespace only.  */
@@ -2600,9 +2593,8 @@  find_intrinsic_vtab (gfc_typespec *ts)
 	      c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
 						 NULL,
 						 ts->type == BT_CHARACTER
-						 && charlen == 0 ?
-						   ts->kind :
-						   (int)gfc_element_size (e));
+						 ? ts->kind
+						 : (int)gfc_element_size (e));
 	      gfc_free_expr (e);
 
 	      /* Add component _extends.  */
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c59e872..0d0bc38 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2681,6 +2681,20 @@  gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
 
   if (base)
     {
+      if (ss_info->expr->ts.type == BT_CHARACTER && !ss_info->expr->ts.deferred
+	  && ss_info->expr->ts.u.cl->length == NULL)
+	{
+	  /* Emit a DECL_EXPR for the variable sized array type in
+	     GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
+	     sizes works correctly.  */
+	  tree arraytype = TREE_TYPE (
+		GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (info->descriptor)));
+	  if (! TYPE_NAME (arraytype))
+	    TYPE_NAME (arraytype) = build_decl (UNKNOWN_LOCATION, TYPE_DECL,
+						NULL_TREE, arraytype);
+	  gfc_add_expr_to_block (block, build1 (DECL_EXPR, arraytype,
+						TYPE_NAME (arraytype)));
+	}
       /* Also the data pointer.  */
       tmp = gfc_conv_array_data (se.expr);
       /* If this is a variable or address of a variable we use it directly.
@@ -3143,9 +3157,22 @@  build_class_array_ref (gfc_se *se, tree base, tree index)
 
   size = gfc_class_vtab_size_get (decl);
 
+  /* For unlimited polymorphic entities then _len component needs to be
+     multiplied with the size.  If no _len component is present, then
+     gfc_class_len_or_zero_get () return a zero_node.  */
+  tmp = gfc_class_len_or_zero_get (decl);
+  if (!integer_zerop (tmp))
+    size = fold_build2 (MULT_EXPR, TREE_TYPE (index),
+			fold_convert (TREE_TYPE (index), size),
+			fold_build2 (MAX_EXPR, TREE_TYPE (index),
+				     fold_convert (TREE_TYPE (index), tmp),
+				     fold_convert (TREE_TYPE (index),
+						   integer_one_node)));
+  else
+    size = fold_convert (TREE_TYPE (index), size);
+
   /* Build the address of the element.  */
   type = TREE_TYPE (TREE_TYPE (base));
-  size = fold_convert (TREE_TYPE (index), size);
   offset = fold_build2_loc (input_location, MULT_EXPR,
 			    gfc_array_index_type,
 			    index, size);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f1849f5..aababab 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -861,7 +861,7 @@  gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
     {
       ctree = gfc_class_len_get (var);
       /* When the actual arg is a char array, then set the _len component of the
-       unlimited polymorphic entity, too.  */
+	 unlimited polymorphic entity to the length of the string.  */
       if (e->ts.type == BT_CHARACTER)
 	{
 	  /* Start with parmse->string_length because this seems to be set to a
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_5.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_5.f03
index a2d7cce..f07ffa1 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_class_5.f03
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_5.f03
@@ -1,7 +1,7 @@ 
 ! { dg-do run }
 !
 ! Contributed by Vladimir Fuka
-! Check that pr61337 is fixed.
+! Check that pr61337 and pr78053, which was caused by this testcase, is fixed.
 
 module array_list
 
@@ -39,8 +39,9 @@  program test_pr61337
   call add_item(a_list, [1, 2])
   call add_item(a_list, [3.0_8, 4.0_8])
   call add_item(a_list, [.true., .false.])
+  call add_item(a_list, ["foo", "bar", "baz"])
 
-  if (size(a_list) /= 3) call abort()
+  if (size(a_list) /= 4) call abort()
   do i = 1, size(a_list)
           call checkarr(a_list(i))
   end do
@@ -60,6 +61,9 @@  contains
           if (any(x /= [3.0_8, 4.0_8])) call abort()
         type is (logical)
           if (any(x .neqv. [.true., .false.])) call abort()
+        type is (character(len=*))
+          if (len(x) /= 3) call abort()
+          if (any(x /= ["foo", "bar", "baz"])) call abort()
         class default
           call abort()
       end select