From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Mon, 24 Feb 2020 15:53:24 +0000 (+0000)
Subject: fortran: ICE using SHAPE with FINDLOC PR93835
X-Git-Tag: releases/gcc-9.3.0~90
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ba740092516cd759ac69e89d7f502a51d8bec19a;p=thirdparty%2Fgcc.git

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 e26027edfae3..2b4581e12368 100644
--- 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 f02a94152300..812ae834d707 100644
--- 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 76ce5c528b29..e3e8bc4f64bd 100644
--- 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
index 000000000000..933e249e632e
--- /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
+