diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/config/gcn/gcn-hsa.h | 6 | ||||
| -rw-r--r-- | gcc/config/gcn/gcn-opts.h | 10 | ||||
| -rw-r--r-- | gcc/config/gcn/gcn.cc | 19 | ||||
| -rw-r--r-- | gcc/config/gcn/gcn.opt | 20 | ||||
| -rw-r--r-- | gcc/config/gcn/mkoffload.cc | 21 | ||||
| -rw-r--r-- | gcc/doc/invoke.texi | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 54 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 93 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 103 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 | 230 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 | 22 |
12 files changed, 585 insertions, 35 deletions
diff --git a/gcc/config/gcn/gcn-hsa.h b/gcc/config/gcn/gcn-hsa.h index 51b0509..0b5610b 100644 --- a/gcc/config/gcn/gcn-hsa.h +++ b/gcc/config/gcn/gcn-hsa.h @@ -82,11 +82,15 @@ extern unsigned int gcn_local_sym_hash (const char *name); configuration. The name of the attribute also changed. */ #define SRAMOPT "msram-ecc=on:-mattr=+sramecc;msram-ecc=off:-mattr=-sramecc" +/* Replace once XNACK is supported: + #define XNACKOPT "mxnack=on:-mattr=+xnack;mxnack=off:-mattr=-xnack" */ +#define XNACKOPT "!mnack=*:-mattr=-xnack;mnack=*:-mattr=-xnack" + /* Use LLVM assembler and linker options. */ #define ASM_SPEC "-triple=amdgcn--amdhsa " \ "%:last_arg(%{march=*:-mcpu=%*}) " \ "%{!march=*|march=fiji:--amdhsa-code-object-version=3} " \ - "%{" NO_XNACK "mxnack:-mattr=+xnack;:-mattr=-xnack} " \ + "%{" NO_XNACK XNACKOPT "}" \ "%{" NO_SRAM_ECC SRAMOPT "} " \ "-filetype=obj" #define LINK_SPEC "--pie --export-dynamic" diff --git a/gcc/config/gcn/gcn-opts.h b/gcc/config/gcn/gcn-opts.h index cd1b2ec..f780a7c 100644 --- a/gcc/config/gcn/gcn-opts.h +++ b/gcc/config/gcn/gcn-opts.h @@ -54,11 +54,13 @@ extern enum gcn_isa { #define TARGET_M0_LDS_LIMIT (TARGET_GCN3) #define TARGET_PACKED_WORK_ITEMS (TARGET_CDNA2_PLUS) -enum sram_ecc_type +#define TARGET_XNACK (flag_xnack != HSACO_ATTR_OFF) + +enum hsaco_attr_type { - SRAM_ECC_OFF, - SRAM_ECC_ON, - SRAM_ECC_ANY + HSACO_ATTR_OFF, + HSACO_ATTR_ON, + HSACO_ATTR_ANY }; #endif diff --git a/gcc/config/gcn/gcn.cc b/gcc/config/gcn/gcn.cc index 007730d..efb7211 100644 --- a/gcc/config/gcn/gcn.cc +++ b/gcc/config/gcn/gcn.cc @@ -157,8 +157,10 @@ gcn_option_override (void) acc_lds_size = 32768; } - /* The xnack option is a placeholder, for now. */ - if (flag_xnack) + /* The xnack option is a placeholder, for now. Before removing, update + gcn-hsa.h's XNACKOPT, gcn.opt's mxnack= default init+descr, and + invoke.texi's default description. */ + if (flag_xnack != HSACO_ATTR_OFF) sorry ("XNACK support"); } @@ -6162,11 +6164,12 @@ static void output_file_start (void) { /* In HSACOv4 no attribute setting means the binary supports "any" hardware - configuration. In GCC binaries, this is true for SRAM ECC, but not - XNACK. */ - const char *xnack = (flag_xnack ? ":xnack+" : ":xnack-"); - const char *sram_ecc = (flag_sram_ecc == SRAM_ECC_ON ? ":sramecc+" - : flag_sram_ecc == SRAM_ECC_OFF ? ":sramecc-" + configuration. */ + const char *xnack = (flag_xnack == HSACO_ATTR_ON ? ":xnack+" + : flag_xnack == HSACO_ATTR_OFF ? ":xnack-" + : ""); + const char *sram_ecc = (flag_sram_ecc == HSACO_ATTR_ON ? ":sramecc+" + : flag_sram_ecc == HSACO_ATTR_OFF ? ":sramecc-" : ""); const char *cpu; @@ -6210,7 +6213,7 @@ void gcn_hsa_declare_function_name (FILE *file, const char *name, tree) { int sgpr, vgpr; - bool xnack_enabled = false; + bool xnack_enabled = TARGET_XNACK; fputs ("\n\n", file); diff --git a/gcc/config/gcn/gcn.opt b/gcc/config/gcn/gcn.opt index c5c32bd..36c2b53 100644 --- a/gcc/config/gcn/gcn.opt +++ b/gcc/config/gcn/gcn.opt @@ -81,23 +81,23 @@ Wopenacc-dims Target Var(warn_openacc_dims) Warning Warn about invalid OpenACC dimensions. -mxnack -Target Var(flag_xnack) Init(0) -Compile for devices requiring XNACK enabled. Default off. - Enum -Name(sram_ecc_type) Type(enum sram_ecc_type) -SRAM-ECC modes: +Name(hsaco_attr_type) Type(enum hsaco_attr_type) +SRAM-ECC and XNACK modes: EnumValue -Enum(sram_ecc_type) String(off) Value(SRAM_ECC_OFF) +Enum(hsaco_attr_type) String(off) Value(HSACO_ATTR_OFF) EnumValue -Enum(sram_ecc_type) String(on) Value(SRAM_ECC_ON) +Enum(hsaco_attr_type) String(on) Value(HSACO_ATTR_ON) EnumValue -Enum(sram_ecc_type) String(any) Value(SRAM_ECC_ANY) +Enum(hsaco_attr_type) String(any) Value(HSACO_ATTR_ANY) + +mxnack= +Target RejectNegative Joined ToLower Enum(hsaco_attr_type) Var(flag_xnack) Init(HSACO_ATTR_OFF) +Compile for devices requiring XNACK enabled. Default \"off\". msram-ecc= -Target RejectNegative Joined ToLower Enum(sram_ecc_type) Var(flag_sram_ecc) Init(SRAM_ECC_ANY) +Target RejectNegative Joined ToLower Enum(hsaco_attr_type) Var(flag_sram_ecc) Init(HSACO_ATTR_ANY) Compile for devices with the SRAM ECC feature enabled, or not. Default \"any\". diff --git a/gcc/config/gcn/mkoffload.cc b/gcc/config/gcn/mkoffload.cc index 61bc927..988c123 100644 --- a/gcc/config/gcn/mkoffload.cc +++ b/gcc/config/gcn/mkoffload.cc @@ -72,10 +72,16 @@ #define SET_XNACK_ON(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \ | EF_AMDGPU_FEATURE_XNACK_ON_V4) +#define SET_XNACK_ANY(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \ + | EF_AMDGPU_FEATURE_XNACK_ANY_V4) #define SET_XNACK_OFF(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_XNACK_V4) \ | EF_AMDGPU_FEATURE_XNACK_OFF_V4) -#define TEST_XNACK(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \ - == EF_AMDGPU_FEATURE_XNACK_ON_V4) +#define TEST_XNACK_ANY(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \ + == EF_AMDGPU_FEATURE_XNACK_ANY_V4) +#define TEST_XNACK_ON(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \ + == EF_AMDGPU_FEATURE_XNACK_ON_V4) +#define TEST_XNACK_OFF(VAR) ((VAR & EF_AMDGPU_FEATURE_XNACK_V4) \ + == EF_AMDGPU_FEATURE_XNACK_OFF_V4) #define SET_SRAM_ECC_ON(VAR) VAR = ((VAR & ~EF_AMDGPU_FEATURE_SRAMECC_V4) \ | EF_AMDGPU_FEATURE_SRAMECC_ON_V4) @@ -907,9 +913,11 @@ main (int argc, char **argv) fPIC = true; else if (strcmp (argv[i], "-fpic") == 0) fpic = true; - else if (strcmp (argv[i], "-mxnack") == 0) + else if (strcmp (argv[i], "-mxnack=on") == 0) SET_XNACK_ON (elf_flags); - else if (strcmp (argv[i], "-mno-xnack") == 0) + else if (strcmp (argv[i], "-mxnack=any") == 0) + SET_XNACK_ANY (elf_flags); + else if (strcmp (argv[i], "-mxnack=off") == 0) SET_XNACK_OFF (elf_flags); else if (strcmp (argv[i], "-msram-ecc=on") == 0) SET_SRAM_ECC_ON (elf_flags); @@ -1073,8 +1081,9 @@ main (int argc, char **argv) obstack_ptr_grow (&ld_argv_obstack, gcn_s2_name); obstack_ptr_grow (&ld_argv_obstack, "-lgomp"); obstack_ptr_grow (&ld_argv_obstack, - (TEST_XNACK (elf_flags) - ? "-mxnack" : "-mno-xnack")); + (TEST_XNACK_ON (elf_flags) ? "-mxnack=on" + : TEST_XNACK_ANY (elf_flags) ? "-mxnack=any" + : "-mxnack=off")); obstack_ptr_grow (&ld_argv_obstack, (TEST_SRAM_ECC_ON (elf_flags) ? "-msram-ecc=on" : TEST_SRAM_ECC_ANY (elf_flags) ? "-msram-ecc=any" diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index ee78591..898a88c 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -20822,12 +20822,14 @@ run-time performance. The default is 32KB when using OpenACC or OpenMP, and 1MB otherwise. @opindex mxnack -@item -mxnack -Compile binaries suitable for devices with the XNACK feature enabled. Some -devices always require XNACK and some allow the user to configure XNACK. The -compiled code must match the device mode. The default is @samp{-mno-xnack}. -At present this option is a placeholder for support that is not yet -implemented. +@item -mxnack=on +@itemx -mxnack=off +@itemx -mxnack=any +Compile binaries suitable for devices with the XNACK feature enabled, disabled, +or either mode. Some devices always require XNACK and some allow the user to +configure XNACK. The compiled code must match the device mode. +@c The default is @samp{-mxnack=any}. +At present this option is a placeholder for support that is not yet implemented. @end table diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 new file mode 100644 index 0000000..a2dcf10 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 @@ -0,0 +1,54 @@ +module my_omp_lib + use iso_c_binding, only: c_intptr_t + !use omp_lib + implicit none + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module my_omp_lib + +subroutine one(n, my_alloc) + use my_omp_lib + implicit none +integer :: n +integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc + +!stack variables: +integer :: a,b,c(n),d(5),e(2) +!$omp allocate(a) ! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" } +!$omp allocate ( b , c ) align ( 32) allocator (my_alloc) +!$omp allocate (d) align( 128 ) +!$omp allocate( e ) allocator( omp_high_bw_mem_alloc ) + +!saved vars +integer, save :: k,l,m(5),r(2) +!$omp allocate(k) align(16) , allocator (omp_large_cap_mem_alloc) +!$omp allocate ( l ) allocator (omp_large_cap_mem_alloc) , align ( 32) +!$omp allocate (m) align( 128 ),allocator( omp_high_bw_mem_alloc ) +!$omp allocate( r ) allocator( omp_high_bw_mem_alloc ) + +!common /block/ +integer :: q,x,y(2),z(5) +common /com1/ q,x +common /com2/ y,z +!$omp allocate ( / com1/) align( 128 ) allocator( omp_high_bw_mem_alloc ) +!$omp allocate(/com2 / ) allocator( omp_high_bw_mem_alloc ) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 new file mode 100644 index 0000000..bf9c781d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 @@ -0,0 +1,93 @@ +module my_omp_lib + use iso_c_binding, only: c_intptr_t + !use omp_lib + implicit none + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 + type t + integer :: a + end type t +end module my_omp_lib + +subroutine zero() + !$omp assumes absent (allocators) + + !$omp assume absent (allocators) + !$omp end assume +end + +subroutine two(c,x2,y2) + use my_omp_lib + implicit none + integer, allocatable :: a, b(:), c(:,:) + type(t), allocatable :: x1 + type(t), pointer :: x2(:) + class(t), allocatable :: y1 + class(t), pointer :: y2(:) + + !$omp flush ! some executable statement + !$omp allocate(a) ! { dg-message "not yet supported" } + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + + !$omp allocate(x1,y1,x2,y2) ! { dg-message "not yet supported" } + allocate(x1,y1,x2(5),y2(5)) + deallocate(x1,y1,x2,y2) + + !$omp allocate(b,a) align ( 128 ) ! { dg-message "not yet supported" } + !$omp allocate align ( 64 ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) +end + +subroutine three(c) + use my_omp_lib + implicit none + integer :: q + integer, allocatable :: a, b(:), c(:,:) + + call foo() ! executable stmt + !$omp allocate allocator( omp_large_cap_mem_alloc ) , align(64) ! { dg-message "not yet supported" } + !$omp allocate(b) allocator( omp_high_bw_mem_alloc ) + !$omp allocate(c) allocator( omp_high_bw_mem_alloc ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + + block + q = 5 ! executable stmt + !$omp allocate(a) align(64) ! { dg-message "not yet supported" } + !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32) + !$omp allocate(c) allocator( omp_thread_mem_alloc ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + end block + call inner +contains + subroutine inner + call foo() ! executable stmt + !$omp allocate(a) align(64) ! { dg-message "not yet supported" } + !$omp allocate(b) allocator( omp_high_bw_mem_alloc ), align(32) + !$omp allocate(c) allocator( omp_thread_mem_alloc ) + allocate(a,b(4),c(3,4)) + deallocate(a,b,c) + end subroutine inner +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 new file mode 100644 index 0000000..73e5bbc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -0,0 +1,103 @@ +module my_omp_lib + use iso_c_binding, only: c_intptr_t + !use omp_lib + implicit none + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 + type t + integer,allocatable :: a + integer,pointer :: b(:,:) + end type t +end module my_omp_lib + +subroutine zero() + !$omp assumes absent (allocate) ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" } + + !$omp assume absent (allocate) ! { dg-error "Invalid 'ALLOCATE' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" } + !!$omp end assume +end + +subroutine alloc(c,x2,y2) + use my_omp_lib + implicit none + integer, allocatable :: a, b(:), c(:,:) + type(t) :: x1,x2 + class(t) :: y1,y2 + allocatable :: x1, y1 + + !$omp flush ! some executable statement + + !$omp allocate(x2%a,x2%b,y2%a,y2%b) allocator(omp_pteam_mem_alloc) align(64) ! { dg-error "Sorry, structure-element list item at .1. in ALLOCATE directive is not yet supported" } + allocate(x2%a,x2%b(3,4),y2%a,y2%b(3,4)) + + !$omp allocate(b(3)) align ( 64 ) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" } + allocate(b(3)) +end + +subroutine one(n, my_alloc) + use my_omp_lib + implicit none +integer :: n +integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc + +integer :: a,b,c(n),d(5),e(2) +integer, save :: k,l,m(5),r(2) +integer :: q,x,y(2),z(5) +common /com1/ q,x +common /com2/ y,z +integer, allocatable :: alloc +integer, pointer :: ptr + +!$omp allocate(q) ! { dg-error "'q' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" } + +!$omp allocate(d(:)) ! { dg-error "Unexpected expression as list item at .1. in ALLOCATE directive" } +!$omp allocate(a) align(4), align(4) ! { dg-error "Duplicated 'align' clause" } +!$omp allocate( e ) allocator( omp_high_bw_mem_alloc ), align(32),allocator( omp_high_bw_mem_alloc ) ! { dg-error "Duplicated 'allocator' clause" } + +!$omp allocate align(32) ! { dg-error "'!.OMP ALLOCATE' directive at .1. must either have a variable argument or, if associated with an ALLOCATE stmt, must be preceded by an executable statement or OpenMP construct" } + +!$omp allocate(alloc) align(128) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" } +!$omp allocate(ptr) align(128) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" } + +!$omp allocate(e) allocate(omp_thread_mem_alloc) ! { dg-error "Expected ALIGN or ALLOCATOR clause" } +end + +subroutine two() + integer, allocatable :: a,b,c + + call foo() + !$omp allocate(a) + a = 5 ! { dg-error "Unexpected assignment at .1.; expected ALLOCATE or !.OMP ALLOCATE statement" } + + !$omp allocate ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" } + !$omp allocate(b) + !$omp allocate ! { dg-error "!.OMP ALLOCATE statements at .1. and .2. have both no list item but only one may" } + allocate(a,b,c) + + !$omp allocate + allocate(a,b,c) ! allocate is no block construct, hence: + !$omp end allocate ! { dg-error "Unclassifiable OpenMP directive" } + + !$omp allocators allocate(align(64) : a, b) + !$omp allocators allocate(align(128) : c) ! { dg-error "Unexpected !.OMP ALLOCATORS at .1.; expected ALLOCATE statement after !.OMP ALLOCATORS" } + allocate(a,b,c) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 new file mode 100644 index 0000000..c46899d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 @@ -0,0 +1,230 @@ +! { dg-additional-options "-fmax-errors=1000" } +module my_omp_lib + use iso_c_binding, only: c_intptr_t + !use omp_lib + implicit none + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 + type t + integer,allocatable :: a + integer,pointer :: b(:,:) + end type t + integer :: used +end module my_omp_lib + +subroutine one(n, my_alloc) + use my_omp_lib + implicit none +integer :: n +integer(kind=omp_allocator_handle_kind), intent(in) :: my_alloc + +integer :: a,b,c(n),d(5),e(2) +integer, save :: k,l,m(5),r(2) +integer :: q,x,y(2),z(5) +common /com1/ q,x +common /com2/ y,z +integer, allocatable :: alloc +integer, pointer :: ptr +integer, parameter :: prm=5 + +!$omp allocate(prm) align(64) ! { dg-error "Argument 'prm' at .1. to declarative !.OMP ALLOCATE directive must be a variable" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } + +!$omp allocate(used) allocator(omp_pteam_mem_alloc) ! { dg-error "Argument 'used' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" } +!$omp allocate(n) allocator(omp_pteam_mem_alloc) ! { dg-error "Unexpected dummy argument 'n' as argument at .1. to declarative !.OMP ALLOCATE" } + +!$omp allocate (x) align(128) ! { dg-error "'x' at .1. is part of the common block '/com1/' and may only be specificed implicitly via the named common block" } + +!$omp allocate (a, b, a) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'a' in !.OMP ALLOCATE" } +contains + + subroutine inner + !$omp allocate(a) allocator(omp_pteam_mem_alloc) ! { dg-error "Argument 'a' at .1. to declarative !.OMP ALLOCATE shall be in the same scope as the variable declaration" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } + end +end + +subroutine three(n) + use my_omp_lib + implicit none +integer,value :: n +integer :: a,b,c(n),d(5),e(2) +integer, save :: k,l,m(5) +integer :: q,x,y(2),z(5),r +common /com4/ y,z +allocatable :: q +pointer :: b +!$omp allocate (c, d) allocator (omp_pteam_mem_alloc) +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) +!$omp allocate (c) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE" } +!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" } + +!$omp allocate(q,x) ! { dg-error "Unexpected allocatable variable 'q' at .1. in declarative !.OMP ALLOCATE directive" } +!$omp allocate(b,e) ! { dg-error "Unexpected pointer variable 'b' at .1. in declarative !.OMP ALLOCATE directive" } +end + +subroutine four(n) + integer :: qq, rr, ss, tt, uu, vv,n +!$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" } +!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" } +!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" } +!$omp allocate (uu) align(31) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1. that is a power of two" } +end + +subroutine five(n,my_alloc) + use my_omp_lib + implicit none + integer :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc +!$omp allocate (qq) allocator(3.0) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) allocator(3_2) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +!$omp allocate (tt) allocator(my_alloc) ! OK +end + + +subroutine five_SaveAll(n,my_alloc) + use my_omp_lib + implicit none + save + integer :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc +!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" } +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" } +!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" } +end + + +subroutine five_Save(n,my_alloc) + use my_omp_lib + implicit none + integer :: n + integer, save :: qq, rr, ss, tt, uu, vv + integer(omp_allocator_handle_kind) :: my_alloc +!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" } +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" } +!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" } +end + +module five_Module + use my_omp_lib + implicit none + integer, save :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc +!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" } +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" } +!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" } +end module + +program five_program + use my_omp_lib + implicit none + integer, save :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc +!$omp allocate (qq) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'qq' at .2. has the SAVE attribute" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (rr) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'rr' at .2. has the SAVE attribute" } +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'ss' at .2. has the SAVE attribute" } +!$omp allocate (tt) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item 'tt' at .2. has the SAVE attribute" } +end program + + + +subroutine six(n,my_alloc) + use my_omp_lib + implicit none + integer :: qq, rr, ss, tt, uu, vv,n + common /com6qq/ qq + common /com6rr/ rr + common /com6ss/ ss + common /com6tt/ tt + integer(omp_allocator_handle_kind) :: my_alloc + +!$omp allocate (/com6qq/) allocator(3.0) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6qq/' at .2. has the SAVE attribute" } +! { dg-error "Sorry, declarative !.OMP ALLOCATE at .1. not yet supported" "" { target *-*-* } .-1 } +!$omp allocate (/com6rr/) allocator(3_2) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6rr/' at .2. has the SAVE attribute" } +!$omp allocate (/com6ss/) allocator([omp_pteam_mem_alloc]) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6ss/' at .2. has the SAVE attribute" } +!$omp allocate (/com6tt/) allocator(my_alloc) ! { dg-error "Predefined allocator required in ALLOCATOR clause at .1. as the list item '/com6tt/' at .2. has the SAVE attribute" } +end + + +subroutine two() + use my_omp_lib + implicit none + integer,allocatable :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc + + call foo() +!$omp allocate (qq) allocator(3.0) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +allocate(qq) +!$omp allocate (rr) allocator(3_2) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +allocate(rr) +!$omp allocate (ss) allocator([omp_pteam_mem_alloc]) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind" } +allocate(ss) +!$omp allocate (tt) allocator(my_alloc) ! OK +allocate(tt) +end + +subroutine two_ptr() + use my_omp_lib + implicit none + integer,pointer :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc + + call foo() +!$omp allocate (qq) align(3+n) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(qq) +!$omp allocate (rr) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(rr) +!$omp allocate (ss) align([4]) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(ss) +!$omp allocate (tt) align(32.0) ! { dg-error "ALIGN requires a scalar positive constant integer alignment expression at .1." } +allocate(tt) + +end + +subroutine next() + use my_omp_lib + implicit none + integer,allocatable :: qq, rr, ss, tt, uu, vv,n + integer(omp_allocator_handle_kind) :: my_alloc + + !$omp allocate(qq) ! { dg-error "'!.OMP ALLOCATE' directive at .1. associated with an ALLOCATE stmt must be preceded by an executable statement or OpenMP construct; note the variables in the list all have the allocatable or pointer attribute" } + allocate(qq,rr) + + !$omp allocate(uu,tt) + !$omp allocate(tt) ! { dg-warning "'tt' appears more than once in 'allocate" } + allocate(uu,tt) + + !$omp allocate(uu,vv) ! { dg-error "'uu' specified in 'allocate' at .1. but not in the associated ALLOCATE statement" } + allocate(vv) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 new file mode 100644 index 0000000..b39f6d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-1.f90 @@ -0,0 +1,28 @@ +implicit none +integer, allocatable :: a, b +integer :: q +integer :: arr(2) + +!$omp allocators allocate(align(64): a) +block ! { dg-error "expected ALLOCATE statement after !.OMP ALLOCATORS" } +end block ! { dg-error "Expecting END PROGRAM statement" } + + +!$omp allocators allocate(align(64): a) + allocate(a, b) ! OK +!$omp end allocators + +!$omp allocators allocate(align(128): b) + allocate(a, b) ! OK (assuming not allocated) + + +!$omp allocators allocate(align(64): a) + allocate(a, b, stat=arr) ! { dg-error "Stat-variable at .1. must be a scalar INTEGER variable" } +!$omp end allocators + + +!$omp allocators allocate(align(64): a) + allocate(q) ! { dg-error "is neither a data pointer nor an allocatable variable" } +!$omp end allocators ! { dg-error "Unexpected !.OMP END ALLOCATORS" } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 new file mode 100644 index 0000000..6fb8087 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocators-2.f90 @@ -0,0 +1,22 @@ +implicit none +integer, allocatable :: a, b +integer :: q +integer :: arr(2) + +!$omp allocators allocate(align(64): a) + allocate(a, b) ! OK +!$omp end allocators + +!$omp allocators allocate(align(128): b) + allocate(a, b) ! OK (assuming not allocated) + + +!$omp allocators allocate(align(62.0): a) ! { dg-error "a scalar positive constant integer alignment expression" } + allocate(a) + + +!$omp allocators allocate(align(64): a, b) ! { dg-error "'b' specified in 'allocate' at \\(1\\) but not in the associated ALLOCATE statement" } + allocate(a) +!$omp end allocators + +end |