ortran: ICE using SHAPE with FINDLOC PR93835

The expression representing the array returned by SHAPE does not
have its shape defined. An ICE occurs when FINDLOC attempts to
use the shape of the array.  Add shape to expression before returning
from SHAPE.

Whitespace issues identified by Steven G. Kargl  <kargl@gcc.gnu.org>
have also been fixed.

gcc/fortran/ChangeLog

	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.

gcc/testsuite/ChangeLog

	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/ChangeLog b/gcc/fortran/ChangeLog
index e25d05cf79431cdb8a150cd35197bbebf54d9027..5759689f8b758e54f30eed874491b15e955b1734 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2020-02-24  Mark Eggleston  <mark.eggleston@codethink.com>
+       Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/93835
+       * decl.c (gfc_match_data) : Check whether the data expression
+       is a derived type and is a constructor. If a BOZ constant
+       is encountered in the constructor output an error and return
+       MATCH_ERROR.
+
 2020-02-24  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/93604

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 613fdafd1a64c8a08100c5aa2f659afb2f8e0d7a..86715d52d9067097a0850a12bee0d5246d2fab8d 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5497,7 +5497,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.  */
@@ -5540,7 +5540,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;
@@ -5565,9 +5565,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;
@@ -7228,6 +7228,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;
@@ -7284,6 +7286,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 7356523ede75e8001b61801c4faef3caa35eb463..8c7ae6f3685365db5020f3b774d53084cf05b879 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-02-20  Mark Eggleston  <mark.eggleston@codethink.com>
+
+       PR fortran/93835
+       * gfortran.dg/pr77351.f90 : Check for one error instead of two.
+       * gfortran.dg/pr93835.f08 : New test.
+
 2020-02-24  Marek Polacek  <polacek@redhat.com>
 
        PR c++/93712 - ICE with ill-formed array list-initialization.

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
+