re PR fortran/39865 (ICE in gfc_conv_scalarized_array_ref)

	PR fortran/39865
	* io.c (resolve_tag_format): CHARACTER array in FMT= argument
	isn't an extension.  Reject non-CHARACTER array element of
	assumed shape or pointer or assumed size array.
	* trans-array.c (array_parameter_size): New function.
	(gfc_conv_array_parameter): Add size argument.  Call
	array_parameter_size if it is non-NULL.
	* trans-array.h (gfc_conv_array_parameter): Adjust prototype.
	* trans-expr.c (gfc_conv_function_call, gfc_trans_arrayfunc_assign):
	Adjust callers.
	* trans-intrinsic.c (gfc_conv_intrinsic_loc): Likewise.
	* trans-io.c (gfc_convert_array_to_string): Rewritten.

	* gfortran.dg/pr39865.f90: New test.
	* gfortran.dg/hollerith.f90: Don't expect errors for CHARACTER
	arrays in FMT=.
	* gfortran.dg/hollerith_f95.f90: Likewise.
	* gfortran.dg/hollerith6.f90: New test.
	* gfortran.dg/hollerith7.f90: New test.

From-SVN: r147507

1 files changed, 30 insertions, 13 deletions

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index eb0e3ae..c902257 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1,5 +1,5 @@
 /* Deal with I/O statements & related stuff.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1234,8 +1234,11 @@ resolve_tag_format (const gfc_expr *e)
   /* If e's rank is zero and e is not an element of an array, it should be
      of integer or character type.  The integer variable should be
      ASSIGNED.  */
-  if (e->symtree == NULL || e->symtree->n.sym->as == NULL
-      || e->symtree->n.sym->as->rank == 0)
+  if (e->rank == 0
+      && (e->expr_type != EXPR_VARIABLE
+	  || e->symtree == NULL
+	  || e->symtree->n.sym->as == NULL
+	  || e->symtree->n.sym->as->rank == 0))
     {
       if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
 	{
@@ -1266,20 +1269,34 @@ resolve_tag_format (const gfc_expr *e)
       return SUCCESS;
     }
 
-  /* If rank is nonzero, we allow the type to be character under GFC_STD_GNU
-     and other type under GFC_STD_LEGACY. It may be assigned an Hollerith
-     constant.  */
-  if (e->ts.type == BT_CHARACTER)
-    {
-      if (gfc_notify_std (GFC_STD_GNU, "Extension: Character array "
-			  "in FORMAT tag at %L", &e->where) == FAILURE)
-	return FAILURE;
-    }
-  else
+  /* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY.
+     It may be assigned an Hollerith constant.  */
+  if (e->ts.type != BT_CHARACTER)
     {
       if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character "
 			  "in FORMAT tag at %L", &e->where) == FAILURE)
 	return FAILURE;
+
+      if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)
+	{
+	  gfc_error ("Non-character assumed shape array element in FORMAT"
+		     " tag at %L", &e->where);
+	  return FAILURE;
+	}
+
+      if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
+	{
+	  gfc_error ("Non-character assumed size array element in FORMAT"
+		     " tag at %L", &e->where);
+	  return FAILURE;
+	}
+
+      if (e->rank == 0 && e->symtree->n.sym->attr.pointer)
+	{
+	  gfc_error ("Non-character pointer array element in FORMAT tag at %L",
+		     &e->where);
+	  return FAILURE;
+	}
     }
 
   return SUCCESS;