[Patch, Fortran] Fix PRs 36492 and 36517: Wrong error-messages for character array ctors and ICE

[Daniel Kraft <d at domob dot eu>]

Hi,

attached is a patch that fixes both PR fortran/36492 and PR
fortran/36517; its an extended version of the patch attached in PR 36517.

To solve the problem with wrong error messages on valid array
constructors I changed the third argument of
gfc_set_constant_character_len from bool array to int check_len; this
allows to check for a common length inside an array constructor that is
not neccessarily equal to the target length of the length change (as was
the problem for PR 36492).  I updated the calls to this function
accordingly and added tests for typespec on the array constructor where
appropriate to disable this check for ctors with typespec.

In decl.c:build_struct I also added additional conditions to a branch
that prevent an ICE on invalid code.  This just skips the branch in this
case as assumptions made would be wrong and the compilation is aborted
with an error message anyway, so we don't need this branch's work.

Regression-tested on GNU/Linux-x86-32, only parameter_array_init_4.f90 
failed, see PR 36534/36535.  I hope it's ok as it is implemented.

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-06-13  Daniel Kraft  <d@domob.eu>

	PR fortran/36517, fortran/36492
	* array_constructor_25.f03:  New test.
	* array_constructor_26.f03:  New test.
	* array_constructor_27.f03:  New test.
	* array_constructor_28.f03:  New test.
	* array_constructor_29.f03:  New test.
	* array_constructor_30.f03:  New test.
	* array_constructor_type_19.f03:  New test.
	* array_constructor_type_20.f03:  New test.
	* array_constructor_type_21.f03:  New test.

2008-06-13  Daniel Kraft  <d@domob.eu>

	PR fortran/36517, fortran/36492
	* array.c (gfc_resolve_character_array_constructor):  Call
	gfc_set_constant_character_len with changed length-chec argument.
	* decl.c (gfc_set_constant_character_len):  Changed array argument to
	be a generic length-checking argument that can be used for correct
	checking with typespec and in special cases where the should-be length
	is different from the target length.
	(build_struct):  Call gfc_set_constant_character_len with changed length
	checking argument and introduced additional checks for exceptional
	conditions on invalid code.
	(add_init_expr_to_sym), (do_parm):  Call gfc_set_constant_character_len
	with changed argument.
	* match.h (gfc_set_constant_character_len):  Changed third argument to
	int for the should-be length rather than bool.

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 136762)
+++ gcc/fortran/decl.c	(working copy)
@@ -1084,10 +1084,12 @@ build_sym (const char *name, gfc_charlen
 
 
 /* Set character constant to the given length. The constant will be padded or
-   truncated.  */
+   truncated.  If we're inside an array constructor without a typespec, we
+   additionally check that all elements have the same length; check_len -1
+   means no checking.  */
 
 void
-gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
+gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
 {
   gfc_char_t *s;
   int slen;
@@ -1110,10 +1112,11 @@ gfc_set_constant_character_len (int len,
 
       /* Apply the standard by 'hand' otherwise it gets cleared for
 	 initializers.  */
-      if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU))
+      if (check_len != -1 && slen != check_len
+          && !(gfc_option.allow_std & GFC_STD_GNU))
 	gfc_error_now ("The CHARACTER elements of the array constructor "
 		       "at %L must have the same length (%d/%d)",
-			&expr->where, slen, len);
+			&expr->where, slen, check_len);
 
       s[len] = '\0';
       gfc_free (expr->value.character.string);
@@ -1269,7 +1272,7 @@ add_init_expr_to_sym (const char *name, 
 	      gfc_constructor * p;
 
 	      if (init->expr_type == EXPR_CONSTANT)
-		gfc_set_constant_character_len (len, init, false);
+		gfc_set_constant_character_len (len, init, -1);
 	      else if (init->expr_type == EXPR_ARRAY)
 		{
 		  /* Build a new charlen to prevent simplification from
@@ -1280,7 +1283,7 @@ add_init_expr_to_sym (const char *name, 
 		  init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
 
 		  for (p = init->value.constructor; p; p = p->next)
-		    gfc_set_constant_character_len (len, p->expr, false);
+		    gfc_set_constant_character_len (len, p->expr, -1);
 		}
 	    }
 	}
@@ -1402,19 +1405,49 @@ build_struct (const char *name, gfc_char
 
   /* Should this ever get more complicated, combine with similar section
      in add_init_expr_to_sym into a separate function.  */
-  if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer)
+  if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer && c->ts.cl
+      && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT)
     {
-      int len = mpz_get_si (c->ts.cl->length->value.integer);
+      int len;
+
+      gcc_assert (c->ts.cl && c->ts.cl->length);
+      gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT);
+      gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER);
+      gcc_assert (c->initializer->ts.cl && c->initializer->ts.cl->length);
+
+      len = mpz_get_si (c->ts.cl->length->value.integer);
 
       if (c->initializer->expr_type == EXPR_CONSTANT)
