fortran: ICE in gfc_match_assignment PR93600

This patch builds on the original patch by Steve Kargl that fixed the
ICE and produced an "Unclassifiable statement at (1)" error. The
processing of parameter variables now correctly handles zero length
arrays used with %kind and %len. A side affect is that "Unclassifiable"
error now says "Assignment to constant expression at (1)". It also
fixes PR93365.

gcc/fortran/ChangeLog:

	PR fortran/93600
	* expr.c (simplify_parameter_variable): Check whether the ref
	chain contains INQUIRY_LEN or INQUIRY_KIND and set inquiry
	boolean. When an empty array has been identified and a new
	new EXPR_ARRAY expression has been created only return that
	expression if inquiry is not set. This allows the new
	expression to drop through to be simplified into a
	EXPR_CONSTANT representing %kind or %len.
	* match.c (gfc_match_assignment): If lvalue doesn't have a
	symtree free both lvalue and rvalue expressions and return
	an error.
	* resolv.c (gfc_resolve_ref): Ensure that code to handle
	INQUIRY_LEN is only performed for arrays with deferred types.

gcc/testsuite/ChangeLog:

	PR fortran/93365
	PR fortran/93600
	* gfortran.dg/pr93365.f90: New test.
	* gfortran.dg/pr93600_1.f90: New test.
	* gfortran.dg/pr93600_2.f90: New test.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db79f05d73f8878e82cbe9e03286e956633d44e8..05915791d865b827ab5c699dbf2708dde5d3c5e7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2020-03-23  Mark Eggleston  <mark.eggleston@codethink.com>
+       Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/93600
+       * expr.c (simplify_parameter_variable): Check whether the ref
+       chain contains INQUIRY_LEN or INQUIRY_KIND and set inquiry
+       boolean. When an empty array has been identified and a new
+       new EXPR_ARRAY expression has been created only return that
+       expression if inquiry is not set. This allows the new
+       expression to drop through to be simplified into a
+       EXPR_CONSTANT representing %kind or %len.
+       * matc.c (gfc_match_assignment): If lvalue doesn't have a
+       symtree free both lvalue and rvalue expressions and return
+       an error.
+       * resolv.c (gfc_resolve_ref): Ensure that code to handle
+       INQUIRY_LEN is only performed for arrays with deferred types.
+
 2020-03-18  Jakub Jelinek  <jakub@redhat.com>
 
        * class.c (generate_finalization_wrapper): Fix up duplicated word

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 79e00b4112a926a0f594e2c6273b1804b906ffe2..08b0a92655ad6be834989e1a64f4e9d1c0113158 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2057,6 +2057,18 @@ simplify_parameter_variable (gfc_expr *p, int type)
     }
   gfc_expression_rank (p);
 
+  /* Is this an inquiry?  */
+  bool inquiry = false;
+  gfc_ref* ref = p->ref;
+  while (ref)
+    {
+      if (ref->type == REF_INQUIRY)
+       break;
+      ref = ref->next;
+    }
+  if (ref && ref->type == REF_INQUIRY)
+    inquiry = ref->u.i == INQUIRY_LEN || ref->u.i == INQUIRY_KIND;
+
   if (gfc_is_size_zero_array (p))
     {
       if (p->expr_type == EXPR_ARRAY)
@@ -2069,15 +2081,22 @@ simplify_parameter_variable (gfc_expr *p, int type)
       e->value.constructor = NULL;
       e->shape = gfc_copy_shape (p->shape, p->rank);
       e->where = p->where;
-      gfc_replace_expr (p, e);
-      return true;
+      /* If %kind and %len are not used then we're done, otherwise
+        drop through for simplification.  */
+      if (!inquiry)
+       {
+         gfc_replace_expr (p, e);
+         return true;
+       }
     }
