diff options
author | Kwok Cheung Yeung <kcy@codesourcery.com> | 2022-03-03 10:23:26 +0000 |
---|---|---|
committer | Kwok Cheung Yeung <kcy@codesourcery.com> | 2022-03-03 10:25:11 +0000 |
commit | 88c4d85e27e18bf991ab8728b73127a0385f2c27 (patch) | |
tree | d8da68a27c3a7dd423d86d2ef74e676c9c576963 | |
parent | 5b5e456f0187406e17444b6e40d974f94524f2a2 (diff) | |
download | gcc-88c4d85e27e18bf991ab8728b73127a0385f2c27.zip gcc-88c4d85e27e18bf991ab8728b73127a0385f2c27.tar.gz gcc-88c4d85e27e18bf991ab8728b73127a0385f2c27.tar.bz2 |
openmp, fortran: Check that the type of an event handle in a detach clause is suitable [PR104131]
This rejects variables that are array types, array elements or derived type
members when used as the event handle inside a detach clause (in accordance
with the OpenMP specification). This would previously lead to an ICE.
2022-03-03 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/fortran/
PR fortran/104131
* openmp.cc (gfc_match_omp_detach): Move check for type of event
handle to...
(resolve_omp_clauses) ...here. Also check that the event handle is
not an array, or an array access or structure element access.
gcc/testsuite/
PR fortran/104131
* gfortran.dg/gomp/pr104131.f90: New.
* gfortran.dg/gomp/task-detach-1.f90: Update expected error message.
-rw-r--r-- | gcc/fortran/openmp.cc | 34 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/pr104131.f90 | 26 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 | 4 |
3 files changed, 51 insertions, 13 deletions
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 19142c4..16cd03a 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -531,14 +531,6 @@ gfc_match_omp_detach (gfc_expr **expr) if (gfc_match_variable (expr, 0) != MATCH_YES) goto syntax_error; - if ((*expr)->ts.type != BT_INTEGER || (*expr)->ts.kind != gfc_c_intptr_kind) - { - gfc_error ("%qs at %L should be of type " - "integer(kind=omp_event_handle_kind)", - (*expr)->symtree->n.sym->name, &(*expr)->where); - return MATCH_ERROR; - } - if (gfc_match_char (')') != MATCH_YES) goto syntax_error; @@ -7581,9 +7573,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("%s must contain at least one MAP clause at %L", p, &code->loc); } - if (!openacc && omp_clauses->mergeable && omp_clauses->detach) - gfc_error ("%<DETACH%> clause at %L must not be used together with " - "%<MERGEABLE%> clause", &omp_clauses->detach->where); + + if (!openacc && omp_clauses->detach) + { + if (!gfc_resolve_expr (omp_clauses->detach) + || omp_clauses->detach->ts.type != BT_INTEGER + || omp_clauses->detach->ts.kind != gfc_c_intptr_kind + || omp_clauses->detach->rank != 0) + gfc_error ("%qs at %L should be a scalar of type " + "integer(kind=omp_event_handle_kind)", + omp_clauses->detach->symtree->n.sym->name, + &omp_clauses->detach->where); + else if (omp_clauses->detach->symtree->n.sym->attr.dimension > 0) + gfc_error ("The event handle at %L must not be an array element", + &omp_clauses->detach->where); + else if (omp_clauses->detach->symtree->n.sym->ts.type == BT_DERIVED + || omp_clauses->detach->symtree->n.sym->ts.type == BT_CLASS) + gfc_error ("The event handle at %L must not be part of " + "a derived type or class", &omp_clauses->detach->where); + + if (omp_clauses->mergeable) + gfc_error ("%<DETACH%> clause at %L must not be used together with " + "%<MERGEABLE%> clause", &omp_clauses->detach->where); + } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr104131.f90 b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90 new file mode 100644 index 0000000..472d19d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr104131.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +program p + use iso_c_binding, only: c_intptr_t + implicit none + integer, parameter :: omp_event_handle_kind = c_intptr_t + + type dt + integer(omp_event_handle_kind) :: f + end type + integer(omp_event_handle_kind) :: x(1) + type(dt) :: y + + !$omp task detach(x) ! { dg-error "'x' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" } + !$omp end task + + !$omp task detach(x(1)) ! { dg-error "The event handle at \\\(1\\\) must not be an array element" } + !$omp end task + + !$omp task detach(y) ! { dg-error "'y' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" } + !$omp end task + + !$omp task detach(y%f) ! { dg-error "The event handle at \\\(1\\\) must not be part of a derived type or class" } + !$omp end task +end program diff --git a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 index 020be13..2e77aea 100644 --- a/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/task-detach-1.f90 @@ -18,8 +18,8 @@ program task_detach_1 !$omp task detach(x) mergeable ! { dg-error "'DETACH' clause at \\\(1\\\) must not be used together with 'MERGEABLE' clause" } !$omp end task - !$omp task detach(z) ! { dg-error "'z' at \\\(1\\\) should be of type integer\\\(kind=omp_event_handle_kind\\\)" } - !$omp end task ! { dg-error "Unexpected !\\\$OMP END TASK statement at \\\(1\\\)" } + !$omp task detach(z) ! { dg-error "'z' at \\\(1\\\) should be a scalar of type integer\\\(kind=omp_event_handle_kind\\\)" } + !$omp end task !$omp task detach (x) firstprivate (x) ! { dg-error "DETACH event handle 'x' in FIRSTPRIVATE clause at \\\(1\\\)" } !$omp end task |