From patchwork Wed Mar 10 10:55:43 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1450453 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4DwTX41ynnz9sRN for ; Wed, 10 Mar 2021 21:56:02 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E1A0E3870895; Wed, 10 Mar 2021 10:55:57 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 66E30384A40A; Wed, 10 Mar 2021 10:55:51 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 66E30384A40A Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: PdYBO6SK96X43Bo+II+JThkSp2fRf1Br89com0mEm1NR/JzNaDsGYnhD+RU4z7qnRPJ3DyQ3r1 obxuHL0AowUS/cUCOyJ0RHMYA7xA/6/hNxbNJSQdIp/krbeO+PwYjR4TpbeBsOfmVc7OKD8ren /hP0rDMtIRSJLahvDkUaK4Kx+cRvg0plt/ko87Rq+k9aw3eTuMB04wKVKl9Vc41PxabSyZRkYI BpykLHoeePGaAqT76b53qD94u9P+llGGKPfDAz8bea59F3bn8FZOvyWxlgrafH7/W6VqxbH7PU YIE= X-IronPort-AV: E=Sophos;i="5.81,237,1610438400"; d="diff'?scan'208";a="59070215" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 10 Mar 2021 02:55:49 -0800 IronPort-SDR: UR6Knq/RHQyVPpMzMzeovvFh9jpjvixuqrTV7lQ6aywV7ucmOhSGO/lV7ew0EEAa3WJ3G7wJDm G/D/wNG6Q6ckanj6KDSRXdG/cSkMDChf3NAY2Cmpv0+7vlG1hQRQFBEExWxyrIE6dHITT/O/fo XQ1NUr/l6N3I6NzGsbZq5N25sx66uZKFVV9qoVsLJ1c73h7XGbXUmyFCSMJZydcdEGJsGxSJqL LPujXdFQLXn4sHdpQ64BsZl0wO2FDO5K4pazy26f/HC+N1GPu5w0KcS5XWcwu6BpvJG4VD5tP2 LnU= To: gcc-patches , fortran , Jakub Jelinek From: Tobias Burnus Subject: [Patch] OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470] Message-ID: <9b270c75-b88c-7477-1303-5f4f5a6662ae@codesourcery.com> Date: Wed, 10 Mar 2021 11:55:43 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-06.mgc.mentorg.com (139.181.222.6) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-12.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Belated follow-up to the patch from August ... https://gcc.gnu.org/pipermail/gcc-patches/2020-August/552588.html This patch handles CLASS variables in the FIRSTPRIVATE data-sharing clause, including freeing the memory at the end. Technically this patch fixes a regression as the ICE is new – before the code was just rejected. It is also rather contained. OK for mainline? Tobias PS: The dtor can be extended rather simply to support arrays, for the copy_ctor, some scalarization loop is needed. Todo: 'private', which has to allocate the dynamic type and copy the default initialization for this the dynamic type. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf OpenMP/Fortran: Handle polymorphic scalars in data-sharing FIRSTPRIVATE [PR86470] gcc/fortran/ChangeLog: PR fortran/86470 * trans-expr.c (gfc_copy_class_to_class): Add unshare_expr. * trans-openmp.c (gfc_is_polymorphic_nonptr, gfc_is_unlimited_polymorphic_nonptr): New. (gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle polymorphic scalars. libgomp/ChangeLog: PR fortran/86470 * testsuite/libgomp.fortran/class-firstprivate-1.f90: New test. * testsuite/libgomp.fortran/class-firstprivate-2.f90: New test. * testsuite/libgomp.fortran/class-firstprivate-3.f90: New test. gcc/testsuite/ChangeLog: PR fortran/86470 * gfortran.dg/gomp/class-firstprivate-1.f90: New test. * gfortran.dg/gomp/class-firstprivate-2.f90: New test. * gfortran.dg/gomp/class-firstprivate-3.f90: New test. * gfortran.dg/gomp/class-firstprivate-4.f90: New test. gcc/fortran/trans-expr.c | 2 +- gcc/fortran/trans-openmp.c | 162 +++++++++- .../gfortran.dg/gomp/class-firstprivate-1.f90 | 62 ++++ .../gfortran.dg/gomp/class-firstprivate-2.f90 | 54 ++++ .../gfortran.dg/gomp/class-firstprivate-3.f90 | 61 ++++ .../gfortran.dg/gomp/class-firstprivate-4.f90 | 44 +++ .../libgomp.fortran/class-firstprivate-1.f90 | 323 ++++++++++++++++++++ .../libgomp.fortran/class-firstprivate-2.f90 | 334 +++++++++++++++++++++ .../libgomp.fortran/class-firstprivate-3.f90 | 334 +++++++++++++++++++++ 9 files changed, 1374 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 85c16d7f4c3..5389b9a4a37 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1524,7 +1524,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) { vec_safe_push (args, from_len); vec_safe_push (args, to_len); - extcopy = build_call_vec (fcn_type, fcn, args); + extcopy = build_call_vec (fcn_type, unshare_expr (fcn), args); tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, from_len, build_zero_cst (TREE_TYPE (from_len))); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 349df1cc346..7c25241a863 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -360,6 +360,39 @@ gfc_has_alloc_comps (tree type, tree decl) return false; } +/* Return true if TYPE is polymorphic but not with pointer attribute. */ + +static bool +gfc_is_polymorphic_nonptr (tree type) +{ + if (POINTER_TYPE_P (type)) + type = TREE_TYPE (type); + return GFC_CLASS_TYPE_P (type); +} + +/* Return true if TYPE is unlimited polymorphic but not with pointer attribute; + unlimited means also intrinsic types are handled and _len is used. */ + +static bool +gfc_is_unlimited_polymorphic_nonptr (tree type) +{ + if (POINTER_TYPE_P (type)) + type = TREE_TYPE (type); + if (!GFC_CLASS_TYPE_P (type)) + return false; + + tree field = TYPE_FIELDS (type); /* _data */ + gcc_assert (field); + field = DECL_CHAIN (field); /* _vptr */ + gcc_assert (field); + field = DECL_CHAIN (field); + if (!field) + return false; + gcc_assert (0 == strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field)))); + return true; +} + + /* Return true if DECL in private clause needs OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */ bool @@ -743,12 +776,88 @@ tree gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) { tree type = TREE_TYPE (dest), ptr, size, call; + tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause)); tree cond, then_b, else_b; stmtblock_t block, cond_block; gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR); + if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause)) + && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause)) + && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))) + decl_type + = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))); + + if (gfc_is_polymorphic_nonptr (decl_type)) + { + if (POINTER_TYPE_P (decl_type)) + decl_type = TREE_TYPE (decl_type); + decl_type = TREE_TYPE (TYPE_FIELDS (decl_type)); + if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type)) + fatal_error (input_location, + "Sorry, polymorphic arrays not yet supported for " + "firstprivate"); + tree src_len; + tree nelems = build_int_cst (size_type_node, 1); /* Scalar. */ + tree src_data = gfc_class_data_get (unshare_expr (src)); + tree dest_data = gfc_class_data_get (unshare_expr (dest)); + bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type); + + gfc_start_block (&block); + gfc_add_modify (&block, gfc_class_vptr_get (dest), + gfc_class_vptr_get (src)); + gfc_init_block (&cond_block); + + if (unlimited) + { + src_len = gfc_class_len_get (src); + gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len); + } + + /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1). */ + size = fold_convert (size_type_node, gfc_class_vtab_size_get (src)); + if (unlimited) + { + cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + unshare_expr (src_len), + build_zero_cst (TREE_TYPE (src_len))); + cond = build3_loc (input_location, COND_EXPR, size_type_node, cond, + fold_convert (size_type_node, + unshare_expr (src_len)), + build_int_cst (size_type_node, 1)); + size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, + size, cond); + } + + /* Malloc memory + call class->_vpt->_copy. */ + call = builtin_decl_explicit (BUILT_IN_MALLOC); + call = build_call_expr_loc (input_location, call, 1, size); + gfc_add_modify (&cond_block, dest_data, + fold_convert (TREE_TYPE (dest_data), call)); + gfc_add_expr_to_block (&cond_block, + gfc_copy_class_to_class (src, dest, nelems, + unlimited)); + + gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF); + if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1))) + { + gfc_add_block_to_block (&block, &cond_block); + } + else + { + /* Create: if (class._data != 0) else class._data = NULL; */ + cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + src_data, null_pointer_node); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + gfc_finish_block (&cond_block), + fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, + unshare_expr (dest_data), null_pointer_node))); + } + return gfc_finish_block (&block); + } + if ((! GFC_DESCRIPTOR_TYPE_P (type) || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause)) @@ -773,7 +882,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) gfc_init_block (&cond_block); - gfc_add_modify (&cond_block, dest, src); + gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src)); if (GFC_DESCRIPTOR_TYPE_P (type)) { tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1]; @@ -1185,6 +1294,57 @@ tree gfc_omp_clause_dtor (tree clause, tree decl) { tree type = TREE_TYPE (decl), tem; + tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause)); + + if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause)) + && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause)) + && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))) + decl_type + = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause))); + if (gfc_is_polymorphic_nonptr (decl_type)) + { + if (POINTER_TYPE_P (decl_type)) + decl_type = TREE_TYPE (decl_type); + decl_type = TREE_TYPE (TYPE_FIELDS (decl_type)); + if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type)) + fatal_error (input_location, + "Sorry, polymorphic arrays not yet supported for " + "firstprivate"); + stmtblock_t block, cond_block; + gfc_start_block (&block); + gfc_init_block (&cond_block); + tree final = gfc_class_vtab_final_get (decl); + tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl)); + gfc_se se; + gfc_init_se (&se, NULL); + symbol_attribute attr = {}; + tree data = gfc_class_data_get (decl); + tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr); + + /* Call class->_vpt->_finalize + free. */ + tree call = build_fold_indirect_ref (final); + call = build_call_expr_loc (input_location, call, 3, + gfc_build_addr_expr (NULL, desc), + size, boolean_false_node); + gfc_add_block_to_block (&cond_block, &se.pre); + gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call)); + gfc_add_block_to_block (&cond_block, &se.post); + /* Create: if (_vtab && _final) */ + tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + gfc_class_vptr_get (decl), + null_pointer_node); + tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + final, null_pointer_node); + cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, + boolean_type_node, cond, cond2); + gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, + void_type_node, cond, + gfc_finish_block (&cond_block), NULL_TREE)); + call = builtin_decl_explicit (BUILT_IN_FREE); + call = build_call_expr_loc (input_location, call, 1, data); + gfc_add_expr_to_block (&block, fold_convert (void_type_node, call)); + return gfc_finish_block (&block); + } if ((! GFC_DESCRIPTOR_TYPE_P (type) || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE) diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90 new file mode 100644 index 00000000000..0ff851db390 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-1.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-prune-output "compilation terminated." } +! +! FIRSTPRIVATE + class array +! +! For now: Expected to give "Sorry" for polymorphic arrays. +! +! Polymorphic arrays are tricky - at least if not allocatable, they become: +! var.0 = var._data.data +! which needs to be handled properly. +! +! +program select_type_openmp + use iso_c_binding + !use omp_lib + implicit none + integer :: i + integer :: A(4) + type(c_ptr) :: B(4) + + B = [(c_null_ptr, i=1,4)] + A = [1,2,3,4] + call sub(A, B) +contains + subroutine sub(val1, val2) + class(*) :: val1(4) + type(c_ptr) :: val2(2:5) + + !$OMP PARALLEL firstprivate(val2) + do i = 2, 5 + if (c_associated (val2(i))) stop 123 + end do + !$OMP END PARALLEL + + !$OMP PARALLEL firstprivate(val1) ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" } + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [1, 2, 3, 4])) stop 4549 + val1 = [32,6,48,28] + class default + stop 99 + end select + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [32,6,48,28])) stop 4512 + class default + stop 99 + end select + !$OMP END PARALLEL + + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [1, 2, 3, 4])) stop 454 + class default + stop 99 + end select + print *, "PASS!" + end subroutine +end program select_type_openmp diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90 new file mode 100644 index 00000000000..354223741f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-2.f90 @@ -0,0 +1,54 @@ +! { dg-do compile } +! { dg-prune-output "compilation terminated." } +! +! FIRSTPRIVATE + class array +! +! For now: Expected to give "Sorry" for polymorphic arrays. +! +! Polymorphic arrays are tricky - at least if not allocatable, they become: +! var.0 = var._data.data +! which needs to be handled properly. +! +! +program select_type_openmp + !use omp_lib + implicit none + class(*), allocatable :: B(:) + + allocate(B, source=["abcdef","cdefi2"]) + allocate(B, source=[1,2,3]) + call sub(B) +contains + subroutine sub(val2) + class(*), allocatable :: val2(:) + + !$OMP PARALLEL firstprivate(val2) ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" } + if (.not.allocated(val2)) stop 3 + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 44 + if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 4545 + val2 = ["123456", "789ABC"] + class default + stop 991 + end select + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 44 + if (val2(1) /= "123456" .or. val2(2) /= "789ABC") stop 453 + class default + stop 991 + end select + !$OMP END PARALLEL + + if (.not.allocated(val2)) stop 3 + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 44 + if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 456 + class default + stop 991 + end select + print *, "PASS!" + end subroutine +end program select_type_openmp diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90 new file mode 100644 index 00000000000..c83bf297511 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-3.f90 @@ -0,0 +1,61 @@ +! { dg-do compile } +! { dg-prune-output "compilation terminated." } +! +! FIRSTPRIVATE + class array +! +! For now: Expected to give "Sorry" for polymorphic arrays. +! +! Polymorphic arrays are tricky - at least if not allocatable, they become: +! var.0 = var._data.data +! which needs to be handled properly. +! +! +program select_type_openmp + use iso_c_binding + !use omp_lib + implicit none + call sub +contains + subroutine sub + integer :: i + class(*), allocatable :: val1(:) + type(c_ptr), allocatable :: val2(:) + + allocate(val1, source=[1, 2, 3, 4]) + allocate(val2(2:5)) + val2 = c_null_ptr + + !$OMP PARALLEL firstprivate(val2) + do i = 2, 5 + if (c_associated (val2(i))) stop 123 + end do + !$OMP END PARALLEL + + !$OMP PARALLEL firstprivate(val1) ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" } + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [1, 2, 3, 4])) stop 4549 + val1 = [32,6,48,28] + class default + stop 99 + end select + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [32,6,48,28])) stop 4512 + class default + stop 99 + end select + !$OMP END PARALLEL + + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [1, 2, 3, 4])) stop 454 + class default + stop 99 + end select + print *, "PASS!" + end subroutine +end program select_type_openmp diff --git a/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90 new file mode 100644 index 00000000000..237c6c535f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! { dg-prune-output "compilation terminated." } +! +! FIRSTPRIVATE + class array +! +! For now: Expected to give "Sorry" for polymorphic arrays. +! +! Polymorphic arrays are tricky - at least if not allocatable, they become: +! var.0 = var._data.data +! which needs to be handled properly. +! +! +program select_type_openmp + use iso_c_binding + !use omp_lib + implicit none + integer x(4) + x = [1, 2, 3, 4] + call sub(x) + if (any (x /= [1,2,3,4])) stop 3 +contains + subroutine sub(val1) + integer :: i + class(*) :: val1(4) + + !$OMP PARALLEL firstprivate(val1) ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" } + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 33 + if (any (val1 /= [1, 2, 3, 4])) stop 4549 + val1 = [32,6,48,28] + class default + stop 99 + end select + select type (val1) + type is (integer) + if (size(val1) /= 4) stop 34 + if (any (val1 /= [32,6,48,28])) stop 4512 + class default + stop 98 + end select + !$OMP END PARALLEL + end +end diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90 new file mode 100644 index 00000000000..b77117ec611 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-1.f90 @@ -0,0 +1,323 @@ +! FIRSTPRIVATE: CLASS(*) + intrinsic types +program select_type_openmp + implicit none + class(*), allocatable :: val1, val1a, val2, val3 + + call sub() ! local var + + call sub2(val1, val1a, val2, val3) ! allocatable args + + allocate(val1, source=7) + allocate(val1a, source=7) + allocate(val2, source="abcdef") + allocate(val3, source=4_"zyx4") + call sub3(val1, val1a, val2, val3) ! nonallocatable vars + deallocate(val1, val1a, val2, val3) +contains +subroutine sub() + class(*), allocatable :: val1, val1a, val2, val3 + allocate(val1a, source=7) + allocate(val2, source="abcdef") + allocate(val3, source=4_"zyx4") + + if (allocated(val1)) stop 1 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 2 + if (.not.allocated(val1a)) stop 3 + if (.not.allocated(val2)) stop 4 + if (.not.allocated(val3)) stop 5 + + allocate(val1, source=7) + + select type (val1) + type is (integer) + if (val1 /= 7) stop 6 + val1 = 8 + class default + stop 7 + end select + + select type (val1a) + type is (integer) + if (val1a /= 7) stop 8 + val1a = 8 + class default + stop 9 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 10 + if (val2 /= "abcdef") stop 11 + val2 = "123456" + class default + stop 12 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 13 + if (val3 /= 4_"zyx4") stop 14 + val3 = 4_"AbCd" + class default + stop 15 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 16 + if (val3 /= 4_"AbCd") stop 17 + val3 = 4_"1ab2" + class default + stop 18 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 19 + if (val2 /= "123456") stop 20 + val2 = "A2C4E6" + class default + stop 21 + end select + + select type (val1) + type is (integer) + if (val1 /= 8) stop 22 + val1 = 9 + class default + stop 23 + end select + + select type (val1a) + type is (integer) + if (val1a /= 8) stop 24 + val1a = 9 + class default + stop 25 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 26 + if (.not. allocated(val1a)) stop 27 + if (.not. allocated(val2)) stop 28 + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 29 + if (val2 /= "abcdef") stop 30 + class default + stop 31 + end select + select type (val3) + type is (character(len=*,kind=4)) + if (len(val3) /= 4) stop 32 + if (val3 /= 4_"zyx4") stop 33 + class default + stop 34 + end select + deallocate(val1a, val2, val3) +end subroutine sub + +subroutine sub2(val1, val1a, val2, val3) + class(*), allocatable :: val1, val1a, val2, val3 + optional :: val1a + allocate(val1a, source=7) + allocate(val2, source="abcdef") + allocate(val3, source=4_"zyx4") + + if (allocated(val1)) stop 35 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 36 + if (.not.allocated(val1a)) stop 37 + if (.not.allocated(val2)) stop 38 + if (.not.allocated(val3)) stop 39 + + allocate(val1, source=7) + + select type (val1) + type is (integer) + if (val1 /= 7) stop 40 + val1 = 8 + class default + stop 41 + end select + + select type (val1a) + type is (integer) + if (val1a /= 7) stop 42 + val1a = 8 + class default + stop 43 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 44 + if (val2 /= "abcdef") stop 45 + val2 = "123456" + class default + stop 46 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 47 + if (val3 /= 4_"zyx4") stop 48 + val3 = "AbCd" + class default + stop 49 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 50 + if (val3 /= 4_"AbCd") stop 51 + val3 = 4_"1ab2" + class default + stop 52 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 53 + if (val2 /= "123456") stop 54 + val2 = "A2C4E6" + class default + stop 55 + end select + + select type (val1) + type is (integer) + if (val1 /= 8) stop 56 + val1 = 9 + class default + stop 57 + end select + + select type (val1a) + type is (integer) + if (val1a /= 8) stop 58 + val1a = 9 + class default + stop 59 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 60 + if (.not. allocated(val1a)) stop 61 + if (.not. allocated(val2)) stop 62 + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 63 + if (val2 /= "abcdef") stop 64 + class default + stop 65 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 66 + if (val3 /= 4_"zyx4") stop 67 + val3 = 4_"AbCd" + class default + stop 68 + end select + deallocate(val1a, val2, val3) +end subroutine sub2 + +subroutine sub3(val1, val1a, val2, val3) + class(*) :: val1, val1a, val2, val3 + optional :: val1a + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + select type (val1) + type is (integer) + if (val1 /= 7) stop 69 + val1 = 8 + class default + stop 70 + end select + + select type (val1a) + type is (integer) + if (val1a /= 7) stop 71 + val1a = 8 + class default + stop 72 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 73 + if (val2 /= "abcdef") stop 74 + val2 = "123456" + class default + stop 75 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 76 + if (val3 /= 4_"zyx4") stop 77 + val3 = 4_"AbCd" + class default + stop 78 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 79 + if (val3 /= 4_"AbCd") stop 80 + val3 = 4_"1ab2" + class default + stop 81 + end select + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 82 + if (val2 /= "123456") stop 83 + val2 = "A2C4E6" + class default + stop 84 + end select + + select type (val1) + type is (integer) + if (val1 /= 8) stop 85 + val1 = 9 + class default + stop 86 + end select + + select type (val1a) + type is (integer) + if (val1a /= 8) stop 87 + val1a = 9 + class default + stop 88 + end select + !$OMP END PARALLEL + + select type (val2) + type is (character(len=*)) + if (len(val2) /= 6) stop 89 + if (val2 /= "abcdef") stop 90 + class default + stop 91 + end select + + select type (val3) + type is (character(len=*, kind=4)) + if (len(val3) /= 4) stop 92 + if (val3 /= 4_"zyx4") stop 93 + val3 = 4_"AbCd" + class default + stop 94 + end select +end subroutine sub3 +end program select_type_openmp diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90 new file mode 100644 index 00000000000..7528d32e8db --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-2.f90 @@ -0,0 +1,334 @@ +! FIRSTPRIVATE: CLASS(t) + derived types +program select_type_openmp + implicit none + type t + end type t + type, extends(t) :: t_int + integer :: i + end type + type, extends(t) :: t_char1 + character(len=:, kind=1), allocatable :: str + end type + type, extends(t) :: t_char4 + character(len=:, kind=4), allocatable :: str + end type + class(t), allocatable :: val1, val1a, val2, val3 + + call sub() ! local var + + call sub2(val1, val1a, val2, val3) ! allocatable args + + allocate(val1, source=t_int(7)) + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + call sub3(val1, val1a, val2, val3) ! nonallocatable vars + deallocate(val1, val1a, val2, val3) +contains +subroutine sub() + class(t), allocatable :: val1, val1a, val2, val3 + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + + if (allocated(val1)) stop 1 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 2 + if (.not.allocated(val1a)) stop 3 + if (.not.allocated(val2)) stop 4 + if (.not.allocated(val3)) stop 5 + + allocate(val1, source=t_int(7)) + + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 6 + val1%i = 8 + class default + stop 7 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 8 + val1a%i = 8 + class default + stop 9 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 10 + if (val2%str /= "abcdef") stop 11 + val2%str = "123456" + class default + stop 12 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 13 + if (val3%str /= 4_"zyx4") stop 14 + val3%str = 4_"AbCd" + class default + stop 15 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 16 + if (val3%str /= 4_"AbCd") stop 17 + val3%str = 4_"1ab2" + class default + stop 18 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 19 + if (val2%str /= "123456") stop 20 + val2%str = "A2C4E6" + class default + stop 21 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 22 + val1%i = 9 + class default + stop 23 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 24 + val1a%i = 9 + class default + stop 25 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 26 + if (.not. allocated(val1a)) stop 27 + if (.not. allocated(val2)) stop 28 + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 29 + if (val2%str /= "abcdef") stop 30 + class default + stop 31 + end select + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 32 + if (val3%str /= 4_"zyx4") stop 33 + class default + stop 34 + end select + deallocate(val1a,val2, val3) +end subroutine sub + +subroutine sub2(val1, val1a, val2, val3) + class(t), allocatable :: val1, val1a, val2, val3 + optional :: val1a + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + + if (allocated(val1)) stop 35 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 36 + if (.not.allocated(val1a)) stop 37 + if (.not.allocated(val2)) stop 38 + if (.not.allocated(val3)) stop 39 + + allocate(val1, source=t_int(7)) + + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 40 + val1%i = 8 + class default + stop 41 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 42 + val1a%i = 8 + class default + stop 43 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 44 + if (val2%str /= "abcdef") stop 45 + val2%str = "123456" + class default + stop 46 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 47 + if (val3%str /= 4_"zyx4") stop 48 + val3%str = "AbCd" + class default + stop 49 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 50 + if (val3%str /= 4_"AbCd") stop 51 + val3%str = 4_"1ab2" + class default + stop 52 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 53 + if (val2%str /= "123456") stop 54 + val2%str = "A2C4E6" + class default + stop 55 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 56 + val1%i = 9 + class default + stop 57 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 58 + val1a%i = 9 + class default + stop 59 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 60 + if (.not. allocated(val1a)) stop 61 + if (.not. allocated(val2)) stop 62 + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 63 + if (val2%str /= "abcdef") stop 64 + class default + stop 65 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 66 + if (val3%str /= 4_"zyx4") stop 67 + val3%str = 4_"AbCd" + class default + stop 68 + end select + deallocate(val1a, val2, val3) +end subroutine sub2 + +subroutine sub3(val1, val1a, val2, val3) + class(t) :: val1, val1a, val2, val3 + optional :: val1a + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 69 + val1%i = 8 + class default + stop 70 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 71 + val1a%i = 8 + class default + stop 72 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 73 + if (val2%str /= "abcdef") stop 74 + val2%str = "123456" + class default + stop 75 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 76 + if (val3%str /= 4_"zyx4") stop 77 + val3%str = 4_"AbCd" + class default + stop 78 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 79 + if (val3%str /= 4_"AbCd") stop 80 + val3%str = 4_"1ab2" + class default + stop 81 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 82 + if (val2%str /= "123456") stop 83 + val2%str = "A2C4E6" + class default + stop 84 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 85 + val1%i = 9 + class default + stop 86 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 87 + val1a%i = 9 + class default + stop 88 + end select + !$OMP END PARALLEL + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 89 + if (val2%str /= "abcdef") stop 90 + class default + stop 91 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 92 + if (val3%str /= 4_"zyx4") stop 93 + val3%str = 4_"AbCd" + class default + stop 94 + end select +end subroutine sub3 +end program select_type_openmp diff --git a/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90 b/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90 new file mode 100644 index 00000000000..a450fdee1ac --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/class-firstprivate-3.f90 @@ -0,0 +1,334 @@ +! FIRSTPRIVATE: CLASS(*) + derived types +program select_type_openmp + implicit none + type t + end type t + type, extends(t) :: t_int + integer :: i + end type + type, extends(t) :: t_char1 + character(len=:, kind=1), allocatable :: str + end type + type, extends(t) :: t_char4 + character(len=:, kind=4), allocatable :: str + end type + class(*), allocatable :: val1, val1a, val2, val3 + + call sub() ! local var + + call sub2(val1, val1a, val2, val3) ! allocatable args + + allocate(val1, source=t_int(7)) + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + call sub3(val1, val1a, val2, val3) ! nonallocatable vars + deallocate(val1, val1a, val2, val3) +contains +subroutine sub() + class(*), allocatable :: val1, val1a, val2, val3 + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + + if (allocated(val1)) stop 1 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 2 + if (.not.allocated(val1a)) stop 3 + if (.not.allocated(val2)) stop 4 + if (.not.allocated(val3)) stop 5 + + allocate(val1, source=t_int(7)) + + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 6 + val1%i = 8 + class default + stop 7 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 8 + val1a%i = 8 + class default + stop 9 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 10 + if (val2%str /= "abcdef") stop 11 + val2%str = "123456" + class default + stop 12 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 13 + if (val3%str /= 4_"zyx4") stop 14 + val3%str = 4_"AbCd" + class default + stop 15 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 16 + if (val3%str /= 4_"AbCd") stop 17 + val3%str = 4_"1ab2" + class default + stop 18 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 19 + if (val2%str /= "123456") stop 20 + val2%str = "A2C4E6" + class default + stop 21 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 22 + val1%i = 9 + class default + stop 23 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 24 + val1a%i = 9 + class default + stop 25 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 26 + if (.not. allocated(val1a)) stop 27 + if (.not. allocated(val2)) stop 28 + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 29 + if (val2%str /= "abcdef") stop 30 + class default + stop 31 + end select + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 32 + if (val3%str /= 4_"zyx4") stop 33 + class default + stop 34 + end select + deallocate(val1a,val2, val3) +end subroutine sub + +subroutine sub2(val1, val1a, val2, val3) + class(*), allocatable :: val1, val1a, val2, val3 + optional :: val1a + allocate(val1a, source=t_int(7)) + allocate(val2, source=t_char1("abcdef")) + allocate(val3, source=t_char4(4_"zyx4")) + + if (allocated(val1)) stop 35 + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + if (allocated(val1)) stop 36 + if (.not.allocated(val1a)) stop 37 + if (.not.allocated(val2)) stop 38 + if (.not.allocated(val3)) stop 39 + + allocate(val1, source=t_int(7)) + + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 40 + val1%i = 8 + class default + stop 41 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 42 + val1a%i = 8 + class default + stop 43 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 44 + if (val2%str /= "abcdef") stop 45 + val2%str = "123456" + class default + stop 46 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 47 + if (val3%str /= 4_"zyx4") stop 48 + val3%str = "AbCd" + class default + stop 49 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 50 + if (val3%str /= 4_"AbCd") stop 51 + val3%str = 4_"1ab2" + class default + stop 52 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 53 + if (val2%str /= "123456") stop 54 + val2%str = "A2C4E6" + class default + stop 55 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 56 + val1%i = 9 + class default + stop 57 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 58 + val1a%i = 9 + class default + stop 59 + end select + !$OMP END PARALLEL + + if (allocated(val1)) stop 60 + if (.not. allocated(val1a)) stop 61 + if (.not. allocated(val2)) stop 62 + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 63 + if (val2%str /= "abcdef") stop 64 + class default + stop 65 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 66 + if (val3%str /= 4_"zyx4") stop 67 + val3%str = 4_"AbCd" + class default + stop 68 + end select + deallocate(val1a, val2, val3) +end subroutine sub2 + +subroutine sub3(val1, val1a, val2, val3) + class(*) :: val1, val1a, val2, val3 + optional :: val1a + + !$OMP PARALLEL firstprivate(val1, val1a, val2, val3) + select type (val1) + type is (t_int) + if (val1%i /= 7) stop 69 + val1%i = 8 + class default + stop 70 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 7) stop 71 + val1a%i = 8 + class default + stop 72 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 73 + if (val2%str /= "abcdef") stop 74 + val2%str = "123456" + class default + stop 75 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 76 + if (val3%str /= 4_"zyx4") stop 77 + val3%str = 4_"AbCd" + class default + stop 78 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 79 + if (val3%str /= 4_"AbCd") stop 80 + val3%str = 4_"1ab2" + class default + stop 81 + end select + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 82 + if (val2%str /= "123456") stop 83 + val2%str = "A2C4E6" + class default + stop 84 + end select + + select type (val1) + type is (t_int) + if (val1%i /= 8) stop 85 + val1%i = 9 + class default + stop 86 + end select + + select type (val1a) + type is (t_int) + if (val1a%i /= 8) stop 87 + val1a%i = 9 + class default + stop 88 + end select + !$OMP END PARALLEL + + select type (val2) + type is (t_char1) + if (len(val2%str) /= 6) stop 89 + if (val2%str /= "abcdef") stop 90 + class default + stop 91 + end select + + select type (val3) + type is (t_char4) + if (len(val3%str) /= 4) stop 92 + if (val3%str /= 4_"zyx4") stop 93 + val3%str = 4_"AbCd" + class default + stop 94 + end select +end subroutine sub3 +end program select_type_openmp