This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, Fortran] PR fortran/35846: ICE on character array constructor


Tobias Burnus wrote:
Hi Daniel,

Daniel Kraft wrote:
this is a fix for PR fortran/35846 where character array constructor
ICEd in certain situations because gfc_conv_string_length could be
called with a charlength structure whose length was NULL. [...]

After fixing the ICE, the problem with the global variables pointed out
broke bounds-checking for the tests, which I fixed by saving & restoring
their values.

I think you just made it more difficult to hit the bug rather than fully fixing the bug. If one adds another nested constructor one still gets:

Hi Tobias,


thanks for catching this one! I'm not in my best testing shape today it seems... But while I'm surely not in a position to claim the patch is right or correct, I still believe that the problem here was just that I missed to call flatten_array_ctors_without_strlen on the first constructor element when I took it out, so that in your example there still remained an array constructor in the "flattened" expression.

This is fixed with the new patch and your test compiles fine, too, and outputs the expected values.

The new patch is just regression testing. What do you think about this one? Or do you think the way this patch works is completely wrong and I should try to find another solution? I just thought it would be the best idea to reuse the existing logic in gfc_conv_string_length for gfc_conv_expr_descriptor/gfc_conv_string_length.

Yours,
Daniel

internal compiler error: in gfc_conv_array_constructor_expr,
                         at fortran/trans-expr.c:3356

using the following program

implicit none
character(len=3) :: c(3)
c = 'a'
c = (/ (/ 'A'//(/ trim(c(1)), 'a' /)/)//'c', 'dcd' /)
print *, c(1)
print *, c(2)
print *, c(3)
end

NAG f95 and ifort print for this program:
 Aac
 Aac
 dcd

-- Done: Arc-Bar-Cav-Sam-Val-Wiz, Dwa-Elf-Gno-Hum-Orc, Law-Neu-Cha, Fem-Mal To go: Hea-Kni-Mon-Pri-Ran-Rog-Tou
2008-09-20  Daniel Kraft  <d@domob.eu>

	PR fortran/35846
	* trans.h (gfc_conv_string_length): New argument `expr'.
	* trans-expr.c (flatten_array_ctors_without_strlen): New method.
	(gfc_conv_string_length): New argument `expr' that is used in a new
	special case handling if cl->length is NULL.
	(gfc_conv_subref_array_arg): Pass expr to gfc_conv_string_length.
	* trans-array.c (gfc_conv_expr_descriptor): Ditto.
	(gfc_trans_auto_array_allocation): Pass NULL as new expr.
	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_deferred_array): Ditto.
	(gfc_trans_array_constructor): Save and restore old values of globals
	used for bounds checking.
	* trans-decl.c (gfc_trans_dummy_character): Ditto.
	(gfc_trans_auto_character_variable): Ditto.

2008-09-20  Daniel Kraft  <d@domob.eu>

	PR fortran/35846
	* gfortran.dg/nested_array_constructor_1.f90: New test.
	* gfortran.dg/nested_array_constructor_2.f90: New test.
	* gfortran.dg/nested_array_constructor_3.f90: New test.
	* gfortran.dg/nested_array_constructor_4.f90: New test.
	* gfortran.dg/nested_array_constructor_5.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 140465)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -1694,6 +1694,13 @@ gfc_trans_array_constructor (gfc_loopinf
   tree type;
   tree loopfrom;
   bool dynamic;
+  bool old_first_len, old_typespec_chararray_ctor;
+  tree old_first_len_val;
+
+  /* Save the old values for nested checking.  */
+  old_first_len = first_len;
+  old_first_len_val = first_len_val;
+  old_typespec_chararray_ctor = typespec_chararray_ctor;
 
   /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
      typespec was given for the array constructor.  */
@@ -1792,7 +1799,7 @@ gfc_trans_array_constructor (gfc_loopinf
 	  if (size && compare_tree_int (size, nelem) == 0)
 	    {
 	      gfc_trans_constant_array_constructor (loop, ss, type);
-	      return;
+	      goto finish;
 	    }
 	}
     }
@@ -1849,6 +1856,12 @@ gfc_trans_array_constructor (gfc_loopinf
       gcc_unreachable ();
     }
 #endif
+
+finish:
+  /* Restore old values of globals.  */
+  first_len = old_first_len;
+  first_len_val = old_first_len_val;
+  typespec_chararray_ctor = old_typespec_chararray_ctor;
 }
 
 
