From 799478b8914c438f7a33eb319efbae69c81f2111 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 16 Feb 2021 17:39:49 +0100 Subject: [PATCH] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous gcc/fortran/ChangeLog: * expr.c (gfc_is_simplify_contiguous): Handle REF_INQUIRY, i.e. %im and %re which are EXPR_VARIABLE. * openmp.c (resolve_omp_clauses): Diagnose %re/%im explicitly. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/ref_inquiry.f90: New test. * gfortran.dg/gomp/ref_inquiry.f90: New test. --- gcc/fortran/expr.c | 2 + gcc/fortran/openmp.c | 8 +++ .../gfortran.dg/goacc/ref_inquiry.f90 | 56 +++++++++++++++++++ .../gfortran.dg/gomp/ref_inquiry.f90 | 39 +++++++++++++ 4 files changed, 105 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 4f456fc629a..92a6700568d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -5854,6 +5854,8 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) part_ref = ref; else if (ref->type == REF_SUBSTRING) return false; + else if (ref->type == REF_INQUIRY) + return false; else if (ref->u.ar.type != AR_ELEMENT) ar = &ref->u.ar; } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index aab17f0589f..1e541ebdafa 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -5218,6 +5218,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && array_ref->next->type == REF_SUBSTRING))) gfc_error ("Unexpected substring reference in %s clause " "at %L", name, &n->where); + else if (array_ref && array_ref->type == REF_INQUIRY) + { + gcc_assert (array_ref->u.i == INQUIRY_RE + || array_ref->u.i == INQUIRY_IM); + gfc_error ("Unexpected complex-parts designator " + "reference in %s clause at %L", + name, &n->where); + } else if (!resolved || n->expr->expr_type != EXPR_VARIABLE || array_ref->next diff --git a/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 new file mode 100644 index 00000000000..69dd38e5197 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 @@ -0,0 +1,56 @@ +! Check for %re, ...%im, ...%kind, ...%len +! Cf. also OpenMP's ../gomp/ref_inquiry.f90 +! Cf. OpenACC spec issue 346 +! +implicit none +type t + integer :: i + character :: c + complex :: z + complex :: zz(5) +end type t + +integer :: i +character(kind=4, len=5) :: c +complex :: z, zz(5) +type(t) :: x + +print *, is_contiguous(zz(:)%re) + +! inquiry function; expr_type != EXPR_VARIABLE: +!$acc enter data copyin(i%kind, c%len) ! { dg-error "not a proper array section" } +!$acc enter data copyin(x%i%kind) ! { dg-error "not a proper array section" } +!$acc enter data copyin(x%c%len) ! { dg-error "not a proper array section" } +!$acc update self(i%kind, c%len) ! { dg-error "not a proper array section" } +!$acc update self(x%i%kind) ! { dg-error "not a proper array section" } +!$acc update self(x%c%len) ! { dg-error "not a proper array section" } + +! EXPR_VARIABLE +!$acc enter data copyin(z%re) ! { dg-error "Unexpected complex-parts designator" } +!$acc enter data copyin(z%im) ! { dg-error "Unexpected complex-parts designator" } +!$acc enter data copyin(zz%re) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$acc enter data copyin(zz%im) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } + +!$acc enter data copyin(x%z%re) ! { dg-error "Unexpected complex-parts designator" } +!$acc enter data copyin(x%z%im) ! { dg-error "Unexpected complex-parts designator" } +!$acc enter data copyin(x%zz%re) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$acc enter data copyin(x%zz%im) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } + +!$acc update self(z%re) ! { dg-error "Unexpected complex-parts designator" } +!$acc update self(z%im) ! { dg-error "Unexpected complex-parts designator" } +!$acc update self(zz%re) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$acc update self(zz%im) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } + +!$acc update self(x%z%re) ! { dg-error "Unexpected complex-parts designator" } +!$acc update self(x%z%im) ! { dg-error "Unexpected complex-parts designator" } +!$acc update self(x%zz%re) ! { dg-error "is not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$acc update self(x%zz%im) ! { dg-error "is not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90 b/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90 new file mode 100644 index 00000000000..37461040560 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90 @@ -0,0 +1,39 @@ +! Check for %re, ...%im, ...%kind, ...%len +! Cf. also OpenACC's ../goacc/ref_inquiry.f90 +! Cf. also OpenMP spec issue 2661 +implicit none +type t + integer :: i + character :: c + complex :: z + complex :: zz(5) +end type t + +integer :: i +character(kind=4, len=5) :: c +complex :: z, zz(5) +type(t) :: x + +print *, is_contiguous(zz(:)%re) + +! inquiry function; expr_type != EXPR_VARIABLE: +!$omp target enter data map(to: i%kind, c%len) ! { dg-error "not a proper array section" } +!$omp target enter data map(to: x%i%kind) ! { dg-error "not a proper array section" } +!$omp target enter data map(to: x%c%len) ! { dg-error "not a proper array section" } + +! EXPR_VARIABLE +!$omp target enter data map(to: z%re) ! { dg-error "Unexpected complex-parts designator" } +!$omp target enter data map(to: z%im) ! { dg-error "Unexpected complex-parts designator" } +!$omp target enter data map(to: zz%re) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$omp target enter data map(to: zz%im) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } + +!$omp target enter data map(to: x%z%re) ! { dg-error "Unexpected complex-parts designator" } +!$omp target enter data map(to: x%z%im) ! { dg-error "Unexpected complex-parts designator" } +!$omp target enter data map(to: x%zz%re) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } +!$omp target enter data map(to: x%zz%im) ! { dg-error "not a proper array section" } + ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 } + +end -- 2.30.2