From a2795be8cc85b052069e26e74b0b377bc5771706 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Tue, 10 Jun 2014 06:05:22 +0000 Subject: PR fortran/60928 * omp-low.c (lower_rec_input_clauses) : Set lastprivate_firstprivate even if omp_private_outer_ref langhook returns true. : When calling omp_clause_default_ctor langhook, call unshare_expr on new_var and call build_outer_var_ref to get the last argument. gcc/c-family/ * c-pragma.c (omp_pragmas_simd): Move PRAGMA_OMP_TASK... (omp_pragmas): ... back here. gcc/fortran/ * f95-lang.c (gfc_init_builtin_functions): Handle -fopenmp-simd like -fopenmp. * openmp.c (resolve_omp_clauses): Remove allocatable components diagnostics. Add associate-name and intent(in) pointer diagnostics for various clauses, diagnose procedure pointers in reduction clause. * parse.c (match_word_omp_simd): New function. (matchs, matcho): New macros. (decode_omp_directive): Change match macros to either matchs or matcho. Handle -fopenmp-simd. (next_free, next_fixed): Handle -fopenmp-simd like -fopenmp. * scanner.c (skip_free_comments, skip_fixed_comments, include_line): Likewise. * trans-array.c (get_full_array_size): Rename to... (gfc_full_array_size): ... this. No longer static. (duplicate_allocatable): Adjust caller. Add NO_MEMCPY argument and handle it. (gfc_duplicate_allocatable, gfc_copy_allocatable_data): Adjust duplicate_allocatable callers. (gfc_duplicate_allocatable_nocopy): New function. (structure_alloc_comps): Adjust g*_full_array_size and duplicate_allocatable caller. * trans-array.h (gfc_full_array_size, gfc_duplicate_allocatable_nocopy): New prototypes. * trans-common.c (create_common): Call gfc_finish_decl_attrs. * trans-decl.c (gfc_finish_decl_attrs): New function. (gfc_finish_var_decl, create_function_arglist, gfc_get_fake_result_decl): Call it. (gfc_allocate_lang_decl): If DECL_LANG_SPECIFIC is already allocated, don't allocate it again. (gfc_get_symbol_decl): Set GFC_DECL_ASSOCIATE_VAR_P on associate-names. * trans.h (gfc_finish_decl_attrs): New prototype. (struct lang_decl): Add scalar_allocatable and scalar_pointer bitfields. (GFC_DECL_SCALAR_ALLOCATABLE, GFC_DECL_SCALAR_POINTER, GFC_DECL_GET_SCALAR_ALLOCATABLE, GFC_DECL_GET_SCALAR_POINTER, GFC_DECL_ASSOCIATE_VAR_P): Define. (GFC_POINTER_TYPE_P): Remove. * trans-openmp.c (gfc_omp_privatize_by_reference): Don't check GFC_POINTER_TYPE_P, instead test GFC_DECL_GET_SCALAR_ALLOCATABLE, GFC_DECL_GET_SCALAR_POINTER or GFC_DECL_CRAY_POINTEE on decl. (gfc_omp_predetermined_sharing): Associate-names are predetermined. (enum walk_alloc_comps): New. (gfc_has_alloc_comps, gfc_omp_unshare_expr_r, gfc_omp_unshare_expr, gfc_walk_alloc_comps): New functions. (gfc_omp_private_outer_ref): Return true for scalar allocatables or decls with allocatable components. (gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Fix up handling of allocatables, handle also OMP_CLAUSE_REDUCTION, handle scalar allocatables and decls with allocatable components. (gfc_trans_omp_array_reduction_or_udr): Don't handle allocatable arrays here. (gfc_trans_omp_reduction_list): Call gfc_trans_omp_array_reduction_or_udr even for allocatable scalars. (gfc_trans_omp_do_simd): If -fno-openmp, just expand it as OMP_SIMD. (gfc_trans_omp_parallel_do_simd): Likewise. * trans-types.c (gfc_sym_type): Don't set GFC_POINTER_TYPE_P. (gfc_get_derived_type): Call gfc_finish_decl_attrs. gcc/testsuite/ * gfortran.dg/gomp/allocatable_components_1.f90: Remove dg-error directives. * gfortran.dg/gomp/associate1.f90: New test. * gfortran.dg/gomp/intentin1.f90: New test. * gfortran.dg/gomp/openmp-simd-1.f90: New test. * gfortran.dg/gomp/openmp-simd-2.f90: New test. * gfortran.dg/gomp/openmp-simd-3.f90: New test. * gfortran.dg/gomp/proc_ptr_2.f90: New test. libgomp/ * testsuite/libgomp.fortran/allocatable9.f90: New test. * testsuite/libgomp.fortran/allocatable10.f90: New test. * testsuite/libgomp.fortran/allocatable11.f90: New test. * testsuite/libgomp.fortran/allocatable12.f90: New test. * testsuite/libgomp.fortran/alloc-comp-1.f90: New test. * testsuite/libgomp.fortran/alloc-comp-2.f90: New test. * testsuite/libgomp.fortran/alloc-comp-3.f90: New test. * testsuite/libgomp.fortran/associate1.f90: New test. * testsuite/libgomp.fortran/associate2.f90: New test. * testsuite/libgomp.fortran/procptr1.f90: New test. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@211397 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 | 328 ++++++++++++++++++ libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 | 367 ++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 | 372 +++++++++++++++++++++ .../testsuite/libgomp.fortran/allocatable10.f90 | 112 +++++++ .../testsuite/libgomp.fortran/allocatable11.f90 | 72 ++++ .../testsuite/libgomp.fortran/allocatable12.f90 | 74 ++++ libgomp/testsuite/libgomp.fortran/allocatable9.f90 | 156 +++++++++ libgomp/testsuite/libgomp.fortran/associate1.f90 | 23 ++ libgomp/testsuite/libgomp.fortran/associate2.f90 | 46 +++ libgomp/testsuite/libgomp.fortran/procptr1.f90 | 42 +++ 10 files changed, 1592 insertions(+) create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocatable10.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocatable11.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocatable12.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocatable9.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/associate1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/associate2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/procptr1.f90 (limited to 'libgomp/testsuite/libgomp.fortran') diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 new file mode 100644 index 00000000000..2a2a12ec817 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-1.f90 @@ -0,0 +1,328 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt) :: y + call foo (y) +contains + subroutine foo (y) + use m + type (dt) :: x, y, z(-3:-3,2:3) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x%h, x%k) + deallocate (y%h) + allocate (y%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 new file mode 100644 index 00000000000..490ed24cf4f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-2.f90 @@ -0,0 +1,367 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt), allocatable :: y + call foo (y) +contains + subroutine foo (y) + use m + type (dt), allocatable :: x, y, z(:,:) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l +!$omp parallel private (x, y, z) + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort +!$omp end parallel +!$omp parallel firstprivate (x, y, z) + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort +!$omp end parallel + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (.not. l) then + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort + end if +!$omp section + if (.not. l) then + if (allocated (x) .or. allocated (y) .or. allocated (z)) call abort + end if + allocate (x, y, z(-3:-3,2:3)) + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + if (.not.allocated (x) .or. .not.allocated (y)) call abort + if (.not.allocated (z)) call abort + if (lbound (z, 1) /= -3 .or. ubound (z, 1) /= -3) call abort + if (lbound (z, 2) /= 2 .or. ubound (z, 2) /= 3) call abort + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x%h, x%k) + deallocate (y%h) + allocate (y%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y, 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x, 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x, 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y, 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x, 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y, 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x, 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y, 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x, 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y, 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x, 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x, 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y, 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x, 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x, 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y, 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x, 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y, 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 new file mode 100644 index 00000000000..20f13144a62 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-3.f90 @@ -0,0 +1,372 @@ +! { dg-do run } +! Don't cycle by default through all options, just test -O0 and -O2, +! as this is quite large test. +! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O0" "-O2" } } + +module m + type dl + integer :: a, b + integer, allocatable :: c(:,:) + integer :: d, e + integer, allocatable :: f + end type + type dt + integer :: g + type (dl), allocatable :: h(:) + integer :: i + type (dl) :: j(2, 2) + type (dl), allocatable :: k + end type +contains + subroutine ver_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (in) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if ((c .neqv. allocated (obj%c)) .or. (f .neqv. allocated (obj%f))) call abort + if (c) then + if (lbound (obj%c, 1) /= cl1 .or. ubound (obj%c, 1) /= cu1) call abort + if (lbound (obj%c, 2) /= cl2 .or. ubound (obj%c, 2) /= cu2) call abort + end if + if (val /= 0) then + if (obj%a /= val .or. obj%b /= val) call abort + if (obj%d /= val .or. obj%e /= val) call abort + if (c) then + if (any (obj%c /= val)) call abort + end if + if (f) then + if (obj%f /= val) call abort + end if + end if + end subroutine ver_dl + subroutine ver_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (in) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if ((h .neqv. allocated (obj%h)) .or. (k .neqv. allocated (obj%k))) call abort + if (h) then + if (lbound (obj%h, 1) /= hl .or. ubound (obj%h, 1) /= hu) call abort + do i = hl, hu + call ver_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call ver_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) call ver_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + if (val /= 0) then + if (obj%g /= val .or. obj%i /= val) call abort + end if + end subroutine ver_dt + subroutine alloc_dl (obj, val, c, cl1, cu1, cl2, cu2, f) + type (dl), intent (inout) :: obj + integer, intent (in) :: val, cl1, cu1, cl2, cu2 + logical, intent (in) :: c, f + if (val /= 0) then + obj%a = val + obj%b = val + obj%d = val + obj%e = val + end if + if (allocated (obj%c)) deallocate (obj%c) + if (c) then + allocate (obj%c(cl1:cu1, cl2:cu2)) + if (val /= 0) obj%c = val + end if + if (f) then + if (.not.allocated (obj%f)) allocate (obj%f) + if (val /= 0) obj%f = val + else + if (allocated (obj%f)) deallocate (obj%f) + end if + end subroutine alloc_dl + subroutine alloc_dt (obj, val, h, hl, hu, k, c, cl1, cu1, cl2, cu2, f) + type (dt), intent (inout) :: obj + integer, intent (in) :: val, hl, hu, cl1, cu1, cl2, cu2 + logical, intent (in) :: h, k, c, f + integer :: i, j + if (val /= 0) then + obj%g = val + obj%i = val + end if + if (allocated (obj%h)) deallocate (obj%h) + if (h) then + allocate (obj%h(hl:hu)) + do i = hl, hu + call alloc_dl (obj%h(i), val, c, cl1, cu1, cl2, cu2, f) + end do + end if + do i = 1, 2 + do j = 1, 2 + call alloc_dl (obj%j(i, j), val, c, cl1, cu1, cl2, cu2, f) + end do + end do + if (k) then + if (.not.allocated (obj%k)) allocate (obj%k) + call alloc_dl (obj%k, val, c, cl1, cu1, cl2, cu2, f) + else + if (allocated (obj%k)) deallocate (obj%k) + end if + end subroutine alloc_dt +end module m + use m + type (dt), allocatable :: z(:,:) + type (dt) :: y(2:3) + call foo (y, z, 4) +contains + subroutine foo (y, z, n) + use m + integer :: n + type (dt) :: x(2:n), y(3:) + type (dt), allocatable :: z(:,:) + logical, parameter :: F = .false. + logical, parameter :: T = .true. + logical :: l + if (lbound (x, 1) /= 2 .or. ubound (x, 1) /= 4) call abort + if (lbound (y, 1) /= 3 .or. ubound (y, 1) /= 4) call abort + call ver_dt (x(2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x(n), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (z) + if (allocated (z)) call abort +!$omp end parallel +!$omp parallel firstprivate (z) + if (allocated (z)) call abort +!$omp end parallel + l = F +!$omp parallel sections lastprivate (z) firstprivate (l) +!$omp section + if (.not. l) then + if (allocated (z)) call abort + end if +!$omp section + if (.not. l) then + if (allocated (z)) call abort + end if + allocate (z(-3:-3,2:3)) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + if (.not.allocated (z)) call abort + if (lbound (z, 1) /= -3 .or. ubound (z, 1) /= -3) call abort + if (lbound (z, 2) /= 2 .or. ubound (z, 2) /= 3) call abort + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 14, T, 3, 4, F, T, 1, 1, 2, 4, T) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (x(n - 1)%h, x(n - 1)%k) + deallocate (y(4)%h) + allocate (y(4)%k) + call ver_dt (z(-3,2), 0, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 0, T, 3, 4, F, T, 1, 1, 2, 4, T) + deallocate (z(-3,2)%h, z(-3,2)%k) + deallocate (z(-3,3)%h) + allocate (z(-3,3)%k) +!$omp end parallel + call alloc_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) +!$omp parallel firstprivate (x, y, z) + if (lbound (x, 1) /= 2 .or. ubound (x, 1) /= 4) call abort + if (lbound (y, 1) /= 3 .or. ubound (y, 1) /= 4) call abort + call ver_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y(4), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (y(4), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) + call ver_dt (z(-3,3), 4, T, 3, 4, T, T, 1, 1, 2, 4, T) +!$omp end parallel + call ver_dt (x(n - 1), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,2), 5, T, 1, 2, F, T, 2, 3, -2, -2, F) + call alloc_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 15, F, 0, 0, T, T, 2, 2, 2, 2, T) + call alloc_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) +!$omp parallel firstprivate (x, y, z) + call ver_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (x(n - 1), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (y(4), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,2), 4, T, -3, -1, T, T, -1, -1, 2, 3, T) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) + call ver_dt (z(-3,3), 17, T, 1, 2, F, T, 2, 2, 3, 3, F) +!$omp end parallel + call ver_dt (x(n - 1), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (y(4), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 4, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 16, F, 0, 0, F, F, 0, 0, 0, 0, F) + call alloc_dt (z(-3,3), 18, T, 0, 1, T, T, 0, 1, 0, 1, T) + l = F +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + else + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call alloc_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call alloc_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) +!$omp section + if (l) then + call ver_dt (x(n - 1), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (y(4), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + call ver_dt (z(-3,2), 7, T, 1, 1, T, T, 1, 2, 3, 3, T) + call ver_dt (z(-3,3), 20, T, 0, 0, F, T, 2, 2, 3, 4, F) + else + call ver_dt (x(n - 1), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(4), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + call ver_dt (z(-3,2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 0, 1, 0, 1, T) + end if + l = T + call alloc_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call alloc_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call alloc_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp section +!$omp end parallel sections + call ver_dt (x(n - 1), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 9, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 21, F, 0, 0, T, T, 1, 2, 3, 4, T) +!$omp parallel sections lastprivate (x, y, z) firstprivate (l) +!$omp section + if (l) then + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + else + call ver_dt (x(n - 1), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp section + if (l) then + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + else + call ver_dt (x(n - 1), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (y(4), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + call ver_dt (z(-3,2), 0, T, 1, 1, F, F, 0, 0, 0, 0, T) + call ver_dt (z(-3,3), 0, F, 0, 0, T, T, 1, 2, 3, 4, T) + end if + l = T + call alloc_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call alloc_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call alloc_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp section +!$omp end parallel sections + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp parallel private (x, y, z) + call ver_dt (x(n - 1), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 0, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 0, T, 0, 1, T, T, 2, 2, 2, 2, F) +!$omp single + call alloc_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call alloc_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call alloc_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end single copyprivate (x, y, z) + call ver_dt (x(n - 1), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (y(4), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) + call ver_dt (z(-3,2), 3, F, 0, 0, T, T, 0, 1, 0, 1, F) + call ver_dt (z(-3,3), 22, T, 5, 5, F, T, 2, 3, 2, 2, T) +!$omp end parallel + call ver_dt (x(n - 1), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (y(4), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (z(-3,2), 5, F, 0, 0, T, T, -1, -1, -1, -1, T) + call ver_dt (z(-3,3), 23, T, 0, 1, T, T, 2, 2, 2, 2, F) + call ver_dt (x(2), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (x(n), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + call ver_dt (y(3), 0, F, 0, 0, F, F, 0, 0, 0, 0, F) + end subroutine foo +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable10.f90 b/libgomp/testsuite/libgomp.fortran/allocatable10.f90 new file mode 100644 index 00000000000..54eed617b45 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable10.f90 @@ -0,0 +1,112 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + integer :: i +!$omp declare reduction (foo : integer : omp_out = omp_out + omp_in) & +!$omp & initializer (omp_priv = 0) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(6:9), c(3, 8:9)) + a = 0 + b = 0 + c = 0 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort +!$omp parallel do reduction (+:a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp parallel do reduction (foo : a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp simd reduction (+:a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort + a = 0 + b = 0 + c = 0 +!$omp simd reduction (foo : a, b, c) + do i = 1, 10 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + a = a + i + b = b + 2 * i + c = c + 3 * i + end do + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 55 .or. any (b /= 110) .or. any (c /= 165)) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable11.f90 b/libgomp/testsuite/libgomp.fortran/allocatable11.f90 new file mode 100644 index 00000000000..479f6041b7d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable11.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +! { dg-require-effective-target tls_runtime } + + use omp_lib + integer, allocatable, save :: a, b(:), c(:,:) + integer :: p +!$omp threadprivate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + + call omp_set_dynamic (.false.) + call omp_set_num_threads (4) + +!$omp parallel num_threads (4) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp end parallel + + allocate (a, b(6:9), c(3, 8:9)) + a = 4 + b = 5 + c = 6 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + +!$omp parallel num_threads (4) copyin (a, b, c) private (p) + p = omp_get_thread_num () + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 4 .or. any (b /= 5) .or. any (c /= 6)) call abort + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(p:9), c(3, p:7)) + a = p + b = p + c = p + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= (10 - p)) call abort + if (lbound (b, 1) /= p .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= (3 * (8 - p))) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= (8 - p)) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= p .or. ubound (c, 2) /= 7) call abort + if (a /= p .or. any (b /= p) .or. any (c /= p)) call abort +!$omp end parallel + +!$omp parallel num_threads (4) copyin (a, b, c) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 10) call abort + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 24) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 8) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 0 .or. ubound (c, 2) /= 7) call abort + if (a /= 0 .or. any (b /= 0) .or. any (c /= 0)) call abort +!$omp end parallel + + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp parallel num_threads (4) copyin (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable12.f90 b/libgomp/testsuite/libgomp.fortran/allocatable12.f90 new file mode 100644 index 00000000000..533ab7cd85d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable12.f90 @@ -0,0 +1,74 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + logical :: l + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp parallel private (a, b, c, l) + l = .false. + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + +!$omp single + allocate (a, b(6:9), c(3, 8:9)) + a = 4 + b = 5 + c = 6 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 4 .or. any (b /= 5) .or. any (c /= 6)) call abort + +!$omp single + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(0:4), c(3, 2:7)) + a = 1 + b = 2 + c = 3 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 5) call abort + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 4) call abort + if (.not.allocated (c) .or. size (c) /= 18) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 6) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 2 .or. ubound (c, 2) /= 7) call abort + if (a /= 1 .or. any (b /= 2) .or. any (c /= 3)) call abort + +!$omp single + l = .true. + deallocate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(2:6), c(3:5, 3:8)) + a = 7 + b = 8 + c = 9 +!$omp end single copyprivate (a, b, c) + + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 5) call abort + if (l) then + if (lbound (b, 1) /= 2 .or. ubound (b, 1) /= 6) call abort + else + if (lbound (b, 1) /= 0 .or. ubound (b, 1) /= 4) call abort + end if + if (.not.allocated (c) .or. size (c) /= 18) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 6) call abort + if (l) then + if (lbound (c, 1) /= 3 .or. ubound (c, 1) /= 5) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 8) call abort + else + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 2 .or. ubound (c, 2) /= 7) call abort + end if + if (a /= 7 .or. any (b /= 8) .or. any (c /= 9)) call abort + +!$omp end parallel +end diff --git a/libgomp/testsuite/libgomp.fortran/allocatable9.f90 b/libgomp/testsuite/libgomp.fortran/allocatable9.f90 new file mode 100644 index 00000000000..80bf5d389f3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable9.f90 @@ -0,0 +1,156 @@ +! { dg-do run } + + integer, allocatable :: a, b(:), c(:,:) + logical :: l + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp parallel private (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(-7:-1), c(2:3, 3:5)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 7) call abort + if (lbound (b, 1) /= -7 .or. ubound (b, 1) /= -1) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 3) call abort + if (lbound (c, 1) /= 2 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 5) call abort + a = 4 + b = 3 + c = 2 +!$omp end parallel + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort +!$omp parallel firstprivate (a, b, c) + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(-7:-1), c(2:3, 3:5)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 7) call abort + if (lbound (b, 1) /= -7 .or. ubound (b, 1) /= -1) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 3) call abort + if (lbound (c, 1) /= 2 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 3 .or. ubound (c, 2) /= 5) call abort + a = 4 + b = 3 + c = 2 +!$omp end parallel + if (allocated (a) .or. allocated (b) .or. allocated (c)) call abort + allocate (a, b(6:9), c(3, 8:9)) + a = 2 + b = 4 + c = 5 + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort +!$omp parallel firstprivate (a, b, c) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 2 .or. any (b .ne. 4) .or. any (c .ne. 5)) call abort + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 8 + b = (/ 1, 2, 3 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 2, 4 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort +!$omp end parallel + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + if (a /= 2 .or. any (b .ne. 4) .or. any (c .ne. 5)) call abort + l = .false. +!$omp parallel sections lastprivate (a, b, c) firstprivate (l) +!$omp section + if (.not.allocated (a)) call abort + if (l) then + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort + else + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + end if + l = .true. + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 8 + b = (/ 1, 2, 3 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 2, 4 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort +!$omp section + if (.not.allocated (a)) call abort + if (l) then + if (.not.allocated (b) .or. size (b) /= 3) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 3) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 2 .or. size (c, 2) /= 4) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 2) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 4) call abort + if (a /= 8 .or. b(2) /= 2 .or. c(1, 2) /= 3) call abort + else + if (.not.allocated (b) .or. size (b) /= 4) call abort + if (lbound (b, 1) /= 6 .or. ubound (b, 1) /= 9) call abort + if (.not.allocated (c) .or. size (c) /= 6) call abort + if (size (c, 1) /= 3 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 3) call abort + if (lbound (c, 2) /= 8 .or. ubound (c, 2) /= 9) call abort + end if + l = .true. + deallocate (a) + if (allocated (a)) call abort + allocate (a) + a = 12 + b = (/ 9, 8, 7, 6, 5, 4 /) + c = reshape ((/ 1, 2, 3, 4, 5, 6, 7, 8 /), (/ 4, 2 /)) + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort +!$omp end parallel sections + if (.not.allocated (a)) call abort + if (.not.allocated (b) .or. size (b) /= 6) call abort + if (lbound (b, 1) /= 1 .or. ubound (b, 1) /= 6) call abort + if (.not.allocated (c) .or. size (c) /= 8) call abort + if (size (c, 1) /= 4 .or. size (c, 2) /= 2) call abort + if (lbound (c, 1) /= 1 .or. ubound (c, 1) /= 4) call abort + if (lbound (c, 2) /= 1 .or. ubound (c, 2) /= 2) call abort + if (a /= 12 .or. b(2) /= 8 .or. c(1, 2) /= 5) call abort +end diff --git a/libgomp/testsuite/libgomp.fortran/associate1.f90 b/libgomp/testsuite/libgomp.fortran/associate1.f90 new file mode 100644 index 00000000000..e40995515d8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/associate1.f90 @@ -0,0 +1,23 @@ +! { dg-do run } + +program associate1 + integer :: v, i, j + real :: a(3, 3) + v = 15 + a = 4.5 + a(2,1) = 3.5 + i = 2 + j = 1 + associate(u => v, b => a(i, j)) +!$omp parallel private(v, a) default(none) + v = -1 + a = 2.5 + if (v /= -1 .or. u /= 15) call abort + if (a(2,1) /= 2.5 .or. b /= 3.5) call abort + associate(u => v, b => a(2, 1)) + if (u /= -1 .or. b /= 2.5) call abort + end associate + if (u /= 15 .or. b /= 3.5) call abort +!$omp end parallel + end associate +end program diff --git a/libgomp/testsuite/libgomp.fortran/associate2.f90 b/libgomp/testsuite/libgomp.fortran/associate2.f90 new file mode 100644 index 00000000000..dee8496e1d7 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/associate2.f90 @@ -0,0 +1,46 @@ +! { dg-do run } + +program associate2 + type dl + integer :: i + end type + type dt + integer :: i + real :: a(3, 3) + type(dl) :: c(3, 3) + end type + integer :: v(4), i, j, k, l + type (dt) :: a(3, 3) + v = 15 + forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 4.5 + a(2,1)%a(1,2) = 3.5 + i = 2 + j = 1 + associate(u => v, b => a(i, j)%a) +!$omp parallel private(v, a) default(none) + v = -1 + forall (k = 1:3, l = 1:3) a(k, l)%a(:,:) = 2.5 + if (v(3) /= -1 .or. u(3) /= 15) call abort + if (a(2,1)%a(1,2) /= 2.5 .or. b(1,2) /= 3.5) call abort + associate(u => v, b => a(2, 1)%a) + if (u(3) /= -1 .or. b(1,2) /= 2.5) call abort + end associate + if (u(3) /= 15 .or. b(1,2) /= 3.5) call abort +!$omp end parallel + end associate + forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 7 + a(1,2)%c(2,1)%i = 9 + i = 1 + j = 2 + associate(d => a(i, j)%c(2,:)%i) +!$omp parallel private(a) default(none) + forall (k = 1:3, l = 1:3) a(k, l)%c(:,:)%i = 15 + if (a(1,2)%c(2,1)%i /= 15 .or. d(1) /= 9) call abort + if (a(1,2)%c(2,2)%i /= 15 .or. d(2) /= 7) call abort + associate(d => a(2,1)%c(2,:)%i) + if (d(1) /= 15 .or. d(2) /= 15) call abort + end associate + if (d(1) /= 9 .or. d(2) /= 7) call abort +!$omp end parallel + end associate +end program diff --git a/libgomp/testsuite/libgomp.fortran/procptr1.f90 b/libgomp/testsuite/libgomp.fortran/procptr1.f90 new file mode 100644 index 00000000000..4187739826f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/procptr1.f90 @@ -0,0 +1,42 @@ +! { dg-do run } + interface + integer function foo () + end function + integer function bar () + end function + integer function baz () + end function + end interface + procedure(foo), pointer :: ptr + integer :: i + ptr => foo +!$omp parallel shared (ptr) + if (ptr () /= 1) call abort +!$omp end parallel + ptr => bar +!$omp parallel firstprivate (ptr) + if (ptr () /= 2) call abort +!$omp end parallel +!$omp parallel sections lastprivate (ptr) +!$omp section + ptr => foo + if (ptr () /= 1) call abort +!$omp section + ptr => bar + if (ptr () /= 2) call abort +!$omp section + ptr => baz + if (ptr () /= 3) call abort +!$omp end parallel sections + if (ptr () /= 3) call abort + if (.not.associated (ptr, baz)) call abort +end +integer function foo () + foo = 1 +end function +integer function bar () + bar = 2 +end function +integer function baz () + baz = 3 +end function -- cgit v1.2.3