re PR fortran/27997 (Fortran 2003: Support type-spec for array constructor)

2008-04-16  Daniel Kraft  <d@domob.eu>

        PR fortran/27997
        * gfortran.h:  Added field "length_from_typespec" to gfc_charlength.
        * aray.c (gfc_match_array_constructor):  Added code to parse
        * typespec.
        (check_element_type, check_constructor_type, gfc_check_constructor_type):
        Extended to support explicit typespec on constructor.
        (gfc_resolve_character_array_constructor):  Pad strings correctly for
        explicit, constant character length.
        * trans-array.c:  New static global variable
        * "typespec_chararray_ctor"
        (gfc_trans_array_constructor):  New code to support explicit but dynamic
        character lengths.

2008-04-16  Daniel Kraft  <d@domob.eu>

        PR fortran/27997
        * gfortran.dg/array_constructor_type_1.f03:  New test
        * gfortran.dg/array_constructor_type_2.f03:  New test
        * gfortran.dg/array_constructor_type_3.f03:  New test
        * gfortran.dg/array_constructor_type_4.f03:  New test
        * gfortran.dg/array_constructor_type_5.f03:  New test
        * gfortran.dg/array_constructor_type_6.f03:  New test
        * gfortran.dg/array_constructor_type_7.f03:  New test
        * gfortran.dg/array_constructor_type_8.f03:  New test
        * gfortran.dg/array_constructor_type_9.f:  New test
        * gfortran.dg/array_constructor_type_10.f03:  New test
        * gfortran.dg/array_constructor_type_11.f03:  New test
        * gfortran.dg/array_constructor_type_12.f03:  New test
        * gfortran.dg/array_constructor_type_13.f90:  New test
        * gfortran.dg/array_constructor_type_14.f03:  New test
        * gfortran.dg/array_constructor_type_15.f03:  New test
        * gfortran.dg/array_constructor_type_16.f03:  New test
        * gfortran.dg/array_constructor_type_17.f03:  New test
        * gfortran.dg/array_constructor_type_18.f03:  New test

From-SVN: r135439

4 files changed, 149 insertions, 25 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73bd3e2..ef9f1cf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,12 +1,25 @@
+2008-04-16  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/27997
+	* gfortran.h:  Added field "length_from_typespec" to gfc_charlength.
+	* aray.c (gfc_match_array_constructor):  Added code to parse typespec.
+	(check_element_type, check_constructor_type, gfc_check_constructor_type):
+	Extended to support explicit typespec on constructor.
+	(gfc_resolve_character_array_constructor):  Pad strings correctly for
+	explicit, constant character length.
+	* trans-array.c:  New static global variable "typespec_chararray_ctor"
+	(gfc_trans_array_constructor):  New code to support explicit but dynamic
+	character lengths.
+
 2008-05-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
-    PR fortran/34325
-    * decl.c (match_attr_spec): Check for matching pairs of parenthesis.
-    * expr.c (gfc_specification_expr): Supplement the error message with the
-    type that was found.
-    * resolve.c (gfc_resolve_index): Likewise.
-    * match.c (gfc_match_parens): Clarify error message with "at or before".
-    (gfc_match_do): Check for matching pairs of parenthesis.
+	PR fortran/34325
+	* decl.c (match_attr_spec): Check for matching pairs of parenthesis.
+	* expr.c (gfc_specification_expr): Supplement the error message with the
+	type that was found.
+	* resolve.c (gfc_resolve_index): Likewise.
+	* match.c (gfc_match_parens): Clarify error message with "at or before".
+	(gfc_match_do): Check for matching pairs of parenthesis.
 
 2008-05-16  Tobias Burnus  <burnus@net-b.de
 
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index adc3f3f..71c8b5d 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -877,9 +877,11 @@ gfc_match_array_constructor (gfc_expr **result)
 {
   gfc_constructor *head, *tail, *new;
   gfc_expr *expr;
+  gfc_typespec ts;
   locus where;
   match m;
   const char *end_delim;
+  bool seen_ts;
 
   if (gfc_match (" (/") == MATCH_NO)
     {
@@ -898,11 +900,33 @@ gfc_match_array_constructor (gfc_expr **result)
 
   where = gfc_current_locus;
   head = tail = NULL;
+  seen_ts = false;
+
+  /* Try to match an optional "type-spec ::"  */
+  if (gfc_match_type_spec (&ts, 0) == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
+			      "including type specification at %C") == FAILURE)
+	    goto cleanup;
+	}
+    }
+
+  if (! seen_ts)
+    gfc_current_locus = where;
 
   if (gfc_match (end_delim) == MATCH_YES)
     {
-      gfc_error ("Empty array constructor at %C is not allowed");
-      goto cleanup;
+      if (seen_ts)
+	goto done;
+      else
+	{
+	  gfc_error ("Empty array constructor at %C is not allowed");
+	  goto cleanup;
+	}
     }
 
   for (;;)