@@ -4080,7 +4093,7 @@ gfc_trans_auto_array_allocation (tree de
   if (sym->ts.type == BT_CHARACTER
       && onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl))
     {
-      gfc_conv_string_length (sym->ts.cl, &block);
+      gfc_conv_string_length (sym->ts.cl, NULL, &block);
 
       gfc_trans_vla_type_sizes (sym, &block);
 
@@ -4104,7 +4117,7 @@ gfc_trans_auto_array_allocation (tree de
 
   if (sym->ts.type == BT_CHARACTER
       && !INTEGER_CST_P (sym->ts.cl->backend_decl))
-    gfc_conv_string_length (sym->ts.cl, &block);
+    gfc_conv_string_length (sym->ts.cl, NULL, &block);
 
   size = gfc_trans_array_bounds (type, sym, &offset, &block);
 
@@ -4170,7 +4183,7 @@ gfc_trans_g77_array (gfc_symbol * sym, t
 
   if (sym->ts.type == BT_CHARACTER
       && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
-    gfc_conv_string_length (sym->ts.cl, &block);
+    gfc_conv_string_length (sym->ts.cl, NULL, &block);
 
   /* Evaluate the bounds of the array.  */
   gfc_trans_array_bounds (type, sym, &offset, &block);
@@ -4262,7 +4275,7 @@ gfc_trans_dummy_array_bias (gfc_symbol *
 
   if (sym->ts.type == BT_CHARACTER
       && TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
-    gfc_conv_string_length (sym->ts.cl, &block);
+    gfc_conv_string_length (sym->ts.cl, NULL, &block);
 
   checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check);
 
@@ -4848,7 +4861,6 @@ gfc_conv_expr_descriptor (gfc_se * se, g
       break;
     }
 
-
   gfc_init_loopinfo (&loop);
 
   /* Associate the SS with the loop.  */
@@ -4872,7 +4884,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
       loop.temp_ss->next = gfc_ss_terminator;
 
       if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
-	gfc_conv_string_length (expr->ts.cl, &se->pre);
+	gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
 
       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
 
@@ -5672,7 +5684,7 @@ gfc_trans_deferred_array (gfc_symbol * s
   if (sym->ts.type == BT_CHARACTER
       && !INTEGER_CST_P (sym->ts.cl->backend_decl))
     {
-      gfc_conv_string_length (sym->ts.cl, &fnblock);
+      gfc_conv_string_length (sym->ts.cl, NULL, &fnblock);
       gfc_trans_vla_type_sizes (sym, &fnblock);
     }
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 140465)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -241,17 +241,102 @@ gfc_get_expr_charlen (gfc_expr *e)
   return length;
 }
 
-  
+
+/* For each character array constructor subexpression without a ts.cl->length,
+   replace it by its first element (if there aren't any elements, the length
+   should already be set to zero).  */
+
+static void
+flatten_array_ctors_without_strlen (gfc_expr* e)
+{
+  gfc_actual_arglist* arg;
+  gfc_constructor* c;
+
+  if (!e)
+    return;
+
+  switch (e->expr_type)
+    {
+
+    case EXPR_OP:
+      flatten_array_ctors_without_strlen (e->value.op.op1); 
+      flatten_array_ctors_without_strlen (e->value.op.op2); 
+      break;
+
+    case EXPR_COMPCALL:
+      /* TODO: Implement as with EXPR_FUNCTION when needed.  */
+      gcc_unreachable ();
+
+    case EXPR_FUNCTION:
+      for (arg = e->value.function.actual; arg; arg = arg->next)
+	flatten_array_ctors_without_strlen (arg->expr);
+      break;
+
+    case EXPR_ARRAY:
+
+      /* We've found what we're looking for.  */
+      if (e->ts.type == BT_CHARACTER && !e->ts.cl->length)
+	{
+	  gfc_expr* new_expr;
+	  gcc_assert (e->value.constructor);
+
+	  new_expr = e->value.constructor->expr;
+	  e->value.constructor->expr = NULL;
+
+	  flatten_array_ctors_without_strlen (new_expr);
+	  gfc_replace_expr (e, new_expr);
+	  break;
+	}
+
+      /* Otherwise, fall through to handle constructor elements.  */
+    case EXPR_STRUCTURE:
+      for (c = e->value.constructor; c; c = c->next)
+	flatten_array_ctors_without_strlen (c->expr);
+      break;
+
+    default:
+      break;
+
+    }
+}
+
 
 /* Generate code to initialize a string length variable. Returns the
-   value.  */
+   value.  For array constructors, cl->length might be NULL and in this case,
+   the first element of the constructor is needed.  expr is the original
+   expression so we can access it but can be NULL if this is not needed.  */
 
 void
-gfc_conv_string_length (gfc_charlen * cl, stmtblock_t * pblock)
+gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
 {
   gfc_se se;
 
   gfc_init_se (&se, NULL);
+
+  /* If cl->length is NULL, use gfc_conv_expr to obtain the string length but
+     "flatten" array constructors by taking their first element; all elements
+     should be the same length or a cl->length should be present.  */
+  if (!cl->length)
+    {
+      gfc_expr* expr_flat;
+      gcc_assert (expr);
+
+      expr_flat = gfc_copy_expr (expr);
+      flatten_array_ctors_without_strlen (expr_flat);
+      gfc_resolve_expr (expr_flat);
+
+      gfc_conv_expr (&se, expr_flat);
+      gfc_add_block_to_block (pblock, &se.pre);
+      cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
+
+      gfc_free_expr (expr_flat);
+      return;
+    }
+
+  /* Convert cl->length.  */
+
+  gcc_assert (cl->length);
+
   gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
   se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr,
 			 build_int_cst (gfc_charlen_type_node, 0));
@@ -2092,7 +2177,7 @@ gfc_conv_subref_array_arg (gfc_se * parm
 
   /* Build an ss for the temporary.  */
   if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
-    gfc_conv_string_length (expr->ts.cl, &parmse->pre);
+    gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre);
 
   base_type = gfc_typenode_for_spec (&expr->ts);
   if (GFC_ARRAY_TYPE_P (base_type)
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(revision 140465)
+++ gcc/fortran/trans.h	(working copy)
@@ -340,7 +340,7 @@ tree gfc_conv_string_tmp (gfc_se *, tree
 /* Get the string length variable belonging to an expression.  */
 tree gfc_get_expr_charlen (gfc_expr *);
 /* Initialize a string length variable.  */
-void gfc_conv_string_length (gfc_charlen *, stmtblock_t *);
+void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *);
 /* Ensure type sizes can be gimplified.  */
 void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);
 
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 140465)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -2583,7 +2583,7 @@ gfc_trans_dummy_character (gfc_symbol *s
   gfc_start_block (&body);
 
   /* Evaluate the string length expression.  */
-  gfc_conv_string_length (cl, &body);
+  gfc_conv_string_length (cl, NULL, &body);
 
   gfc_trans_vla_type_sizes (sym, &body);
 
@@ -2607,7 +2607,7 @@ gfc_trans_auto_character_variable (gfc_s
   gfc_start_block (&body);
 
   /* Evaluate the string length expression.  */
-  gfc_conv_string_length (sym->ts.cl, &body);
+  gfc_conv_string_length (sym->ts.cl, NULL, &body);
 
   gfc_trans_vla_type_sizes (sym, &body);
 
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90	(revision 0)
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! This test is run with result-checking and -fbounds-check as
+! nested_array_constructor_2.f90
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=2) :: c(3)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
+
+print *, c
+
+end
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90	(revision 0)
@@ -0,0 +1,22 @@
+! { dg-do run }
+
+! PR fortran/35846
+! Alternate test that also produced an ICE because of a missing length.
+
+PROGRAM test
+  IMPLICIT NONE
+  CHARACTER(LEN=2) :: x
+
+  x = 'a'
+  CALL sub ( (/ TRIM(x), 'a' /) // 'c')
+END PROGRAM
+
+SUBROUTINE sub(str)
+  IMPLICIT NONE
+  CHARACTER(LEN=*) :: str(2)
+  WRITE (*,*) str
+
+  IF (str(1) /= 'ac' .OR. str(2) /= 'ac') THEN
+    CALL abort ()
+  END IF
+END SUBROUTINE sub
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL, but it is switched around to test for the right operand of // being
+! not a constant, too.
+
+implicit none
+character(len=2) :: c(2)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /) // (/ trim(c(1)), 'a' /) /)
+
+print *, c
+
+end
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90	(revision 0)
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+
+! PR fortran/35846
+! This used to ICE because the charlength of the trim-expression was
+! NULL.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=2) :: c(3)
+
+c = 'a'
+c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
+
+print *, c
+
+if (c(1) /= 'ac' .or. c(2) /= 'ac' .or. c(3) /= 'cd') then
+  call abort ()
+end if
+
+end
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90	(revision 0)
@@ -0,0 +1,17 @@
+! { dg-do run }
+
+! PR fortran/35846
+! Alternate test that also produced an ICE because of a missing length.
+
+PROGRAM test
+  IMPLICIT NONE
+  CHARACTER(LEN=2) :: x
+  INTEGER :: length
+
+  x = 'a'
+  length = LEN ( (/ TRIM(x), 'a' /) // 'c')
+
+  IF (length /= 2) THEN
+    CALL abort ()
+  END IF
+END PROGRAM
Index: gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90	(revision 0)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+! PR fortran/35846
+! Nested three levels deep.
+
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+implicit none
+character(len=3) :: c(3)
+c = 'a'
+c = (/ (/ 'A'//(/ trim(c(1)), 'a' /)/)//'c', 'dcd' /)
+print *, c(1)
+print *, c(2)
+print *, c(3)
+end

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]