-	gfc_set_constant_character_len (len, c->initializer, false);
+	gfc_set_constant_character_len (len, c->initializer, -1);
       else if (mpz_cmp (c->ts.cl->length->value.integer,
 			c->initializer->ts.cl->length->value.integer))
 	{
+	  bool has_ts;
 	  gfc_constructor *ctor = c->initializer->value.constructor;
-	  for (;ctor ; ctor = ctor->next)
-	    if (ctor->expr->expr_type == EXPR_CONSTANT)
-	      gfc_set_constant_character_len (len, ctor->expr, true);
+
+	  bool first = true;
+	  int first_len;
+
+	  has_ts = (c->initializer->ts.cl
+		    && c->initializer->ts.cl->length_from_typespec);
+
+	  for (; ctor; ctor = ctor->next)
+	    {
+	      /* Remember the length of the first element for checking that
+		 all elements *in the constructor* have the same length.  This
+		 need not be the length of the LHS!  */
+	      if (first)
+		{
+		  gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
+		  gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
+		  first_len = ctor->expr->value.character.length;
+		  first = false;
+		}
+
+	      if (ctor->expr->expr_type == EXPR_CONSTANT)
+		gfc_set_constant_character_len (len, ctor->expr,
+						has_ts ? -1 : first_len);
+	    }
 	}
     }
 
@@ -5822,7 +5855,7 @@ do_parm (void)
       && init->expr_type == EXPR_CONSTANT
       && init->ts.type == BT_CHARACTER)
     gfc_set_constant_character_len (
-      mpz_get_si (sym->ts.cl->length->value.integer), init, false);
+      mpz_get_si (sym->ts.cl->length->value.integer), init, -1);
   else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL
 	   && sym->ts.cl->length == NULL)
 	{
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 136762)
+++ gcc/fortran/array.c	(working copy)
@@ -1676,6 +1676,7 @@ got_charlen:
 	  {
 	    gfc_expr *cl = NULL;
 	    int current_length = -1;
+	    bool has_ts;
 
 	    if (p->expr->ts.cl && p->expr->ts.cl->length)
 	    {
@@ -1683,12 +1684,15 @@ got_charlen:
 	      gfc_extract_int (cl, &current_length);
 	    }
 
+	    has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec);
+
 	    /* 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);
+	      gfc_set_constant_character_len (max_length, p->expr,
+                                              has_ts ? -1 : max_length);
 	  }
     }
 }
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 136762)
+++ gcc/fortran/match.h	(working copy)
@@ -147,7 +147,7 @@ match gfc_match_final_decl (void);
 match gfc_match_implicit_none (void);
 match gfc_match_implicit (void);
 
-void gfc_set_constant_character_len (int, gfc_expr *, bool);
+void gfc_set_constant_character_len (int, gfc_expr *, int);
 
 /* Matchers for attribute declarations.  */
 match gfc_match_allocatable (void);
Index: gcc/testsuite/gfortran.dg/array_constructor_30.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_30.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_30.f03	(revision 0)
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Similar to the ICE-test, but now test for complaint about constant
+! specification expression.
+
+implicit none
+
+integer :: a = 42
+type t
+  character (a) :: arr (1) = [ "a" ]
+  ! { dg-error "in the expression" "" { target *-*-* } 11 }
+  ! { dg-error "specification expression" "" { target *-*-* } 11 }
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_type_20.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_20.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_20.f03	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36517
+! Check for incorrect error message with -std=f2003.
+! This is the original test from PR 36517.
+
+CHARACTER (len=*) MY_STRING(1:3)
+PARAMETER ( MY_STRING = (/ CHARACTER (len=3) :: "AC", "B", "C" /) )
+CHARACTER (len=*), PARAMETER :: str(2) = [ CHARACTER (len=3) :: 'A', 'cc' ]
+END
Index: gcc/testsuite/gfortran.dg/array_constructor_type_21.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_21.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_21.f03	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check that it works with a typespec even for not-the-same-length elements.
+
+type t
+  character (1) :: arr (2) = [ character(len=2) :: "a", "ab" ]
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_25.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_25.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_25.f03	(revision 0)
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Reduced test based on the one from comment #4, PR 36492.
+
+type t
+  character (2) :: arr (1) = [ "a" ]
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_26.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_26.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_26.f03	(revision 0)
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Test from comment #4, PR 36492 causing ICE.
+
+MODULE WinData
+  IMPLICIT NONE
+  INTEGER (1), PARAMETER :: MAXFLD = 25_1, MAXHED = 5_1, MAXCHR = 80_1
+  integer :: i
+  TYPE TWindowData
+    CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
+    ! { dg-error "no IMPLICIT type" "" { target *-*-* } 12 }
+    ! { dg-error "specification expression" "" { target *-*-* } 12 }
+  END TYPE TWindowData
+END MODULE WinData
+
+! { dg-final { cleanup-modules "WinData" } }
Index: gcc/testsuite/gfortran.dg/array_constructor_27.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_27.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_27.f03	(revision 0)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Check for incorrect error message with -std=f2003.
+! Reduced test triggering the ICE mentioned in comment #4, PR 36492.
+
+implicit none
+
+type t
+  character (a) :: arr (1) = [ "a" ]
+  ! { dg-error "no IMPLICIT type" "" { target *-*-* } 10 }
+  ! { dg-error "specification expression" "" { target *-*-* } 10 }
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_28.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_28.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_28.f03	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36492
+! Check that the error is still emitted for really incorrect constructor.
+
+type t
+  character (2) :: arr (2) = [ "a", "ab" ] ! { dg-error "same length" }
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_29.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_29.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_29.f03	(revision 0)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+! PR fortran/36492
+! Similar to the ICE-test, but now test it works for real constants.
+
+implicit none
+
+integer, parameter :: a = 42
+type t
+  character (a) :: arr (1) = [ "a" ]
+end type t
+
+end
Index: gcc/testsuite/gfortran.dg/array_constructor_type_19.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_19.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_19.f03	(revision 0)
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+
+! PR fortran/36517
+! Check for incorrect error message with -std=f2003.
+! This is the test of comment #1, PR 36517.
+
+print *, [ character(len=2) :: 'a', 'bb' ]
+end