From patchwork Thu Sep 30 11:14:49 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1534777 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=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (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 bilbo.ozlabs.org (Postfix) with ESMTPS id 4HKrJW4zQCz9sR4 for ; Thu, 30 Sep 2021 21:15:38 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3F2173857C6D for ; Thu, 30 Sep 2021 11:15:35 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id D2E9C3858C2C; Thu, 30 Sep 2021 11:14:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org D2E9C3858C2C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: OQDWzpD6ldR05X3GyctlB/VDjI4lOUtauPbIQCmSDzjOdcEkxEFc8LSoQOy5WzJDiA2jf4nMrU 34unTOb46MO2ojGbNEUn2TaRXugYXcvBF5HhbUBXcbBDAM2lThCvZLmzYh3Gq5BUeWe0Bggi9i qeZCa3YaZdIehfM8ADmi0wB8kQKwpi2yOJDJ5VC0naF3uxvFFS9ZHzLNmmyetox3EZSW/tekI1 s7Arg7UYEwjQc4usM+MdlO5s0yfZFkoVinhpYh+1rglQ8/lFKvUQw7/MKinjzKeRN9uq+IBtSz VWXBk3PEWp8/DlO0BIDXVTkN X-IronPort-AV: E=Sophos;i="5.85,336,1624348800"; d="diff'?scan'208";a="66557631" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 30 Sep 2021 03:14:56 -0800 IronPort-SDR: lWcCCGjHNuyEisdFbRi9Jo3Qyxc2S99vC42l5sTKNf1XGjyFZk5SxDh3cJjkyXGezqRaIzMk4z FORiWTWn32Xwf8mMGW9lfWMIxroMCc+XBYWfVvr0CHKb3qon7NxsqGkIUB2pl0C9C8b+mifFHD 3LDfxfR2ezgiOihWCmZT7Q+HIlzjD4wevHybG8MG22hiTbmwGB5UepOVS6/AK4erA1YVShe8V5 IF7d5mUe2A5Dhgh4ttcn3+GoCd1F0TBGStfTnaR5fqGBJuS/kWW1qWhGlB8zwVTVxQbQaWViTt K5Y= Subject: [Patch] openmp: Add omp_aligned_{,c}alloc and omp_{c,re}alloc for Fortran (was: [committed] openmp: Add omp_aligned_{,c}alloc and omp_{c,re}alloc) To: Jakub Jelinek , , fortran References: <20210930074518.GY304296@tucnak> From: Tobias Burnus Message-ID: <51ef9b1a-85d9-c00b-14d2-8a82a2129b2b@codesourcery.com> Date: Thu, 30 Sep 2021 13:14:49 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.14.0 MIME-Version: 1.0 In-Reply-To: <20210930074518.GY304296@tucnak> Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-07.mgc.mentorg.com (139.181.222.7) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: , Cc: Tobias Burnus Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" On 30.09.21 09:45, Jakub Jelinek wrote: > This patch adds new OpenMP 5.1 allocator entrypoints ... ... and this patch adds the Fortran support for it, using the C→Fortran converted testcases. Additionally, it fixes and updated the list of API routine names. We now can also tick off one item in the OpenMP 5.1 implementation status list. OK for mainline? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 openmp: Add omp_aligned_{,c}alloc and omp_{c,re}alloc for Fortran gcc/ChangeLog: * omp-low.c (omp_runtime_api_call): Add omp_aligned_{,c}alloc and omp_{c,re}alloc, fix omp_alloc/omp_free. libgomp/ChangeLog: * libgomp.texi (OpenMP 5.1): Set implementation status to Y for omp_aligned_{,c}alloc and omp_{c,re}alloc routines. * omp_lib.f90.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc, omp_realloc): Add. * omp_lib.h.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc, omp_realloc): Add. * testsuite/libgomp.fortran/alloc-10.f90: New test. * testsuite/libgomp.fortran/alloc-6.f90: New test. * testsuite/libgomp.fortran/alloc-7.c: New test. * testsuite/libgomp.fortran/alloc-7.f90: New test. * testsuite/libgomp.fortran/alloc-8.f90: New test. * testsuite/libgomp.fortran/alloc-9.f90: New test. gcc/omp-low.c | 8 +- libgomp/libgomp.texi | 2 +- libgomp/omp_lib.f90.in | 43 +++++- libgomp/omp_lib.h.in | 46 +++++- libgomp/testsuite/libgomp.fortran/alloc-10.f90 | 198 +++++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/alloc-6.f90 | 45 ++++++ libgomp/testsuite/libgomp.fortran/alloc-7.c | 5 + libgomp/testsuite/libgomp.fortran/alloc-7.f90 | 174 ++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/alloc-8.f90 | 58 ++++++++ libgomp/testsuite/libgomp.fortran/alloc-9.f90 | 196 ++++++++++++++++++++++++ 10 files changed, 770 insertions(+), 5 deletions(-) diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 26c5c0261e9..f7242dfbbca 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -3921,8 +3921,12 @@ omp_runtime_api_call (const_tree fndecl) { /* This array has 3 sections. First omp_* calls that don't have any suffixes. */ - "omp_alloc", - "omp_free", + "aligned_alloc", + "aligned_calloc", + "alloc", + "calloc", + "free", + "realloc", "target_alloc", "target_associate_ptr", "target_disassociate_ptr", diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index b3bab8feddf..02160f81562 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -315,7 +315,7 @@ The OpenMP 4.5 specification is fully supported. runtime routines @tab N @tab @item @code{omp_get_mapped_ptr} runtime routine @tab N @tab @item @code{omp_calloc}, @code{omp_realloc}, @code{omp_aligned_alloc} and - @code{omp_aligned_calloc} runtime routines @tab N @tab + @code{omp_aligned_calloc} runtime routines @tab Y @tab @item @code{omp_alloctrait_key_t} enum: @code{omp_atv_serialized} added, @code{omp_atv_default} changed @tab Y @tab @item @code{omp_display_env} runtime routine @tab P diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in index a36a5626123..1063eee0c94 100644 --- a/libgomp/omp_lib.f90.in +++ b/libgomp/omp_lib.f90.in @@ -680,13 +680,54 @@ end function omp_alloc end interface + interface + function omp_aligned_alloc (alignment, size, allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + import :: omp_allocator_handle_kind + type(c_ptr) :: omp_aligned_alloc + integer(c_size_t), value :: alignment, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_aligned_alloc + end interface + interface subroutine omp_free(ptr, allocator) bind(c) use, intrinsic :: iso_c_binding, only : c_ptr import :: omp_allocator_handle_kind type(c_ptr), value :: ptr integer(omp_allocator_handle_kind), value :: allocator - end subroutine + end subroutine omp_free + end interface + + interface + function omp_calloc (nmemb, size, allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + import :: omp_allocator_handle_kind + type(c_ptr) :: omp_calloc + integer(c_size_t), value :: nmemb, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_calloc + end interface + + interface + function omp_aligned_calloc (alignment, nmemb, size, allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + import :: omp_allocator_handle_kind + type(c_ptr) :: omp_aligned_calloc + integer(c_size_t), value :: alignment, nmemb, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_aligned_calloc + end interface + + interface + function omp_realloc (ptr, size, allocator, free_allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + import :: omp_allocator_handle_kind + type(c_ptr) :: omp_realloc + type(c_ptr), value :: ptr + integer(c_size_t), value :: size + integer(omp_allocator_handle_kind), value :: allocator, free_allocator + end function omp_realloc end interface interface diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in index 1c2eacba554..f40321c479b 100644 --- a/libgomp/omp_lib.h.in +++ b/libgomp/omp_lib.h.in @@ -282,13 +282,57 @@ end function omp_alloc end interface + interface + function omp_aligned_alloc (alignment, size, allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + use, intrinsic :: omp_lib_kinds + type(c_ptr) :: omp_aligned_alloc + integer(c_size_t), value :: alignment, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_aligned_alloc + end interface + interface subroutine omp_free(ptr, allocator) bind(c) use, intrinsic :: iso_c_binding, only : c_ptr use, intrinsic :: omp_lib_kinds type(c_ptr), value :: ptr integer(omp_allocator_handle_kind), value :: allocator - end subroutine + end subroutine omp_free + end interface + + interface + function omp_calloc (nmemb, size, allocator) bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + use, intrinsic :: omp_lib_kinds + type(c_ptr) :: omp_calloc + integer(c_size_t), value :: nmemb, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_calloc + end interface + + interface + function omp_aligned_calloc (alignment, nmemb, size, allocator) & + & bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + use, intrinsic :: omp_lib_kinds + type(c_ptr) :: omp_aligned_calloc + integer(c_size_t), value :: alignment, nmemb, size + integer(omp_allocator_handle_kind), value :: allocator + end function omp_aligned_calloc + end interface + + interface + function omp_realloc (ptr, size, allocator, free_allocator) & + & bind(c) + use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t + use, intrinsic :: omp_lib_kinds + type(c_ptr) :: omp_realloc + type(c_ptr), value :: ptr + integer(c_size_t), value :: size + integer(omp_allocator_handle_kind), value :: allocator + integer(omp_allocator_handle_kind), value :: free_allocator + end function omp_realloc end interface interface diff --git a/libgomp/testsuite/libgomp.fortran/alloc-10.f90 b/libgomp/testsuite/libgomp.fortran/alloc-10.f90 new file mode 100644 index 00000000000..d26a83b216a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-10.f90 @@ -0,0 +1,198 @@ +! { dg-additional-sources alloc-7.c } +module m + use omp_lib + use iso_c_binding + implicit none + + type (omp_alloctrait), parameter :: traits2(*) & + = [ omp_alloctrait (omp_atk_alignment, 16), & + omp_alloctrait (omp_atk_sync_hint, omp_atv_default), & + omp_alloctrait (omp_atk_access, omp_atv_default), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), & + omp_alloctrait (omp_atk_partition, omp_atv_environment)] + type (omp_alloctrait) :: traits3(7) & + = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), & + omp_alloctrait (omp_atk_alignment, 32), & + omp_alloctrait (omp_atk_access, omp_atv_all), & + omp_alloctrait (omp_atk_pool_size, 512), & + omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), & + omp_alloctrait (omp_atk_fb_data, 0), & + omp_alloctrait (omp_atk_partition, omp_atv_default)] + type (omp_alloctrait), parameter :: traits4(*) & + = [ omp_alloctrait (omp_atk_alignment, 128), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] + + interface + integer(c_int) function get__alignof_int () bind(C) + import :: c_int + end + end interface +end module m + +program main + use m + implicit none (external, type) + type(c_ptr) :: p, q, r + integer, pointer, contiguous :: ip(:), iq(:), ir(:) + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a, a2 + integer (c_ptrdiff_t) :: iptr + integer :: i + + traits = [ omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 4096)] + + p = omp_aligned_calloc (c_sizeof (0), 3_c_size_t, c_sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [3]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & + .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) & + stop 1 + ip(1) = 1 + ip(2) = 2 + ip(3) = 3 + call omp_free (p, omp_default_mem_alloc) + p = omp_aligned_calloc (2 * c_sizeof (0), 1_c_size_t, 2 * c_sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [2]) + if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0 & + .or. ip(1) /= 0 .or. ip(2) /= 0) & + stop 2 + ip(1) = 1 + ip(2) = 2 + call omp_free (p, omp_null_allocator) + call omp_set_default_allocator (omp_default_mem_alloc) + p = omp_aligned_calloc (1_c_size_t, 1_c_size_t, c_sizeof (0), omp_null_allocator) + call c_f_pointer (p, ip, [1]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & + .or. ip(1) /= 0) & + stop 3 + ip(1) = 3 + call omp_free (p, omp_get_default_allocator ()) + + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) & + stop 4 + p = omp_aligned_calloc (32_c_size_t, 3_c_size_t, 1024_c_size_t, a) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 64) /= 0) & + stop 5 + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 6 + end do + ip(1) = 1 + ip(3072 / c_sizeof (0)) = 2 + if (c_associated (omp_aligned_calloc (8_c_size_t, 192_c_size_t, 16_c_size_t, a))) & + stop 7 + call omp_free (p, a) + p = omp_aligned_calloc (128_c_size_t, 6_c_size_t, 512_c_size_t, a) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 128) /= 0) & + stop 8 + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 9 + end do + ip(1) = 3 + ip(3072 / c_sizeof (0)) = 4 + call omp_free (p, omp_null_allocator) + call omp_set_default_allocator (a) + if (omp_get_default_allocator () /= a) & + stop 10 + p = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 256_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 11 + end do + if (c_associated (omp_aligned_calloc (8_c_size_t, 128_c_size_t, 24_c_size_t, omp_null_allocator))) & + stop 12 + call omp_free (p, a) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2) + if (a == omp_null_allocator) & + stop 13 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 14 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 15 + p = omp_aligned_calloc (4_c_size_t, 5_c_size_t, 84_c_size_t, a2) + call c_f_pointer (p, ip, [420 / c_sizeof (0)]) + do i = 1, 420 / c_sizeof (0) + if (ip(i) /= 0) & + stop 16 + end do + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 17 + ip(1) = 5 + ip(420 / c_sizeof (0)) = 6 + q = omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, a2) + call c_f_pointer (q, iq, [768 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 16) /= 0) & + stop 18 + do i = 1, 768 / c_sizeof (0) + if (iq(i) /= 0) & + stop 19 + end do + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + r = omp_aligned_calloc (8_c_size_t, 64_c_size_t, 8_c_size_t, a2) + call c_f_pointer (r, ir, [512 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 8) /= 0) & + stop 20 + do i = 1, 512 / c_sizeof (0) + if (ir(i) /= 0) & + stop 21 + end do + ir(1) = 9 + ir(512 / c_sizeof (0)) = 10 + call omp_free (p, omp_null_allocator) + call omp_free (q, a2) + call omp_free (r, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4) + if (a == omp_null_allocator) & + stop 22 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 23 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 24 + call omp_set_default_allocator (a2) + p = omp_aligned_calloc (4_c_size_t, 21_c_size_t, 20_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [420 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 25 + do i = 1, 420 / c_sizeof (0) + if (ip(i) /= 0) & + stop 26 + end do + ip(1) = 5 + ip(420 / c_sizeof (0)) = 6 + q = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 64_c_size_t, omp_null_allocator) + call c_f_pointer (q, iq, [768 / c_sizeof (0)]) + if (mod (TRANSFER (q, iptr), 128) /= 0) & + stop 27 + do i = 1, 768 / c_sizeof (0) + if (iq(i) /= 0) & + stop 28 + end do + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + if (c_associated (omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, omp_null_allocator))) & + stop 29 + call omp_free (p, omp_null_allocator) + call omp_free (q, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) +end program main diff --git a/libgomp/testsuite/libgomp.fortran/alloc-6.f90 b/libgomp/testsuite/libgomp.fortran/alloc-6.f90 new file mode 100644 index 00000000000..59fd14da600 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-6.f90 @@ -0,0 +1,45 @@ +module m + use omp_lib + implicit none + + type (omp_alloctrait), parameter :: traits(*) & + = [ omp_alloctrait (omp_atk_pool_size, 1), & + omp_alloctrait (omp_atk_fallback, omp_atv_abort_fb) ] +end module m + +program main + use m + use iso_c_binding + implicit none (external, type) + integer (omp_allocator_handle_kind) :: a + integer(c_size_t), parameter :: zero = 0_c_size_t + + if (c_associated (omp_alloc (zero, omp_null_allocator))) & + stop 1 + if (c_associated (omp_aligned_alloc (64_c_size_t, zero, omp_null_allocator))) & + stop 2 + if (c_associated (omp_calloc (zero, zero, omp_null_allocator)) & + .or. c_associated (omp_calloc (32_c_size_t, zero, omp_null_allocator)) & + .or. c_associated (omp_calloc (zero, 64_c_size_t, omp_null_allocator))) & + stop 3 + if (c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, omp_null_allocator)) & + .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, omp_null_allocator)) & + .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, omp_null_allocator))) & + stop 4 + a = omp_init_allocator (omp_default_mem_space, 2, traits) + if (a /= omp_null_allocator) then + if (c_associated (omp_alloc (zero, a)) & + .or. c_associated (omp_alloc (zero, a)) & + .or. c_associated (omp_alloc (zero, a)) & + .or. c_associated (omp_aligned_alloc (16_c_size_t, zero, a)) & + .or. c_associated (omp_aligned_alloc (128_c_size_t, zero, a)) & + .or. c_associated (omp_calloc (zero, zero, a)) & + .or. c_associated (omp_calloc (32_c_size_t, zero, a)) & + .or. c_associated (omp_calloc (zero, 64_c_size_t, a)) & + .or. c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, a)) & + .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, a)) & + .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, a))) & + stop 5 + call omp_destroy_allocator (a) + end if +end program main diff --git a/libgomp/testsuite/libgomp.fortran/alloc-7.c b/libgomp/testsuite/libgomp.fortran/alloc-7.c new file mode 100644 index 00000000000..4d16d095150 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-7.c @@ -0,0 +1,5 @@ +int +get__alignof_int () +{ + return __alignof (int); +} diff --git a/libgomp/testsuite/libgomp.fortran/alloc-7.f90 b/libgomp/testsuite/libgomp.fortran/alloc-7.f90 new file mode 100644 index 00000000000..b047b0e4d10 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-7.f90 @@ -0,0 +1,174 @@ +! { dg-additional-sources alloc-7.c } +module m + use omp_lib + use iso_c_binding + implicit none + + type (omp_alloctrait), parameter :: traits2(*) & + = [ omp_alloctrait (omp_atk_alignment, 16), & + omp_alloctrait (omp_atk_sync_hint, omp_atv_default), & + omp_alloctrait (omp_atk_access, omp_atv_default), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), & + omp_alloctrait (omp_atk_partition, omp_atv_environment)] + + type (omp_alloctrait) :: traits3(7) & + = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), & + omp_alloctrait (omp_atk_alignment, 32), & + omp_alloctrait (omp_atk_access, omp_atv_all), & + omp_alloctrait (omp_atk_pool_size, 512), & + omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), & + omp_alloctrait (omp_atk_fb_data, 0), & + omp_alloctrait (omp_atk_partition, omp_atv_default)] + + type (omp_alloctrait), parameter :: traits4(*) & + = [ omp_alloctrait (omp_atk_alignment, 128), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] + + interface + integer(c_int) function get__alignof_int () bind(C) + import :: c_int + end + end interface +end module m + +program main + use m + implicit none (external, type) + integer(c_ptrdiff_t) :: iptr + type (c_ptr), volatile :: p, q, r + integer, pointer, volatile, contiguous :: ip(:), iq(:), ir(:) + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a, a2 + traits = [ omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 4096)] + + p = omp_aligned_alloc (c_sizeof (0), 3 * c_sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [3]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) & + stop 1 + ip(0) = 1 + ip(1) = 2 + ip(2) = 3 + call omp_free (p, omp_default_mem_alloc) + + p = omp_aligned_alloc (2 * c_sizeof (0), 2 * c_sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [2]) + if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0) & + stop 2 + ip(0) = 1 + ip(1) = 2 + call omp_free (p, omp_null_allocator) + + call omp_set_default_allocator (omp_default_mem_alloc) + p = omp_aligned_alloc (1_c_size_t, 2 * c_sizeof (0), omp_null_allocator) + call c_f_pointer (p, ip, [2]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) & + stop 3 + ip(0) = 3 + call omp_free (p, omp_get_default_allocator ()) + + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) & + stop 4 + p = omp_aligned_alloc (32_c_size_t, 3072_c_size_t, a) + call c_f_pointer (p, ip, [3072/c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 64) /= 0) & + stop 5 + ip(1) = 1 + ip(3072 / c_sizeof (0)) = 2 + + if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, a))) & + stop 6 + + call omp_free (p, a) + + p = omp_aligned_alloc (128_c_size_t, 3072_c_size_t, a) + call c_f_pointer (p, ip, [3072/c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 128) /= 0) & + stop 7 + ip(1) = 3 + ip(3072 / c_sizeof (0)) = 4 + call omp_free (p, omp_null_allocator) + + call omp_set_default_allocator (a) + if (omp_get_default_allocator () /= a) & + stop 8 + p = omp_aligned_alloc (64_c_size_t, 3072_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [3072/c_sizeof (0)]) + if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, omp_null_allocator))) & + stop 9 + call omp_free (p, a) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2) + if (a == omp_null_allocator) & + stop 9 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 10 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 11 + + p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, a2) + call c_f_pointer (p, ip, [420/c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 12 + ip(1) = 5 + ip(420 / c_sizeof (0)) = 6 + + q = omp_aligned_alloc (8_c_size_t, 768_c_size_t, a2) + call c_f_pointer (q, iq, [768/c_sizeof (0)]) + if (mod (TRANSFER (q, iptr), 16) /= 0) & + stop 13 + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + + r = omp_aligned_alloc (8_c_size_t, 512_c_size_t, a2) + call c_f_pointer (r, ir, [512/c_sizeof (0)]) + if (mod (TRANSFER (r, iptr), 8) /= 0) & + stop 14 + ir(1) = 9 + ir(512 / c_sizeof (0)) = 10 + call omp_free (p, omp_null_allocator) + call omp_free (q, a2) + call omp_free (r, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4) + if (a == omp_null_allocator) & + stop 15 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 16 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 17 + call omp_set_default_allocator (a2) + + p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [420/c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 18 + ip(0) = 5 + ip(420 / c_sizeof (0)) = 6 + + q = omp_aligned_alloc (64_c_size_t, 768_c_size_t, omp_null_allocator) + call c_f_pointer (q, iq, [768/c_sizeof (0)]) + if (mod (TRANSFER (q, iptr), 128) /= 0) & + stop 19 + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + if (c_associated (omp_aligned_alloc (8_c_size_t, 768_c_size_t, omp_null_allocator))) & + stop 20 + call omp_free (p, omp_null_allocator) + call omp_free (q, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) +end program main diff --git a/libgomp/testsuite/libgomp.fortran/alloc-8.f90 b/libgomp/testsuite/libgomp.fortran/alloc-8.f90 new file mode 100644 index 00000000000..4bff4d6ea29 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-8.f90 @@ -0,0 +1,58 @@ +module m + use omp_lib + implicit none + + type (omp_alloctrait), parameter :: traits(*) & + = [ omp_alloctrait (omp_atk_alignment, 16), & + omp_alloctrait (omp_atk_sync_hint, omp_atv_default), & + omp_alloctrait (omp_atk_access, omp_atv_default), & + omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), & + omp_alloctrait (omp_atk_partition, omp_atv_environment)] +end module m + +program main + use m + use iso_c_binding + implicit none (external, type) + integer (omp_allocator_handle_kind) :: a + type (c_ptr) :: p, q + integer (c_size_t), volatile :: large_sz + integer (c_ptrdiff_t) :: iptr + + a = omp_init_allocator (omp_default_mem_space, size (traits), traits) + if (a == omp_null_allocator) & + stop 1 + p = omp_alloc (2048_c_size_t, a) + if (mod (TRANSFER (p, iptr), 16) /= 0) & + stop 2 + large_sz = NOT (1023_c_size_t) + q = omp_alloc (large_sz, a) + if (c_associated (q)) & + stop 3 + q = omp_aligned_alloc (32_c_size_t, large_sz, a) + if (c_associated (q)) & + stop 4 + q = omp_calloc (large_sz / 4_c_size_t, 4_c_size_t, a) + if (c_associated (q)) & + stop 5 + q = omp_aligned_calloc (1_c_size_t, 2_c_size_t, large_sz / 2, a) + if (c_associated (q)) & + stop 6 + call omp_free (p, a) + large_sz = NOT (0_c_size_t) + large_sz = ISHFT (large_sz, -1) + large_sz = large_sz + 1 + if (c_associated (omp_calloc (2_c_size_t, large_sz, a))) & + stop 7 + if (c_associated (omp_calloc (large_sz, 1024_c_size_t, a))) & + stop 8 + if (c_associated (omp_calloc (large_sz, large_sz, a))) & + stop 9 + if (c_associated (omp_aligned_calloc (16_c_size_t, 2_c_size_t, large_sz, a))) & + stop 10 + if (c_associated (omp_aligned_calloc (32_c_size_t, large_sz, 1024_c_size_t, a))) & + stop 11 + if (c_associated (omp_aligned_calloc (64_c_size_t, large_sz, large_sz, a))) & + stop 12 + call omp_destroy_allocator (a) +end program main diff --git a/libgomp/testsuite/libgomp.fortran/alloc-9.f90 b/libgomp/testsuite/libgomp.fortran/alloc-9.f90 new file mode 100644 index 00000000000..6458f35fd1f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-9.f90 @@ -0,0 +1,196 @@ +! { dg-additional-sources alloc-7.c } +module m + use omp_lib + use iso_c_binding + implicit none + + type (omp_alloctrait), parameter :: traits2(*) & + = [ omp_alloctrait (omp_atk_alignment, 16), & + omp_alloctrait (omp_atk_sync_hint, omp_atv_default), & + omp_alloctrait (omp_atk_access, omp_atv_default), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), & + omp_alloctrait (omp_atk_partition, omp_atv_environment)] + type (omp_alloctrait) :: traits3(7) & + = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), & + omp_alloctrait (omp_atk_alignment, 32), & + omp_alloctrait (omp_atk_access, omp_atv_all), & + omp_alloctrait (omp_atk_pool_size, 512), & + omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), & + omp_alloctrait (omp_atk_fb_data, 0), & + omp_alloctrait (omp_atk_partition, omp_atv_default)] + type (omp_alloctrait), parameter :: traits4(*) & + = [ omp_alloctrait (omp_atk_alignment, 128), & + omp_alloctrait (omp_atk_pool_size, 1024), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] + + interface + integer(c_int) function get__alignof_int () bind(C) + import :: c_int + end + end interface +end module m + +program main + use m + implicit none (external, type) + type(c_ptr), volatile :: p, q, r + integer, pointer, contiguous, volatile :: ip(:), iq(:), ir(:) + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a, a2 + integer (c_ptrdiff_t) :: iptr + integer :: i + + traits = [ omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 4096)] + + p = omp_calloc (3_c_size_t, sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [3]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & + .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) & + stop 1 + ip(1) = 1 + ip(2) = 2 + ip(3) = 3 + call omp_free (p, omp_default_mem_alloc) + p = omp_calloc (2_c_size_t, sizeof (0), omp_default_mem_alloc) + call c_f_pointer (p, ip, [2]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & + .or. ip(1) /= 0 .or. ip(2) /= 0) & + stop 2 + ip(1) = 1 + ip(2) = 2 + call omp_free (p, omp_null_allocator) + call omp_set_default_allocator (omp_default_mem_alloc) + p = omp_calloc (1_c_size_t, sizeof (0), omp_null_allocator) + call c_f_pointer (p, ip, [1]) + if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 & + .or. ip(1) /= 0) & + stop 3 + ip(1) = 3 + call omp_free (p, omp_get_default_allocator ()) + + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) & + stop 4 + p = omp_calloc (3_c_size_t, 1024_c_size_t, a) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 64) /= 0) & + stop 5 + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 6 + end do + ip(1) = 1 + ip(3072 / c_sizeof (0)) = 2 + if (c_associated (omp_calloc (1024_c_size_t, 3_c_size_t, a))) & + stop 7 + call omp_free (p, a) + p = omp_calloc (512_c_size_t, 6_c_size_t, a) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 8 + end do + ip(1) = 3 + ip(3072 / c_sizeof (0)) = 4 + call omp_free (p, omp_null_allocator) + call omp_set_default_allocator (a) + if (omp_get_default_allocator () /= a) & + stop 9 + p = omp_calloc (12_c_size_t, 256_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [3072 / c_sizeof (0)]) + do i = 1, 3072 / c_sizeof (0) + if (ip(i) /= 0) & + stop 10 + end do + if (c_associated (omp_calloc (128_c_size_t, 24_c_size_t, omp_null_allocator))) & + stop 11 + call omp_free (p, a) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2) + if (a == omp_null_allocator) & + stop 12 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 13 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 14 + p = omp_calloc (10_c_size_t, 42_c_size_t, a2) + call c_f_pointer (p, ip, [420 / c_sizeof (0)]) + do i = 1, 420 / c_sizeof (0) + if (ip(i) /= 0) & + stop 15 + end do + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 16 + ip(1) = 5 + ip(420 / c_sizeof (0)) = 6 + q = omp_calloc (24_c_size_t, 32_c_size_t, a2) + call c_f_pointer (q, iq, [768 / c_sizeof (0)]) + if (mod (TRANSFER (q, iptr), 16) /= 0) & + stop 17 + do i = 1, 768 / c_sizeof (0) + if (iq(i) /= 0) & + stop 18 + end do + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + r = omp_calloc (128_c_size_t, 4_c_size_t, a2) + call c_f_pointer (r, ir, [512 / c_sizeof (0)]) + if (mod (TRANSFER (r, iptr), get__alignof_int ()) /= 0) & + stop 19 + do i = 1, 512 / c_sizeof (0) + if (ir(i) /= 0) & + stop 20 + end do + ir(1) = 9 + ir(512 / c_sizeof (0)) = 10 + call omp_free (p, omp_null_allocator) + call omp_free (q, a2) + call omp_free (r, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) + + a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4) + if (a == omp_null_allocator) & + stop 21 + if (traits3(6)%key /= omp_atk_fb_data) & + stop 22 + traits3(6)%value = a + a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3) + if (a2 == omp_null_allocator) & + stop 23 + call omp_set_default_allocator (a2) + p = omp_calloc (42_c_size_t, 10_c_size_t, omp_null_allocator) + call c_f_pointer (p, ip, [420 / c_sizeof (0)]) + if (mod (TRANSFER (p, iptr), 32) /= 0) & + stop 24 + do i = 1, 420 / c_sizeof (0) + if (ip(i) /= 0) & + stop 25 + end do + ip(1) = 5 + ip(420 / c_sizeof (0)) = 6 + q = omp_calloc (32_c_size_t, 24_c_size_t, omp_null_allocator) + call c_f_pointer (q, iq, [768 / c_sizeof (0)]) + if (mod (TRANSFER (q, iptr), 128) /= 0) & + stop 26 + do i = 1, 768 / c_sizeof (0) + if (iq(i) /= 0) & + stop 27 + end do + iq(1) = 7 + iq(768 / c_sizeof (0)) = 8 + if (c_associated (omp_calloc (24_c_size_t, 32_c_size_t, omp_null_allocator))) & + stop 28 + call omp_free (p, omp_null_allocator) + call omp_free (q, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_free (c_null_ptr, omp_null_allocator) + call omp_destroy_allocator (a2) + call omp_destroy_allocator (a) +end program main