Fortran: checking and simplification of RESHAPE intrinsic [PR103794]

gcc/fortran/ChangeLog:

	PR fortran/103794
	* check.cc (gfc_check_reshape): Expand constant arguments SHAPE and
	ORDER before checking.
	* gfortran.h (gfc_is_constant_array_expr): Add prototype.
	* iresolve.cc (gfc_resolve_reshape): Expand constant argument SHAPE.
	* simplify.cc (is_constant_array_expr): If array is determined to be
	constant, expand small array constructors if needed.
	(gfc_is_constant_array_expr): Wrapper for is_constant_array_expr.
	(gfc_simplify_reshape): Fix check for insufficient elements in SOURCE
	when no padding specified.

gcc/testsuite/ChangeLog:

	PR fortran/103794
	* gfortran.dg/reshape_10.f90: New test.
	* gfortran.dg/reshape_11.f90: New test.

4 files changed, 28 insertions, 6 deletions

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 3dd1711..4086dc7 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -4723,7 +4723,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
     }
 
   gfc_simplify_expr (shape, 0);
-  shape_is_const = gfc_is_constant_expr (shape);
+  shape_is_const = gfc_is_constant_array_expr (shape);
 
   if (shape->expr_type == EXPR_ARRAY && shape_is_const)
     {
@@ -4732,6 +4732,8 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
       for (i = 0; i < shape_size; ++i)
 	{
 	  e = gfc_constructor_lookup_expr (shape->value.constructor, i);
+	  if (e == NULL)
+	    break;
 	  if (e->expr_type != EXPR_CONSTANT)
 	    continue;
 
@@ -4764,7 +4766,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
       if (!type_check (order, 3, BT_INTEGER))
 	return false;
 
-      if (order->expr_type == EXPR_ARRAY && gfc_is_constant_expr (order))
+      if (order->expr_type == EXPR_ARRAY && gfc_is_constant_array_expr (order))
 	{
 	  int i, order_size, dim, perm[GFC_MAX_DIMENSIONS];
 	  gfc_expr *e;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9dd6b45..8cfa8fd 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3970,6 +3970,7 @@ bool gfc_fix_implicit_pure (gfc_namespace *);
 
 void gfc_convert_mpz_to_signed (mpz_t, int);
 gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
+bool gfc_is_constant_array_expr (gfc_expr *);
 bool gfc_is_size_zero_array (gfc_expr *);
 
 /* trans-array.cc  */
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 7880aba..571e1bd 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -2424,7 +2424,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
       break;
     }
 
-  if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_expr (shape))
+  if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_array_expr (shape))
     {
       gfc_constructor *c;
       f->shape = gfc_get_shape (f->rank);
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 6ba2040..3f77203 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -254,12 +254,19 @@ is_constant_array_expr (gfc_expr *e)
 	break;
       }
 
-  /* Check and expand the constructor.  */
-  if (!array_OK && gfc_init_expr_flag && e->rank == 1)
+  /* Check and expand the constructor.  We do this when either
+     gfc_init_expr_flag is set or for not too large array constructors.  */
+  bool expand;
+  expand = (e->rank == 1
+	    && e->shape
+	    && (mpz_cmp_ui (e->shape[0], flag_max_array_constructor) < 0));
+
+  if (!array_OK && (gfc_init_expr_flag || expand) && e->rank == 1)
     {
+      bool saved_init_expr_flag = gfc_init_expr_flag;
       array_OK = gfc_reduce_init_expr (e);
       /* gfc_reduce_init_expr resets the flag.  */
-      gfc_init_expr_flag = true;
+      gfc_init_expr_flag = saved_init_expr_flag;
     }
   else
     return array_OK;
@@ -284,6 +291,13 @@ is_constant_array_expr (gfc_expr *e)
   return array_OK;
 }
 
+bool
+gfc_is_constant_array_expr (gfc_expr *e)
+{
+  return is_constant_array_expr (e);
+}
+
+
 /* Test for a size zero array.  */
 bool
 gfc_is_size_zero_array (gfc_expr *array)
@@ -7001,6 +7015,11 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
 	  if (npad <= 0)
 	    {
 	      mpz_clear (index);
+	      if (pad == NULL)
+		gfc_error ("Without padding, there are not enough elements "
+			   "in the intrinsic RESHAPE source at %L to match "
+			   "the shape", &source->where);
+	      gfc_free_expr (result);
 	      return NULL;
 	    }
 	  j = j - nsource;