fortran: ICE using SHAPE with FINDLOC PR93835

	Backported from mainline
	2020-02-24  Mark Eggleston  <markeggleston@gcc.gnu.org>

	PR fortran/93835
	* simplify.c (simplify_findloc_nodim) : Fix whitespace issues.
	(gfc_simplify_shape) : Create and initialise one shape value
	for the result expression. Set shape value with the rank of
	the source array.

	PR fortran/93835
	* gfortran.dg/pr77351.f90 : Check for one error instead of two.
	* gfortran.dg/pr93835.f08 : New test.

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index e26027edfae31408ad931d25455cb811a6a56275..2b4581e1236876ec07c0b08050c8187768b4be43 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5539,7 +5539,7 @@ simplify_findloc_nodim (gfc_expr *result, gfc_expr *value, gfc_expr *array,
   bool continue_loop;
   bool ma;
 
-  for (i = 0; i<array->rank; i++)
+  for (i = 0; i < array->rank; i++)
     res[i] = -1;
 
   /* Shortcut for constant .FALSE. MASK.  */
@@ -5582,7 +5582,7 @@ simplify_findloc_nodim (gfc_expr *result, gfc_expr *value, gfc_expr *array,
 
          if (ma && gfc_compare_expr (a, value, INTRINSIC_EQ) == 0)
            {
-             for (i = 0; i<array->rank; i++)
+             for (i = 0; i < array->rank; i++)
                res[i] = count[i];
              if (!back_val)
                goto finish;
@@ -5607,9 +5607,9 @@ simplify_findloc_nodim (gfc_expr *result, gfc_expr *value, gfc_expr *array,
        } while (count[n] == extent[n]);
     }
 
- finish:
+finish:
   result_ctor = gfc_constructor_first (result->value.constructor);
-  for (i = 0; i<array->rank; i++)
+  for (i = 0; i < array->rank; i++)
     {
       gfc_expr *r_expr;
       r_expr = result_ctor->expr;
@@ -7255,6 +7255,8 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
     return NULL;
 
   result = gfc_get_array_expr (BT_INTEGER, k, &source->where);
+  result->shape = gfc_get_shape (1);
+  mpz_init (result->shape[0]);
 
   if (source->rank == 0)
     return result;
@@ -7311,6 +7313,8 @@ gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
   if (t)
     gfc_clear_shape (shape, source->rank);
 
+  mpz_set_si (result->shape[0], source->rank);
+
   return result;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f02a941523009050d7e18f1943a923d9c0ecdf29..812ae834d7079e6135fffec8754acd145d32e41d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2020-02-24  Mark Eggleston  <mark.eggleston@codethink.com>
+
+       Backported from master
+       2020-02-24  Mark Eggleston  <markeggleston@gcc.gnu.org>
+
+       PR fortran/93835
+       * gfortran.dg/pr77351.f90 : Check for one error instead of two.
+       * gfortran.dg/pr93835.f08 : New test.
+
 2020-02-23  Peter Bergner  <bergner@linux.ibm.com>
 
        Backport from master

diff --git a/gcc/testsuite/gfortran.dg/pr77351.f90 b/gcc/testsuite/gfortran.dg/pr77351.f90
index 76ce5c528b2912223a5bcc63b5fe4433fc5b1957..e3e8bc4f64bd9b411ba6e8c13106c2bee50d81ab 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr77351.f90
+++ b/gcc/testsuite/gfortran.dg/pr77351.f90
@@ -1,6 +1,8 @@
 ! { dg-do compile }
+!
+! PR93835 resulted in different but valid error message
 program p
    integer :: z(4) = [1, 2, 3, 4]
-   print *, any(shape(z) /= [4,1])  ! { dg-error "shape for elemental binary" }
+   print *, any(shape(z) /= [4,1])  ! { dg-error "Shapes for operands at .1. and .2. are not conformable" }
 end
-! { dg-excess-errors "operands are incommensurate" }
+

diff --git a/gcc/testsuite/gfortran.dg/pr93835.f08 b/gcc/testsuite/gfortran.dg/pr93835.f08
new file mode 100644 (file)
index 0000000..933e249
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93835.f08
@@ -0,0 +1,8 @@
+! {dg-do run }
+!
+! PR fortran/93835 - the following code resulted in an ICE
+!
+program p
+  if (any(findloc(shape(1), 1) .ne. 0)) stop 1
+end
+