From 6a893783f972a2c5d53186dfa15e0a7b8f1b2990 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 16 Jun 2020 15:11:12 +0200 Subject: [PATCH] OpenMP/Fortran: Permit impure ELEMENTAL in omp directives OpenMP since 4.5 permits IMPURE ELEMENTAL in directives and the code already only checked for PURE. gcc/fortran/ChangeLog: * parse.c (decode_omp_directive): Remove "or ELEMENTAL" from "in PURE" error message. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr79154-1.f90: Update dg-*; add an impure elemental example. * gfortran.dg/gomp/pr79154-2.f90: Likewise. --- gcc/fortran/parse.c | 4 ++-- gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 | 15 +++++++++----- gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 | 30 +++++++++++++++++++--------- 3 files changed, 33 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index f71a95d..9d90e50 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -849,7 +849,7 @@ decode_omp_directive (void) /* match is for directives that should be recognized only if -fopenmp, matchs for directives that should be recognized if either -fopenmp or -fopenmp-simd. - Handle only the directives allowed in PURE/ELEMENTAL procedures + Handle only the directives allowed in PURE procedures first (those also shall not turn off implicit pure). */ switch (c) { @@ -868,7 +868,7 @@ decode_omp_directive (void) if (flag_openmp && gfc_pure (NULL)) { gfc_error_now ("OpenMP directives other than SIMD or DECLARE TARGET " - "at %C may not appear in PURE or ELEMENTAL procedures"); + "at %C may not appear in PURE procedures"); gfc_error_recovery (); return ST_NONE; } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 index 69a0009..ea147bf 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-1.f90 @@ -2,7 +2,7 @@ ! { dg-do compile } pure real function foo (a, b) ! { dg-warning "GCC does not currently support mixed size types for 'simd' functions" "" { target aarch64*-*-* } } -!$omp declare simd(foo) ! { dg-bogus "may not appear in PURE or ELEMENTAL" } +!$omp declare simd(foo) ! { dg-bogus "may not appear in PURE" } real, intent(in) :: a, b foo = a + b end function foo @@ -10,23 +10,28 @@ pure function bar (a, b) real, intent(in) :: a(8), b(8) real :: bar(8) integer :: i -!$omp simd ! { dg-bogus "may not appear in PURE or ELEMENTAL" } +!$omp simd ! { dg-bogus "may not appear in PURE" } do i = 1, 8 bar(i) = a(i) + b(i) end do end function bar pure real function baz (a, b) -!$omp declare target ! { dg-bogus "may not appear in PURE or ELEMENTAL" } +!$omp declare target ! { dg-bogus "may not appear in PURE" } real, intent(in) :: a, b baz = a + b end function baz elemental real function fooe (a, b) ! { dg-warning "GCC does not currently support mixed size types for 'simd' functions" "" { target aarch64*-*-* } } -!$omp declare simd(fooe) ! { dg-bogus "may not appear in PURE or ELEMENTAL" } +!$omp declare simd(fooe) ! { dg-bogus "may not appear in PURE" } real, intent(in) :: a, b fooe = a + b end function fooe elemental real function baze (a, b) -!$omp declare target ! { dg-bogus "may not appear in PURE or ELEMENTAL" } +!$omp declare target ! { dg-bogus "may not appear in PURE" } real, intent(in) :: a, b baze = a + b end function baze +elemental impure real function bazei (a, b) +!$omp declare target ! { dg-bogus "may not appear in PURE" } + real, intent(in) :: a, b + baze = a + b +end function bazei diff --git a/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 index 67344f0..38d3fe5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr79154-2.f90 @@ -3,14 +3,14 @@ pure real function foo (a, b) real, intent(in) :: a, b -!$omp taskwait ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp taskwait ! { dg-error "may not appear in PURE" } foo = a + b end function foo pure function bar (a, b) real, intent(in) :: a(8), b(8) real :: bar(8) integer :: i -!$omp do simd ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp do simd ! { dg-error "may not appear in PURE" } do i = 1, 8 bar(i) = a(i) + b(i) end do @@ -19,26 +19,38 @@ pure function baz (a, b) real, intent(in) :: a(8), b(8) real :: baz(8) integer :: i -!$omp do ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp do ! { dg-error "may not appear in PURE" } do i = 1, 8 baz(i) = a(i) + b(i) end do -!$omp end do ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp end do ! { dg-error "may not appear in PURE" } end function baz pure real function baz2 (a, b) real, intent(in) :: a, b -!$omp target map(from:baz2) ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp target map(from:baz2) ! { dg-error "may not appear in PURE" } baz2 = a + b -!$omp end target ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp end target ! { dg-error "may not appear in PURE" } end function baz2 +! ELEMENTAL implies PURE elemental real function fooe (a, b) real, intent(in) :: a, b -!$omp taskyield ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp taskyield ! { dg-error "may not appear in PURE" } fooe = a + b end function fooe elemental real function baze (a, b) real, intent(in) :: a, b -!$omp target map(from:baz) ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp target map(from:baz) ! { dg-error "may not appear in PURE" } baze = a + b -!$omp end target ! { dg-error "may not appear in PURE or ELEMENTAL" } +!$omp end target ! { dg-error "may not appear in PURE" } end function baze +elemental impure real function fooei (a, b) + real, intent(in) :: a, b +!$omp taskyield ! { dg-bogus "may not appear in PURE" } + fooe = a + b +end function fooei +elemental impure real function bazei (a, b) + real, intent(in) :: a, b +!$omp target map(from:baz) ! { dg-bogus "may not appear in PURE" } + baze = a + b +!$omp end target ! { dg-bogus "may not appear in PURE" } +end function bazei -- 2.7.4