@@ -927,6 +951,7 @@ gfc_match_array_constructor (gfc_expr **result)
   if (gfc_match (end_delim) == MATCH_NO)
     goto syntax;
 
+done:
   expr = gfc_get_expr ();
 
   expr->expr_type = EXPR_ARRAY;
@@ -934,6 +959,14 @@ gfc_match_array_constructor (gfc_expr **result)
   expr->value.constructor = head;
   /* Size must be calculated at resolution time.  */
 
+  if (seen_ts)
+    expr->ts = ts;
+  else
+    expr->ts.type = BT_UNKNOWN;
+  
+  if (expr->ts.cl)
+    expr->ts.cl->length_from_typespec = seen_ts;
+
   expr->where = where;
   expr->rank = 1;
 
@@ -964,7 +997,7 @@ static enum
 cons_state;
 
 static int
-check_element_type (gfc_expr *expr)
+check_element_type (gfc_expr *expr, bool convert)
 {
   if (cons_state == CONS_BAD)
     return 0;			/* Suppress further errors */
@@ -985,6 +1018,9 @@ check_element_type (gfc_expr *expr)
   if (gfc_compare_types (&constructor_ts, &expr->ts))
     return 0;
 
+  if (convert)
+    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
+
   gfc_error ("Element in %s array constructor at %L is %s",
 	     gfc_typename (&constructor_ts), &expr->where,
 	     gfc_typename (&expr->ts));
@@ -997,7 +1033,7 @@ check_element_type (gfc_expr *expr)
 /* Recursive work function for gfc_check_constructor_type().  */
 
 static try
-check_constructor_type (gfc_constructor *c)
+check_constructor_type (gfc_constructor *c, bool convert)
 {
   gfc_expr *e;
 
@@ -1007,13 +1043,13 @@ check_constructor_type (gfc_constructor *c)
 
       if (e->expr_type == EXPR_ARRAY)
 	{
-	  if (check_constructor_type (e->value.constructor) == FAILURE)
+	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
 	    return FAILURE;
 
 	  continue;
 	}
 
-      if (check_element_type (e))
+      if (check_element_type (e, convert))
 	return FAILURE;
     }
 
@@ -1029,10 +1065,20 @@ gfc_check_constructor_type (gfc_expr *e)
 {
   try t;
 
-  cons_state = CONS_START;
-  gfc_clear_ts (&constructor_ts);
+  if (e->ts.type != BT_UNKNOWN)
+    {
+      cons_state = CONS_GOOD;
+      constructor_ts = e->ts;
+    }
+  else
+    {
+      cons_state = CONS_START;
+      gfc_clear_ts (&constructor_ts);
+    }
 
-  t = check_constructor_type (e->value.constructor);
+  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
+     typespec, and we will now convert the values on the fly.  */
+  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
   if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
     e->ts = constructor_ts;
 
@@ -1526,13 +1572,15 @@ resolve_array_list (gfc_constructor *p)
 
 /* 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.  */
+   its element constructors' length.  For arrays with fixed length, pad the
+   elements as necessary with needed_length.  */
 
 void
 gfc_resolve_character_array_constructor (gfc_expr *expr)
 {
   gfc_constructor *p;
   int max_length;
+  bool generated_length;
 
   gcc_assert (expr->expr_type == EXPR_ARRAY);
   gcc_assert (expr->ts.type == BT_CHARACTER);
@@ -1557,6 +1605,7 @@ gfc_resolve_character_array_constructor (gfc_expr *expr)
 
 got_charlen:
 
+  generated_length = false;
   if (expr->ts.cl->length == NULL)
     {
       /* Find the maximum length of the elements. Do nothing for variable
@@ -1596,12 +1645,46 @@ got_charlen:
 	{
 	  /* Update the character length of the array constructor.  */
 	  expr->ts.cl->length = gfc_int_expr (max_length);
-	  /* Update the element constructors.  */
-	  for (p = expr->value.constructor; p; p = p->next)
-	    if (p->expr->expr_type == EXPR_CONSTANT)
-	      gfc_set_constant_character_len (max_length, p->expr, true);
+	  generated_length = true;
+	  /* Real update follows below.  */
 	}
     }
+  else 
+    {
+      /* We've got a character length specified.  It should be an integer,
+	 otherwise an error is signalled elsewhere.  */
+      gcc_assert (expr->ts.cl->length);
+
+      /* 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);
+    }
+
+  /* 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);
+	  }
+    }
 }
 
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bf80847..5fa3bc1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -784,6 +784,7 @@ typedef struct gfc_charlen
 {
   struct gfc_expr *length;
   struct gfc_charlen *next;
+  bool length_from_typespec; /* Length from explicit array ctor typespec?  */
   tree backend_decl;
 
   int resolved;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 3c099dd..d6464ca 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -959,9 +959,10 @@ gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
 }
 
 
-/* Assign an element of an array constructor.  */
+/* Variables needed for bounds-checking.  */
 static bool first_len;
 static tree first_len_val; 
+static bool typespec_chararray_ctor;
 
 static void
 gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
@@ -998,7 +999,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
 				 se->string_length,
 				 se->expr);
 	}
