This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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] Fix PR36112: Bounds-checking on character-array-constructors


FX wrote:
Did I? AFAIK, I added this NULL thing only to get_array_ctor_strlen, and not to any of the others (as this function not only calculates the length but also is_const); there it is called with NULL argument for sub-array-constructors not at the first position (thus where we are not interested in the length).

You're right, I misread the patch. Please update the comment on top of get_array_ctor_strlen() accordingly/

Done.


This new patch emits the error unconditionally and fixes some test-cases
that used to be invalid due to such an array constructor.

With latest SVN fixes, the testsuite succeeds for me on GNU/Linux-x86-32.

Cheers,
Daniel

--
Done:     Bar-Sam-Val-Wiz, Dwa-Elf-Hum-Orc, Cha-Law, Fem-Mal
Underway: Ran-Gno-Neu-Fem
To go:    Arc-Cav-Hea-Kni-Mon-Pri-Rog-Tou

2008-05-18  Daniel Kraft  <d@domob.eu>

	PR fortran/36112
	* array.c (gfc_resolve_character_array_constructor):  Check that all
        elements with constant character length have the same one rather than
        fixing it if no typespec is given, emit an error if they don't.  Changed
        return type to "try" and return FAILURE for the case above.
	(gfc_resolve_array_constructor):  Removed unneeded call to
	gfc_resolve_character_array_constructor in this function.
        * gfortran.h (gfc_resolve_character_array_constructor):  Returns try.
	* trans-array.c (get_array_ctor_strlen):  Return length of first element
	rather than last element.
        * resolve.c (gfc_resolve_expr):  Handle FAILURE return from
        gfc_resolve_character_array_constructor.

