diff mbox series

[10,Regression] fortran: ICE in gfc_match_assignment PR93600

Message ID cdee8fcc-ad5b-8a82-42f8-45c2c4312c96@codethink.co.uk
State New
Headers show
Series [10,Regression] fortran: ICE in gfc_match_assignment PR93600 | expand

Commit Message

Mark Eggleston March 20, 2020, 7:21 a.m. UTC
Please find attached a fix for PR93600.

This builds on the patch originally submitted to the PR by Steve Kargl, 
the dreaded "Unclassifiable statement error" is replaced by the correct 
error message. It would have been posted earlier had not one of the test 
cases failed as a result of the fix for PR93581. A small change 
(resolve.c) was necessary to fix that.

As a free gift this also fixes PR93365.

OK to commit?

gcc/fortran/ChangeLog:

     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.

gcc/testsuite/ChangeLog:

     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.

Comments

Jeff Law via Gcc-patches March 22, 2020, 5:47 p.m. UTC | #1
Hi Mark,

> Please find attached a fix for PR93600.
> 
> This builds on the patch originally submitted to the PR by Steve Kargl, 
> the dreaded "Unclassifiable statement error" is replaced by the correct 
> error message. It would have been posted earlier had not one of the test 
> cases failed as a result of the fix for PR93581. A small change 
> (resolve.c) was necessary to fix that.
> 
> As a free gift this also fixes PR93365.
> 
> OK to commit?

OK. Thanks to you and Steve for the patch!

Regards

	Thomas
diff mbox series

Patch

From 93be049f23b453360a32593eb41abd0fb2280a16 Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@gcc.gnu.org>
Date: Thu, 19 Mar 2020 14:25:26 +0000
Subject: [PATCH] fortran: ICE in gfc_match_assignment PR93600

This patch builds on the original patch by Steve Kargl that fixed the
ICE and produced the "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.
---
 gcc/fortran/expr.c                      | 34 +++++++++++++++++++++++++--------
 gcc/fortran/match.c                     |  8 ++++++++
 gcc/fortran/resolve.c                   |  2 +-
 gcc/testsuite/gfortran.dg/pr93365.f90   | 15 +++++++++++++++
 gcc/testsuite/gfortran.dg/pr93600_1.f90 |  9 +++++++++
 gcc/testsuite/gfortran.dg/pr93600_2.f90 | 10 ++++++++++
 6 files changed, 69 insertions(+), 9 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr93365.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr93600_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/pr93600_2.f90

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 79e00b4112a..08b0a92655a 100644
--- 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 753a5f1f1a4..3a0c097325f 100644
--- 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 23b5a2b4439..2dcb261fc71 100644
--- 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/gfortran.dg/pr93365.f90 b/gcc/testsuite/gfortran.dg/pr93365.f90
new file mode 100644
index 00000000000..74144d6a9ee
--- /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
index 00000000000..02bb76fb77c
--- /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
index 00000000000..1fb8c1b97e2
--- /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
+
-- 
2.11.0