-      if (flag_bounds_check)
+      if (flag_bounds_check && !typespec_chararray_ctor)
 	{
 	  if (first_len)
 	    {
@@ -1677,7 +1678,13 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
   tree loopfrom;
   bool dynamic;
 
-  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
+  /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
+     typespec was given for the array constructor.  */
+  typespec_chararray_ctor = (ss->expr->ts.cl
+			     && ss->expr->ts.cl->length_from_typespec);
+
+  if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER
+      && !typespec_chararray_ctor)
     {  
       first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
       first_len = true;
@@ -1688,7 +1695,27 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
   c = ss->expr->value.constructor;
   if (ss->expr->ts.type == BT_CHARACTER)
     {
-      bool const_string = get_array_ctor_strlen (&loop->pre, c, &ss->string_length);
+      bool const_string;
+      
+      /* get_array_ctor_strlen walks the elements of the constructor, if a
+	 typespec was given, we already know the string length and want the one
+	 specified there.  */
+      if (typespec_chararray_ctor && ss->expr->ts.cl->length
+	  && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT)
+	{
+	  gfc_se length_se;
+
+	  const_string = false;
+	  gfc_init_se (&length_se, NULL);
+	  gfc_conv_expr_type (&length_se, ss->expr->ts.cl->length,
+			      gfc_charlen_type_node);
+	  ss->string_length = length_se.expr;
+	  gfc_add_block_to_block (&loop->pre, &length_se.pre);
+	  gfc_add_block_to_block (&loop->post, &length_se.post);
+	}
+      else
+	const_string = get_array_ctor_strlen (&loop->pre, c,
+					      &ss->string_length);
 
       /* Complex character array constructors should have been taken care of
 	 and not end up here.  */