+  else
+    {
+      e = gfc_copy_expr (p->symtree->n.sym->value);
+      if (e == NULL)
+       return false;
 
-  e = gfc_copy_expr (p->symtree->n.sym->value);
-  if (e == NULL)
-    return false;
-
-  e->rank = p->rank;
+      e->rank = p->rank;
+    }
 
   if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL)
     e->ts.u.cl = gfc_new_charlen (gfc_current_ns, p->ts.u.cl);
@@ -2126,7 +2145,6 @@ gfc_simplify_expr (gfc_expr *p, int type)
   gfc_actual_arglist *ap;
   gfc_intrinsic_sym* isym = NULL;
 
-
   if (p == NULL)
     return true;
 

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 753a5f1f1a4995f097c04de001ba5dad507b79b2..3a0c097325fc0d6af86585f1e030833bfc05e88e 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1373,6 +1373,14 @@ gfc_match_assignment (void)
       return m;
     }
 
+  if (!lvalue->symtree)
+    {
+      gfc_free_expr (lvalue);
+      gfc_free_expr (rvalue);
+      return MATCH_ERROR;
+    }
+
+
   gfc_set_sym_referenced (lvalue->symtree->n.sym);
 
   new_st.op = EXEC_ASSIGN;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 23b5a2b443914dabf2512eb43049ca19b89c8619..2dcb261fc7148327c07f86f74ab992e6c5881d03 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5314,7 +5314,7 @@ gfc_resolve_ref (gfc_expr *expr)
        case REF_INQUIRY:
          /* Implement requirement in note 9.7 of F2018 that the result of the
             LEN inquiry be a scalar.  */
-         if (ref->u.i == INQUIRY_LEN && array_ref)
+         if (ref->u.i == INQUIRY_LEN && array_ref && expr->ts.deferred)
            {
              array_ref->u.ar.type = AR_ELEMENT;
              expr->rank = 0;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 558a8c622dff04d3c2820d3aaacb3364149ecd11..3d54e64d05b60cfdeafcfbb9612253cf95af9189 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2020-03-23  Mark Eggleston  <mark.eggleston@codethink.com>
+
+       PR fortran/93365
+       PR fortran/93600
+       * gfortran.dg/pr93365.f90: New test.
+       * gfortran.dg/pr93600_1.f90: New test.
+       * gfortran.dg/pr93600_2.f90: New test.
+
 2020-03-23  Tobias Burnus  <tobias@codesourcery.com>
 
        * lib/target-supports.exp (check_effective_target_offload_gcn):

diff --git a/gcc/testsuite/gfortran.dg/pr93365.f90 b/gcc/testsuite/gfortran.dg/pr93365.f90
new file mode 100644 (file)
index 0000000..74144d6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93365.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+
+program p
+   logical, parameter :: a(0) = .true.
+   real, parameter :: b(0) = 0
+   complex, parameter :: c(0) = 0
+   integer :: d
+   data d /a%kind/
+   data e /b%kind/
+   data f /c%kind/
+   if (d .ne. kind(a)) stop 1
+   if (e .ne. kind(b)) stop 2
+   if (f .ne. kind(c)) stop 3
+end
+

diff --git a/gcc/testsuite/gfortran.dg/pr93600_1.f90 b/gcc/testsuite/gfortran.dg/pr93600_1.f90
new file mode 100644 (file)
index 0000000..02bb76f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93600_1.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+program p
+  integer, parameter :: a(0) = 0
+  character(0), parameter :: b(0) = ''
+  a%kind = 1  ! { dg-error "Assignment to a constant expression" }
+  b%len = 'a' ! { dg-error "Assignment to a constant expression" }
+end program
+

diff --git a/gcc/testsuite/gfortran.dg/pr93600_2.f90 b/gcc/testsuite/gfortran.dg/pr93600_2.f90
new file mode 100644 (file)
index 0000000..1fb8c1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93600_2.f90
@@ -0,0 +1,10 @@
+! { dg-do run }
+
+program p
+  integer, parameter :: a(0) = 0
+  character(0), parameter :: b(0) = ''
+  integer :: c
+  if (a%kind.ne.kind(c)) stop 1
+  if (b%len.ne.0) stop 2
+end program
+