diff mbox series

Fortran: check type of operands of logical operations, comparisons [PR107272]

Message ID trinity-691dab4a-f7d3-4e48-a67b-488e2f830917-1665945998916@3c-app-gmx-bap23
State New
Headers show
Series Fortran: check type of operands of logical operations, comparisons [PR107272] | expand

Commit Message

Harald Anlauf Oct. 16, 2022, 6:46 p.m. UTC 
Dear all,

this PR is actually very related to PR107217 that addressed ICEs
with bad array constructors with typespec when used in arithmetic
expressions.  The present patch extends the checking to logical
operations and to comparisons and catches several ICE-on-invalid
as well as a few cases of accepts-invalid.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald

Comments

Mikael Morin Oct. 16, 2022, 8:59 p.m. UTC | #1 
Le 16/10/2022 à 20:46, Harald Anlauf via Fortran a écrit :
> Dear all,
> 
> this PR is actually very related to PR107217 that addressed ICEs
> with bad array constructors with typespec when used in arithmetic
> expressions.  The present patch extends the checking to logical
> operations and to comparisons and catches several ICE-on-invalid
> as well as a few cases of accepts-invalid.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
Yes, thanks.
diff mbox series

Patch

From 779baf06888f3adef13c12c468c0a5ef0a45f93e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 16 Oct 2022 20:32:27 +0200
Subject: [PATCH] Fortran: check type of operands of logical operations,
 comparisons [PR107272]

gcc/fortran/ChangeLog:

	PR fortran/107272
	* arith.cc (gfc_arith_not): Operand must be of type BT_LOGICAL.
	(gfc_arith_and): Likewise.
	(gfc_arith_or): Likewise.
	(gfc_arith_eqv): Likewise.
	(gfc_arith_neqv): Likewise.
	(gfc_arith_eq): Compare consistency of types of operands.
	(gfc_arith_ne): Likewise.
	(gfc_arith_gt): Likewise.
	(gfc_arith_ge): Likewise.
	(gfc_arith_lt): Likewise.
	(gfc_arith_le): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/107272
	* gfortran.dg/pr107272.f90: New test.
---
 gcc/fortran/arith.cc                   | 33 ++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr107272.f90 | 21 ++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr107272.f90

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index c8e882badab..fc9224ebc5c 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -422,6 +422,9 @@  gfc_arith_not (gfc_expr *op1, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, op1->ts.kind, &op1->where);
   result->value.logical = !op1->value.logical;
   *resultp = result;
@@ -435,6 +438,9 @@  gfc_arith_and (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
 				  &op1->where);
   result->value.logical = op1->value.logical && op2->value.logical;
@@ -449,6 +455,9 @@  gfc_arith_or (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
 				  &op1->where);
   result->value.logical = op1->value.logical || op2->value.logical;
@@ -463,6 +472,9 @@  gfc_arith_eqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
 				  &op1->where);
   result->value.logical = op1->value.logical == op2->value.logical;
@@ -477,6 +489,9 @@  gfc_arith_neqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
 				  &op1->where);
   result->value.logical = op1->value.logical != op2->value.logical;
@@ -1187,6 +1202,9 @@  gfc_arith_eq (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (op1->ts.type == BT_COMPLEX)
@@ -1203,6 +1221,9 @@  gfc_arith_ne (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (op1->ts.type == BT_COMPLEX)
@@ -1219,6 +1240,9 @@  gfc_arith_gt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GT) > 0);
@@ -1233,6 +1257,9 @@  gfc_arith_ge (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GE) >= 0);
@@ -1247,6 +1274,9 @@  gfc_arith_lt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LT) < 0);
@@ -1261,6 +1291,9 @@  gfc_arith_le (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
 {
   gfc_expr *result;

+  if (op1->ts.type != op2->ts.type)
+    return ARITH_INVALID_TYPE;
+
   result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
 				  &op1->where);
   result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LE) <= 0);
diff --git a/gcc/testsuite/gfortran.dg/pr107272.f90 b/gcc/testsuite/gfortran.dg/pr107272.f90
new file mode 100644
index 00000000000..4b5c6a0f844
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107272.f90
@@ -0,0 +1,21 @@ 
+! { dg-do compile }
+! PR fortran/107272 - followup of PR/107217 for non-numeric types
+
+program p
+  print *, 2 <= [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2 <  [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2 == [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2 /= [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2 >= [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, 2 >  [real :: (['1'])] ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] >= 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] >  2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] == 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] /= 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] <= 2 ! { dg-error "Cannot convert" }
+  print *, [real :: (['1'])] <  2 ! { dg-error "Cannot convert" }
+  print *, [logical :: (['1'])] .and.  .true. ! { dg-error "Cannot convert" }
+  print *, [logical :: (['1'])] .or.   .true. ! { dg-error "Cannot convert" }
+  print *, [logical :: (['1'])] .eqv.  .true. ! { dg-error "Cannot convert" }
+  print *, [logical :: (['1'])] .neqv. .true. ! { dg-error "Cannot convert" }
+end
--
2.35.3