diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index a2bf15665b345b48b2ad9142f410e956e2b0a9f6..1dba47126edce7fb2de5ddddf88c2933813a8a0e 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 0000000000000000000000000000000000000000..43f4295494ce12bf7cdc631645cb76169ecea9f8 --- /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