diff mbox series

[v3] Fortran: error recovery for invalid types in array constructors [PR107000]

Message ID 43da1a08-ddc3-bb5c-6f64-cf17f891e35e@orange.fr
State New
Headers
Series [v3] Fortran: error recovery for invalid types in array constructors [PR107000] |

Commit Message

Mikael Morin Oct. 7, 2022, 8:26 p.m. UTC 
  Le 07/10/2022 à 21:47, Mikael Morin a écrit :
> Let me have a look.

The attached patch works with your test, I just moved the checks into 
the loops.
I'm now checking the patch against the full fortran testsuite.
I'm (finally) fine with that version, what do you think of it?

Comments

Harald Anlauf Oct. 7, 2022, 9:41 p.m. UTC | #1 
Hi Mikael,

Am 07.10.22 um 22:26 schrieb Mikael Morin:
> Le 07/10/2022 à 21:47, Mikael Morin a écrit :
>> Let me have a look.
>
> The attached patch works with your test, I just moved the checks into
> the loops.
> I'm now checking the patch against the full fortran testsuite.
> I'm (finally) fine with that version, what do you think of it?

I'm fine with it.  If it regtests ok, then this should be it.
diff mbox series

Patch

From a2b393cab384a08164946916ff96dd576ebf7c97 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 4 Oct 2022 23:04:06 +0200
Subject: [PATCH] Fortran: error recovery for invalid types in array
 constructors [PR107000]

gcc/fortran/ChangeLog:

	PR fortran/107000
	* arith.cc (gfc_arith_error): Define error message for
	ARITH_INVALID_TYPE.
	(reduce_unary): Catch arithmetic expressions with invalid type.
	(reduce_binary_ac): Likewise.
	(reduce_binary_ca): Likewise.
	(reduce_binary_aa): Likewise.
	(eval_intrinsic): Likewise.
	(gfc_real2complex): Source expression must be of type REAL.
	* gfortran.h (enum arith): Add ARITH_INVALID_TYPE.

gcc/testsuite/ChangeLog:

	PR fortran/107000
	* gfortran.dg/pr107000.f90: New test.

Co-authored-by: Mikael Morin <mikael@gcc.gnu.org>
---
 gcc/fortran/arith.cc                   | 30 +++++++++++++---
 gcc/fortran/gfortran.h                 |  2 +-
 gcc/testsuite/gfortran.dg/pr107000.f90 | 50 ++++++++++++++++++++++++++
 3 files changed, 76 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107000.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index d57059a375f..086b1f856b1 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -118,6 +118,9 @@  gfc_arith_error (arith code)
     case ARITH_WRONGCONCAT:
       p = G_("Illegal type in character concatenation at %L");
       break;
