Rather obvious fix for that ICE.
Comments? If there are none, I will commit it later as obvious.
Tobias
-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
Fortran/OpenMP: Reject non-scalar 'holds' expr in 'omp assume(s)' [PR107424]
gcc/fortran/ChangeLog:
PR fortran/107424
* openmp.cc (gfc_resolve_omp_assumptions): Reject nonscalars.
gcc/testsuite/ChangeLog:
PR fortran/107424
* gfortran.dg/gomp/assume-2.f90: Update dg-error.
* gfortran.dg/gomp/assumes-2.f90: Likewise.
* gfortran.dg/gomp/assume-5.f90: New test.
gcc/fortran/openmp.cc| 8 +---
gcc/testsuite/gfortran.dg/gomp/assume-2.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/assume-5.f90 | 20
gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 | 2 +-
4 files changed, 27 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index b71ee467c01..916daeb1aa5 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6911,9 +6911,11 @@ void
gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume)
{
for (gfc_expr_list *el = assume->holds; el; el = el->next)
-if (!gfc_resolve_expr (el->expr) || el->expr->ts.type != BT_LOGICAL)
- gfc_error ("HOLDS expression at %L must be a logical expression",
- &el->expr->where);
+if (!gfc_resolve_expr (el->expr)
+ || el->expr->ts.type != BT_LOGICAL
+ || el->expr->rank != 0)
+ gfc_error ("HOLDS expression at %L must be a scalar logical expression",
+ &el->expr->where);
}
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90
index ca3e04dfe95..dc306a9088a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/assume-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90
@@ -22,6 +22,6 @@ subroutine foo (i, a)
end if
! !$omp end assume - silence: 'Unexpected !$OMP END ASSUME statement'
- !$omp assume holds (1.0) ! { dg-error "HOLDS expression at .1. must be a logical expression" }
+ !$omp assume holds (1.0) ! { dg-error "HOLDS expression at .1. must be a scalar logical expression" }
!$omp end assume
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-5.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-5.f90
new file mode 100644
index 000..5c6c00750dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-5.f90
@@ -0,0 +1,20 @@
+! PR fortran/107424
+!
+! Contributed by G. Steinmetz
+!
+
+integer function f(i)
+ implicit none
+ !$omp assumes holds(i < g()) ! { dg-error "HOLDS expression at .1. must be a scalar logical expression" }
+ integer, value :: i
+
+ !$omp assume holds(i < g()) ! { dg-error "HOLDS expression at .1. must be a scalar logical expression" }
+ block
+ end block
+ f = 3
+contains
+ function g()
+ integer :: g(2)
+ g = 4
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90
index 729c9737a1c..c8719a86a94 100644
--- a/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90
@@ -4,7 +4,7 @@ module m
!$omp assumes contains(target) holds(x > 0.0)
!$omp assumes absent(target)
!$omp assumes holds(0.0)
-! { dg-error "HOLDS expression at .1. must be a logical expression" "" { target *-*-* } .-1 }
+! { dg-error "HOLDS expression at .1. must be a scalar logical expression" "" { target *-*-* } .-1 }
end module
module m2