re PR fortran/44672 ([F08] ALLOCATE with SOURCE and no array-spec)

gcc/testsuite/ChangeLog:

2015-06-15  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/44672
	PR fortran/45440
	PR fortran/57307
	* gfortran.dg/allocate_with_source_3.f90: Removed check for
	unimplemented error.
	* gfortran.dg/allocate_with_source_7.f08: New test.
	* gfortran.dg/allocate_with_source_8.f08: New test.

gcc/fortran/ChangeLog:

2015-06-15  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/44672
	PR fortran/45440
	PR fortran/57307
	* gfortran.h: Extend gfc_code.ext.alloc to carry a
	flag indicating that the array specification has to be
	taken from expr3.
	* resolve.c (resolve_allocate_expr): Add F2008 notify
	and flag indicating source driven array spec.
	(resolve_allocate_deallocate): Check for source driven
	array spec, when array to allocate has no explicit
	array spec.
	* trans-array.c (gfc_array_init_size): Get lower and
	upper bound from a tree array descriptor, except when
	the source expression is an array-constructor which is
	fixed to be one-based.
	(retrieve_last_ref): Extracted from gfc_array_allocate().
	(gfc_array_allocate): Enable allocate(array, source= 
	array_expression) as specified by F2008:C633.
	(gfc_conv_expr_descriptor): Add class tree expression
	into the saved descriptor for class arrays.
	* trans-array.h: Add temporary array descriptor to
	gfc_array_allocate ().
	* trans-expr.c (gfc_conv_procedure_call): Special handling
	for _copy() routine translation, that comes without an
	interface. Third and fourth argument are now passed by value.
	* trans-stmt.c (gfc_trans_allocate): Get expr3 array
	descriptor for temporary arrays to allow allocate(array,
	source = array_expression) for array without array
	specification.

From-SVN: r224477

1 files changed, 27 insertions, 7 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 52dc109..f365e8ff 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6805,7 +6805,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2)
    have a trailing array reference that gives the size of the array.  */
 
 static bool
-resolve_allocate_expr (gfc_expr *e, gfc_code *code)
+resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 {
   int i, pointer, allocatable, dimension, is_abstract;
   int codimension;
@@ -7104,13 +7104,24 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
   if (!ref2 || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
       || (dimension && ref2->u.ar.dimen == 0))
     {
-      gfc_error ("Array specification required in ALLOCATE statement "
-		 "at %L", &e->where);
-      goto failure;
+      /* F08:C633.  */
+      if (code->expr3)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Array specification required "
+			       "in ALLOCATE statement at %L", &e->where))
+	    goto failure;
+	  *array_alloc_wo_spec = true;
+	}
+      else
+	{
+	  gfc_error ("Array specification required in ALLOCATE statement "
+		     "at %L", &e->where);
+	  goto failure;
+	}
     }
 
   /* Make sure that the array section reference makes sense in the
-    context of an ALLOCATE specification.  */
+     context of an ALLOCATE specification.  */
 
   ar = &ref2->u.ar;
 
@@ -7125,7 +7136,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 
   for (i = 0; i < ar->dimen; i++)
     {
-      if (ref2->u.ar.type == AR_ELEMENT)
+      if (ar->type == AR_ELEMENT || ar->type == AR_FULL)
 	goto check_symbols;
 
       switch (ar->dimen_type[i])
@@ -7202,6 +7213,7 @@ failure:
   return false;
 }
 
+
 static void
 resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 {
@@ -7376,8 +7388,16 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 
   if (strcmp (fcn, "ALLOCATE") == 0)
     {
+      bool arr_alloc_wo_spec = false;
       for (a = code->ext.alloc.list; a; a = a->next)
-	resolve_allocate_expr (a->expr, code);
+	resolve_allocate_expr (a->expr, code, &arr_alloc_wo_spec);
+
+      if (arr_alloc_wo_spec && code->expr3)
+	{
+	  /* Mark the allocate to have to take the array specification
+	     from the expr3.  */
+	  code->ext.alloc.arr_spec_from_expr3 = 1;
+	}
     }
   else
     {