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. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/target4.f90: New test. gcc/fortran/trans-openmp.cc | 9 +++++++++ gcc/testsuite/gfortran.dg/gomp/target4.f90 | 18 ++++++++++++++++++ 2 files changed, 27 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/gcc/testsuite/gfortran.dg/gomp/target4.f90 b/gcc/testsuite/gfortran.dg/gomp/target4.f90 new file mode 100644 index 00000000000..09364e707f1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/target4.f90 @@ -0,0 +1,18 @@ +! { dg-additional-options "-fdump-tree-gimple" } + +! PR fortran/114283 + +! { dg-final { scan-tree-dump "#pragma omp parallel default\\(none\\) firstprivate\\(g\\)" "gimple" } } +! { dg-final { scan-tree-dump "#pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) defaultmap\\(none\\) firstprivate\\(g\\)" "gimple" } } + +subroutine f(g) +procedure() :: g + +!$omp parallel default(none) + call g +!$omp end parallel + +!$omp target defaultmap(none) + call g +!$omp end target +end