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.
This commit is contained in:
parent
6586359e8e
commit
c5037fcee2
2 changed files with 52 additions and 0 deletions
|
@ -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)))
|
||||
|
|
|
@ -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
|
Loading…
Add table
Reference in a new issue