re PR fortran/37203 (Check ORDER= of RESHAPE)

gcc/fortran/
2009-06-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/37203
        * check.c (gfc_check_reshape): Additional checks for the
        SHAPE and ORDER arguments.
        * simplify.c (gfc_simplify_reshape): Converted argument checks
        to asserts.

gcc/testsuite/
2009-06-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/37203
        * gfortran.dg/reshape_order_5.f90: New.
        * gfortran.dg/reshape_shape_1.f90: New.

From-SVN: r148190

1 files changed, 16 insertions, 86 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 51a3c51..98df0ed 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3657,16 +3657,10 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
   gfc_expr *e;
 
   /* Check that argument expression types are OK.  */
-  if (!is_constant_array_expr (source))
-    return NULL;
-
-  if (!is_constant_array_expr (shape_exp))
-    return NULL;
-
-  if (!is_constant_array_expr (pad))
-    return NULL;
-
-  if (!is_constant_array_expr (order_exp))
+  if (!is_constant_array_expr (source)
+      || !is_constant_array_expr (shape_exp)
+      || !is_constant_array_expr (pad)
+      || !is_constant_array_expr (order_exp))
     return NULL;
 
   /* Proceed with simplification, unpacking the array.  */
@@ -3681,40 +3675,16 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
       if (e == NULL)
 	break;
 
-      if (gfc_extract_int (e, &shape[rank]) != NULL)
-	{
-	  gfc_error ("Integer too large in shape specification at %L",
-		     &e->where);
-	  gfc_free_expr (e);
-	  goto bad_reshape;
-	}
+      gfc_extract_int (e, &shape[rank]);
 
-      if (rank >= GFC_MAX_DIMENSIONS)
-	{
-	  gfc_error ("Too many dimensions in shape specification for RESHAPE "
-		     "at %L", &e->where);
-	  gfc_free_expr (e);
-	  goto bad_reshape;
-	}
-
-      if (shape[rank] < 0)
-	{
-	  gfc_error ("Shape specification at %L cannot be negative",
-		     &e->where);
-	  gfc_free_expr (e);
-	  goto bad_reshape;
-	}
+      gcc_assert (rank >= 0 && rank < GFC_MAX_DIMENSIONS);
+      gcc_assert (shape[rank] >= 0);
 
       gfc_free_expr (e);
       rank++;
     }
 
-  if (rank == 0)
-    {
-      gfc_error ("Shape specification at %L cannot be the null array",
-		 &shape_exp->where);
-      goto bad_reshape;
-    }
+  gcc_assert (rank > 0);
 
   /* Now unpack the order array if present.  */
   if (order_exp == NULL)
@@ -3730,41 +3700,14 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
       for (i = 0; i < rank; i++)
 	{
 	  e = gfc_get_array_element (order_exp, i);
-	  if (e == NULL)
-	    {
-	      gfc_error ("ORDER parameter of RESHAPE at %L is not the same "
-			 "size as SHAPE parameter", &order_exp->where);
-	      goto bad_reshape;
-	    }
-
-	  if (gfc_extract_int (e, &order[i]) != NULL)
-	    {
-	      gfc_error ("Error in ORDER parameter of RESHAPE at %L",
-			 &e->where);
-	      gfc_free_expr (e);
-	      goto bad_reshape;
-	    }
-
-	  if (order[i] < 1 || order[i] > rank)
-	    {
-	      gfc_error ("ORDER parameter of RESHAPE at %L is out of range",
-			 &e->where);
-	      gfc_free_expr (e);
-	      goto bad_reshape;
-	    }
-
-	  order[i]--;
-
-	  if (x[order[i]])
-	    {
-	      gfc_error ("Invalid permutation in ORDER parameter at %L",
-			 &e->where);
-	      gfc_free_expr (e);
-	      goto bad_reshape;
-	    }
+	  gcc_assert (e);
 
+	  gfc_extract_int (e, &order[i]);
 	  gfc_free_expr (e);
 
+	  gcc_assert (order[i] >= 1 && order[i] <= rank);
+	  order[i]--;
+	  gcc_assert (x[order[i]] == 0);
 	  x[order[i]] = 1;
 	}
     }
@@ -3812,18 +3755,13 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
 	e = gfc_get_array_element (source, j);
       else
 	{
-	  j = j - nsource;
-
-	  if (npad == 0)
-	    {
-	      gfc_error ("PAD parameter required for short SOURCE parameter "
-			 "at %L", &source->where);
-	      goto bad_reshape;
-	    }
+	  gcc_assert (npad > 0);
 
+	  j = j - nsource;
 	  j = j % npad;
 	  e = gfc_get_array_element (pad, j);
 	}
+      gcc_assert (e);
 
       if (head == NULL)
 	head = tail = gfc_get_constructor ();
@@ -3833,9 +3771,6 @@ gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
 	  tail = tail->next;
 	}
 
-      if (e == NULL)
-	goto bad_reshape;
-
       tail->where = e->where;
       tail->expr = e;
 
@@ -3867,11 +3802,6 @@ inc:
   e->rank = rank;
 
   return e;
-
-bad_reshape:
-  gfc_free_constructor (head);
-  mpz_clear (index);
-  return &gfc_bad_expr;
 }