2008-05-18  Daniel Kraft  <d@domob.eu>

	PR fortran/36112
	* bounds_check_array_ctor_1.f90:  New test.
	* bounds_check_array_ctor_2.f90:  New test.
	* bounds_check_array_ctor_3.f90:  New test.
	* bounds_check_array_ctor_4.f90:  New test.
	* bounds_check_array_ctor_5.f90:  New test.
	* bounds_check_array_ctor_6.f90:  New test.
	* bounds_check_array_ctor_7.f90:  New test.
	* bounds_check_array_ctor_8.f90:  New test.
        * arrayio_0.f90:  Fixed invalid array constructor.
        * char_cons_len.f90:  Ditto.
        * char_initializer_actual.f90:  Ditto.
        * pr15959.f90:  Ditto.
        * transfer_simplify_2.f90:  Ditto.
        * char_length_1.f90:  Changed expected error messages.
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 135574)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -1454,6 +1454,9 @@ get_array_ctor_all_strlen (stmtblock_t *
 
 
 /* Figure out the string length of a character array constructor.
+   If len is NULL, don't calculate the length; this happens for recursive calls
+   when a sub-array-constructor is an element but not at the first position,
+   so when we're not interested in the length.
    Returns TRUE if all elements are character constants.  */
 
 bool
@@ -1465,16 +1468,20 @@ get_array_ctor_strlen (stmtblock_t *bloc
 
   if (c == NULL)
     {
-      *len = build_int_cstu (gfc_charlen_type_node, 0);
+      if (len)
+	*len = build_int_cstu (gfc_charlen_type_node, 0);
       return is_const;
     }
 
-  for (; c; c = c->next)
+  /* Loop over all constructor elements to find out is_const, but in len we
+     want to store the length of the first, not the last, element.  We can
+     of course exit the loop as soon as is_const is found to be false.  */
+  for (; c && is_const; c = c->next)
     {
       switch (c->expr->expr_type)
 	{
 	case EXPR_CONSTANT:
-	  if (!(*len && INTEGER_CST_P (*len)))
+	  if (len && !(*len && INTEGER_CST_P (*len)))
 	    *len = build_int_cstu (gfc_charlen_type_node,
 				   c->expr->value.character.length);
 	  break;
@@ -1486,14 +1493,19 @@ get_array_ctor_strlen (stmtblock_t *bloc
 
 	case EXPR_VARIABLE:
 	  is_const = false;
-	  get_array_ctor_var_strlen (c->expr, len);
+	  if (len)
+	    get_array_ctor_var_strlen (c->expr, len);
 	  break;
 
 	default:
 	  is_const = false;
-	  get_array_ctor_all_strlen (block, c->expr, len);
+	  if (len)
+	    get_array_ctor_all_strlen (block, c->expr, len);
 	  break;
 	}
+
+      /* After the first iteration, we don't want the length modified.  */
+      len = NULL;
     }
 
   return is_const;
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 135574)
+++ gcc/fortran/array.c	(working copy)
@@ -1576,23 +1576,20 @@ resolve_array_list (gfc_constructor *p)
   return t;
 }
 
-/* Resolve character array constructor. If it is a constant character array and
-   not specified character length, update character length to the maximum of
-   its element constructors' length.  For arrays with fixed length, pad the
-   elements as necessary with needed_length.  */
+/* Resolve character array constructor. If it has a specified constant character
+   length, pad/trunkate the elements here; if the length is not specified and
+   all elements are of compile-time known length, emit an error as this is
+   invalid.  */
 
-void
+try
 gfc_resolve_character_array_constructor (gfc_expr *expr)
 {
   gfc_constructor *p;
-  int max_length;
-  bool generated_length;
+  int found_length;
 
   gcc_assert (expr->expr_type == EXPR_ARRAY);
   gcc_assert (expr->ts.type == BT_CHARACTER);
 
-  max_length = -1;
-
   if (expr->ts.cl == NULL)
     {
       for (p = expr->value.constructor; p; p = p->next)
@@ -1611,15 +1608,16 @@ gfc_resolve_character_array_constructor 
 
 got_charlen:
 
-  generated_length = false;
+  found_length = -1;
+
   if (expr->ts.cl->length == NULL)
     {
-      /* Find the maximum length of the elements. Do nothing for variable
-	 array constructor, unless the character length is constant or
-	 there is a constant substring reference.  */
+      /* Check that all constant string elements have the same length until
+	 we reach the end or find a variable-length one.  */
 
       for (p = expr->value.constructor; p; p = p->next)
 	{
+	  int current_length = -1;
 	  gfc_ref *ref;
 	  for (ref = p->expr->ref; ref; ref = ref->next)
 	    if (ref->type == REF_SUBSTRING
@@ -1628,32 +1626,43 @@ got_charlen:
 	      break;
 
 	  if (p->expr->expr_type == EXPR_CONSTANT)
-	    max_length = MAX (p->expr->value.character.length, max_length);
+	    current_length = p->expr->value.character.length;
 	  else if (ref)
 	    {
 	      long j;
 	      j = mpz_get_ui (ref->u.ss.end->value.integer)
 		- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
-	      max_length = MAX ((int) j, max_length);
+	      current_length = (int) j;
 	    }
 	  else if (p->expr->ts.cl && p->expr->ts.cl->length
 		   && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
 	    {
 	      long j;
 	      j = mpz_get_si (p->expr->ts.cl->length->value.integer);
-	      max_length = MAX ((int) j, max_length);
+	      current_length = (int) j;
 	    }
 	  else
-	    return;
-	}
+	    return SUCCESS;
 
-      if (max_length != -1)
-	{
-	  /* Update the character length of the array constructor.  */
-	  expr->ts.cl->length = gfc_int_expr (max_length);
-	  generated_length = true;
-	  /* Real update follows below.  */
+	  gcc_assert (current_length != -1);
+
+	  if (found_length == -1)
+	    found_length = current_length;
+	  else if (found_length != current_length)
+	    {
+	      gfc_error ("Different CHARACTER lengths (%d/%d) in array"
+			 " constructor at %L", found_length, current_length,
+			 &p->expr->where);
+	      return FAILURE;
+	    }
+
+	  gcc_assert (found_length == current_length);
 	}
+
+      gcc_assert (found_length != -1);
+
+      /* Update the character length of the array constructor.  */
+      expr->ts.cl->length = gfc_int_expr (found_length);
     }
   else 
     {
@@ -1664,33 +1673,35 @@ got_charlen:
       /* If we've got a constant character length, pad according to this.
 	 gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
 	 max_length only if they pass.  */
-      gfc_extract_int (expr->ts.cl->length, &max_length);
-    }
+      gfc_extract_int (expr->ts.cl->length, &found_length);
 
-  /* Found a length to update to, do it for all element strings shorter than
-     the target length.  */
-  if (max_length != -1)
-    {
-      for (p = expr->value.constructor; p; p = p->next)
-	if (p->expr->expr_type == EXPR_CONSTANT)
-	  {
-	    gfc_expr *cl = NULL;
-	    int current_length = -1;
-
-	    if (p->expr->ts.cl && p->expr->ts.cl->length)
-	    {
-	      cl = p->expr->ts.cl->length;
-	      gfc_extract_int (cl, &current_length);
-	    }
-
-	    /* If gfc_extract_int above set current_length, we implicitly
-	       know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
-
-	    if (generated_length || ! cl
-		|| (current_length != -1 && current_length < max_length))
-	      gfc_set_constant_character_len (max_length, p->expr, true);
-	  }
+      /* Now pad/trunkate the elements accordingly to the specified character
+	 length.  This is ok inside this conditional, as in the case above
+	 (without typespec) all elements are verified to have the same length
+	 anyway.  */
+      if (found_length != -1)
+        for (p = expr->value.constructor; p; p = p->next)
+          if (p->expr->expr_type == EXPR_CONSTANT)
+            {
+              gfc_expr *cl = NULL;
+              int current_length = -1;
+
+              if (p->expr->ts.cl && p->expr->ts.cl->length)
+              {
+                cl = p->expr->ts.cl->length;
+                gfc_extract_int (cl, &current_length);
+              }
+
+              /* If gfc_extract_int above set current_length, we implicitly
+                 know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
+
+              if (! cl
+                  || (current_length != -1 && current_length < found_length))
+                gfc_set_constant_character_len (found_length, p->expr, true);
+            }
     }
+
+  return SUCCESS;
 }
 
 
@@ -1704,8 +1715,10 @@ gfc_resolve_array_constructor (gfc_expr 
   t = resolve_array_list (expr->value.constructor);
   if (t == SUCCESS)
     t = gfc_check_constructor_type (expr);
-  if (t == SUCCESS && expr->ts.type == BT_CHARACTER)
-    gfc_resolve_character_array_constructor (expr);
+
+  /* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after
+     the call to this function, so we don't need to call it here; if it was
+     called twice, an error message there would be duplicated.  */
 
   return t;
 }
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 135574)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2339,7 +2339,7 @@ void gfc_simplify_iterator_var (gfc_expr
 try gfc_expand_constructor (gfc_expr *);
 int gfc_constant_ac (gfc_expr *);
 int gfc_expanded_ac (gfc_expr *);
-void gfc_resolve_character_array_constructor (gfc_expr *);
+try gfc_resolve_character_array_constructor (gfc_expr *);
 try gfc_resolve_array_constructor (gfc_expr *);
 try gfc_check_constructor_type (gfc_expr *);
 try gfc_check_iter_variable (gfc_expr *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 135574)
+++ gcc/fortran/resolve.c	(working copy)
@@ -4340,8 +4340,8 @@ gfc_resolve_expr (gfc_expr *e)
       /* This provides the opportunity for the length of constructors with
 	 character valued function elements to propagate the string length
 	 to the expression.  */
-      if (e->ts.type == BT_CHARACTER)
-	gfc_resolve_character_array_constructor (e);
+      if (t == SUCCESS && e->ts.type == BT_CHARACTER)
+	t = gfc_resolve_character_array_constructor (e);
 
       break;
 
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(3)
+    arr = (/ "this is long", "this one too", s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(12/5\\) in array constructor" }
Index: gcc/testsuite/gfortran.dg/pr15959.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr15959.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/pr15959.f90	(working copy)
@@ -1,5 +1,5 @@
 ! { dg-do run }
 ! Test initializer of character array. PR15959
-character (*), parameter :: a (1:2) = (/'ab', 'abc'/)
+character (*), parameter :: a (1:2) = (/'ab ', 'abc'/)
 if (a(2) .ne. 'abc') call abort()
 end
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(3)
+    arr = (/ s, "this is long", "this one too" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }
Index: gcc/testsuite/gfortran.dg/char_initialiser_actual.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_initialiser_actual.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/char_initialiser_actual.f90	(working copy)
@@ -5,10 +5,10 @@
 program char_initialiser
   character*5, dimension(3) :: x
   character*5, dimension(:), pointer :: y
-  x=(/"is Ja","ne Fo","nda"/)
+  x=(/"is Ja","ne Fo","nda  "/)
   call sfoo ("is Ja", x(1))
-  call afoo ((/"is Ja","ne Fo","nda"/), x)
-  y => pfoo ((/"is Ja","ne Fo","nda"/))
+  call afoo ((/"is Ja","ne Fo","nda  "/), x)
+  y => pfoo ((/"is Ja","ne Fo","nda  "/))
   call afoo (y, x)
 contains
   subroutine sfoo(ch1, ch2)
Index: gcc/testsuite/gfortran.dg/transfer_simplify_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/transfer_simplify_2.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/transfer_simplify_2.f90	(working copy)
@@ -92,7 +92,7 @@ contains
   end subroutine integer8_to_complex4
 
   subroutine character16_to_complex8
-    character(16), parameter ::  c1(2) = (/"abcdefghijklmnop","qrstuvwxyz1234567890"/)
+    character(16), parameter ::  c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
     character(16)            ::  c2(2) = c1
     complex(8), parameter    ::  z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
     complex(8)               ::  z2(2)
Index: gcc/testsuite/gfortran.dg/arrayio_0.f90
===================================================================
--- gcc/testsuite/gfortran.dg/arrayio_0.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/arrayio_0.f90	(working copy)
@@ -8,7 +8,7 @@
   character(len=48), dimension(2) :: iue
   equivalence (iu, iue)
   integer, dimension(4) :: v = (/2,1,4,3/)
-  iu = (/"Vector","subscripts","not","allowed!"/)
+  iu = (/"Vector    ","subscripts","not       ","allowed!  "/)
   read (iu, '(a12/)') buff
   read (iue(1), '(4a12)') buff
   read (iu(4:1:-1), '(a12/)') buff
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("this is long")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(2)
+    arr = (/ s, "abc" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(12/3\\) in array constructor" }
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("this is long")
+contains
+  subroutine test(s)
+    character(len=*) :: s
+    character(len=128) :: arr(2)
+    arr = (/ "abc", s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(3/12\\) in array constructor" }
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90	(revision 0)
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+! This should not need any -fbounds-check and is enabled all the time.
+
+  character(len=128) :: arr(2) = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
+  arr = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" }
+end
Index: gcc/testsuite/gfortran.dg/char_cons_len.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_cons_len.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/char_cons_len.f90	(working copy)
@@ -3,7 +3,7 @@
 ! constructor, as an argument for LEN, would cause an ICE.
 !
   character(11) :: chr1, chr2
-  i = len ((/chr1, chr2, "ggg"/))
+  i = len ((/chr1, chr2, "ggg        "/))
   j = len ((/"abcdefghijk", chr1, chr2/))
   k = len ((/'hello  ','goodbye'/))
   l = foo ("yes siree, Bob")
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short", "this is long")
+contains
+  subroutine test(r, s)
+    character(len=*) :: r, s
+    character(len=128) :: arr(2)
+    arr = (/ r, s /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" }
Index: gcc/testsuite/gfortran.dg/char_length_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_length_1.f90	(revision 135575)
+++ gcc/testsuite/gfortran.dg/char_length_1.f90	(working copy)
@@ -7,12 +7,13 @@
 ! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de> 
 !
 program test
+  implicit none
   character(10) :: a(3)
   character(10) :: b(3)= &
-       (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "same length" }
+       (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
   character(4) :: c = "abcde"  ! { dg-warning "being truncated" }
-  a =  (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "same length" }
+  a =  (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "Different CHARACTER" }
   a =  (/ 'Takata ', 'Tanaka ', 'Hayashi' /)
-  b = "abc"
+  b = "abc" ! { dg-error "no IMPLICIT" }
   c = "abcdefg"   ! { dg-warning "will be truncated" }
 end program test
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90	(revision 0)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+! No need for -fbounds-check, enabled unconditionally.
+
+  character(len=5) :: s = "hello"
+  character(len=128) :: arr(3)
+  arr = (/ "abc", "foo", s /) ! { dg-error "Different CHARACTER lengths" }
+end
Index: gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "foo" }
+!
+! PR 36112
+! Check correct bounds-checking behaviour for character-array-constructors.
+
+  call test ("short", "also5")
+contains
+  subroutine test(r, s)
+    character(len=*) :: r, s
+    character(len=128) :: arr(3)
+    arr = (/ r, s, "this is too long" /)
+  end subroutine test
+end
+! { dg-output "Different CHARACTER lengths \\(5/16\\) in array constructor" }

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