+    case ARITH_INVALID_TYPE:
+      p = G_("Invalid type in arithmetic operation at %L");
+      break;
 
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");
@@ -1268,7 +1271,10 @@  reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
   head = gfc_constructor_copy (op->value.constructor);
   for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
     {
-      rc = reduce_unary (eval, c->expr, &r);
+      if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+	rc = ARITH_INVALID_TYPE;
+      else
+	rc = reduce_unary (eval, c->expr, &r);
 
       if (rc != ARITH_OK)
 	break;
@@ -1309,6 +1315,8 @@  reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 
       if (c->expr->expr_type == EXPR_CONSTANT)
         rc = eval (c->expr, op2, &r);
+      else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+	rc = ARITH_INVALID_TYPE;
       else
 	rc = reduce_binary_ac (eval, c->expr, op2, &r);
 
@@ -1361,6 +1369,8 @@  reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 
       if (c->expr->expr_type == EXPR_CONSTANT)
 	rc = eval (op1, c->expr, &r);
+      else if (c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+	rc = ARITH_INVALID_TYPE;
       else
 	rc = reduce_binary_ca (eval, op1, c->expr, &r);
 
@@ -1420,14 +1430,19 @@  reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
        c && d;
        c = gfc_constructor_next (c), d = gfc_constructor_next (d))
     {
+      if ((c->expr->expr_type == EXPR_OP && c->expr->ts.type == BT_UNKNOWN)
+	  || (d->expr->expr_type == EXPR_OP && d->expr->ts.type == BT_UNKNOWN))
+	rc = ARITH_INVALID_TYPE;
+      else
 	rc = reduce_binary (eval, c->expr, d->expr, &r);
-	if (rc != ARITH_OK)
-	  break;
 
-	gfc_replace_expr (c->expr, r);
+      if (rc != ARITH_OK)
+	break;
+
+      gfc_replace_expr (c->expr, r);
     }
 
-  if (c || d)
+  if (rc == ARITH_OK && (c || d))
     rc = ARITH_INCOMMENSURATE;
 
   if (rc != ARITH_OK)
@@ -1638,6 +1653,8 @@  eval_intrinsic (gfc_intrinsic_op op,
   else
     rc = reduce_binary (eval.f3, op1, op2, &result);
 
+  if (rc == ARITH_INVALID_TYPE)
+    goto runtime;
 
   /* Something went wrong.  */
   if (op == INTRINSIC_POWER && rc == ARITH_PROHIBIT)
@@ -2238,6 +2255,9 @@  gfc_real2complex (gfc_expr *src, int kind)
   arith rc;
   bool did_warn = false;
 
+  if (src->ts.type != BT_REAL)
+    return NULL;
+
   result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
 
   mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4babd77924b..fc0aa51df57 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -226,7 +226,7 @@  enum gfc_intrinsic_op
 enum arith
 { ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
   ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT,
-  ARITH_WRONGCONCAT
+  ARITH_WRONGCONCAT, ARITH_INVALID_TYPE
 };
 
 /* Statements.  */
diff --git a/gcc/testsuite/gfortran.dg/pr107000.f90 b/gcc/testsuite/gfortran.dg/pr107000.f90
new file mode 100644
index 00000000000..30289078c57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107000.f90
@@ -0,0 +1,50 @@ 
+! { dg-do compile }
+! PR fortran/107000 - ICE in gfc_real2complex, reduce_unary, reduce_binary_*
+! Contributed by G.Steinmetz
+
+program p
+  real    :: y(1)
+  complex :: x(1)
+  x = (1.0, 2.0) * [real :: -'1']    ! { dg-error "Operand of unary numeric operator" }
+  x = (1.0, 2.0) * [complex :: +'1'] ! { dg-error "Operand of unary numeric operator" }
+  x = [complex :: -'1'] * (1.0, 2.0) ! { dg-error "Operand of unary numeric operator" }
+  y = [complex :: -'1'] * 2          ! { dg-error "Operand of unary numeric operator" }
+  y = 2 * [complex :: -'1']          ! { dg-error "Operand of unary numeric operator" }
+  y = 2 * [complex :: -(.true.)]     ! { dg-error "Operand of unary numeric operator" }
+  y = [complex :: -(.true.)] * 2     ! { dg-error "Operand of unary numeric operator" }
+  print *, - [real ::  -'1' ]        ! { dg-error "Operand of unary numeric operator" }
+  print *, - [real :: [-'1']]        ! { dg-error "Operand of unary numeric operator" }
+  print *, - [real ::  +(.true.) ]   ! { dg-error "Operand of unary numeric operator" }
+  print *, - [real :: [+(.true.)]]   ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real ::  -'1' ]      ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real :: (-'1')]      ! { dg-error "Operand of unary numeric operator" }
+  print *, [real ::  -'1' ] * 2      ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: (-'1')] * 2      ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [integer :: -('1')]   ! { dg-error "Operand of unary numeric operator" }
+  print *, [integer :: -('1')] * 2   ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real :: 0, (-'1')]   ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 0, (-'1')] * 2   ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real :: 0, -'1']     ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 0, -'1'] * 2     ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real :: 0, 1+'1']    ! { dg-error "Operands of binary numeric operator" }
+  print *, [real :: 0, 1+'1'] * 2    ! { dg-error "Operands of binary numeric operator" }
+  print *, [real :: 1, +(.true.)]    ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, -(.true.)]    ! { dg-error "Operand of unary numeric operator" }
+  print *, 2 * [real :: 1, +(.true.)]      ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, +(.true.)] * 2      ! { dg-error "Operand of unary numeric operator" }
+  print *, [1, 2] * [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, +(.true.)] * [1, 2] ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, 2] * [real :: 1, +(.true.)] ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, +(.true.)] * [real :: 1, 2] ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 0, -'1'] * [real :: 1, +(+(.true.))] ! { dg-error "Operand of unary numeric operator" }
+  print *, [real :: 1, [(+(.true.))]] * [real :: 0, [(-'1')]] ! { dg-error "Operand of unary numeric operator" }
+
+  ! Legal:
+  print *, 2 * [real :: 1, [2], 3]
+  print *, [real :: 1, [2], 3] * 2
+  print *, [real :: 1, [2], 3] * [real :: 1, [2], 3]
+  print *, [real :: 1, [2], 3] * [integer :: 1, [2], 3]
+  print *, [real :: 1, [2], 3] * [1, [2], 3]
+  print *, [real :: 1,  huge(2.0)] * [real :: 1,  real(1.0)]
+  print *, [real :: 1, -(huge(2.0))] * [real :: 1, +(real(1))]
+end
-- 
2.35.1