OpenMP/Fortran: Fix defaultmap(none) issue with dummy procedures [PR114283] Dummy procedures look similar to variables but aren't - neither in Fortran nor in OpenMP. As the middle end sees PARM_DECLs, mark them as predetermined firstprivate for mapping (as already done in gfc_omp_predetermined_sharing). This does not address the isses related to procedure pointers, which are still discussed on spec level [see PR]. PR fortran/114283 gcc/fortran/ChangeLog: * trans-openmp.cc (gfc_omp_predetermined_mapping): Map dummy procedures as firstprivate. libgomp/ChangeLog: * testsuite/libgomp.fortran/declare-target-indirect-4.f90: New test. gcc/fortran/trans-openmp.cc | 9 +++++ .../libgomp.fortran/declare-target-indirect-4.f90 | 43 ++++++++++++++++++++++ 2 files changed, 52 insertions(+) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index a2bf15665b3..1dba47126ed 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -343,6 +343,15 @@ gfc_omp_predetermined_mapping (tree decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))) return OMP_CLAUSE_DEFAULTMAP_TO; + /* Dummy procedures aren't considered variables by OpenMP, thus are + disallowed in OpenMP clauses. They are represented as PARM_DECLs + in the middle-end, so return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE here + to avoid complaining about their uses with defaultmap(none). */ + if (TREE_CODE (decl) == PARM_DECL + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE + && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE) + return OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE; + /* These are either array or derived parameters, or vtables. */ if (VAR_P (decl) && TREE_READONLY (decl) && (TREE_STATIC (decl) || DECL_EXTERNAL (decl))) diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90 new file mode 100644 index 00000000000..43f4295494c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-4.f90 @@ -0,0 +1,43 @@ +! { dg-additional-options "-fdump-tree-gimple" } + +! PR fortran/114283 + +! { dg-final { scan-tree-dump "#pragma omp parallel shared\\(i\\) if\\(0\\) default\\(none\\) firstprivate\\(g\\)" "gimple" } } +! { dg-final { scan-tree-dump "#pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) firstprivate\\(h\\) map\\(from:j \\\[len: 4\\\]\\) defaultmap\\(none\\)" "gimple" } } + + +module m + implicit none (type, external) + !$omp declare target indirect enter(f1, f2) +contains + integer function f1 () + f1 = 99 + end + integer function f2 () + f2 = 89 + end +end module m + +use m +implicit none (type, external) +call sub1(f1) +call sub2(f2) +contains + subroutine sub1(g) + procedure(integer) :: g + integer :: i + !$omp parallel default(none) if(.false.) shared(i) + i = g () + !$omp end parallel + if (i /= 99) stop 1 + end + + subroutine sub2(h) + procedure(integer) :: h + integer :: j + !$omp target defaultmap(none) map(from:j) + j = h () + !$omp end target + if (j /= 89) stop 1 + end +end