Re: [PATCH 1/2] OpenMP/Fortran: Map intermediate array descriptor [PR120505]

Tobias Burnus <[email protected]>
Newsgroups gmane.comp.gcc.patches,gmane.comp.gcc.fortran
Message-ID <[email protected]>
Paul-Antoine Arras wrote:
> Please find attached a slightly amended version of the patch with 
> OMP_CLAUSE_MAP_SIZE_NEEDS_ADJUSTMENT defined as a flag rather than a 
> special value.

I misread one part of the patch – but it turned out be helpful,
nonetheless, because the testcase I created fails (see attachment).

With current mainline (w/o offloading configured), the testcase passes
(compiles and runs with host fallback).

However, with the 1/2 patch applied, it segfaults:

libgomp/testsuite/libgomp.fortran/map-subarray-13.f90:41:38:

    41 | !$omp   map(to: chunk%left_rcv_buffer)
       |                                      ^
internal compiler error: Segmentation fault
0x26213cd internal_error(char const*, ...)
         ../../../repos/gcc/gcc/diagnostic-global-context.cc:787
0x123d12f crash_signal
         ../../../repos/gcc/gcc/toplev.cc:325
0xec3ebe omp_build_struct_sibling_lists
         ../../../repos/gcc/gcc/gimplify.cc:13421
0xed14b7 gimplify_adjust_omp_clauses
         ../../../repos/gcc/gcc/gimplify.cc:15660
0xef11be gimplify_omp_target_update
         ../../../repos/gcc/gcc/gimplify.cc:19054


The testcase is a modified version of your testcase, with some additional
layers of allocatables added.

The fail is because struct_node == NULL:

13402         if (c != NULL && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
13403             && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_STRUCT
13404             && OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c)) == GOMP_MAP_TO_PSET
13405             && OMP_CLAUSE_MAP_KIND (grp->grp_end) == GOMP_MAP_ATTACH_DETACH
13406             && OMP_CLAUSE_MAP_SIZE_NEEDS_ADJUSTMENT (grp->grp_end))
13407           {
...
13420             tree *struct_node = struct_map_to_clause->get (base);
13421             omp_siblist_move_node_after (c, cp, &OMP_CLAUSE_CHAIN (*struct_node));


(gdb) p struct_node
$11 = (tree *) 0x0

(gdb) p debug(c)
  <omp_clause 0x7ffff727a2d0 constant map
     op-0: <nop_expr 0x7ffff728a7a0>
     op-1: <integer_cst 0x7ffff7402df8 0>
     op-2:>
$7 = void

(gdb) p c == *cp
$9 = true


(gdb) p debug(base)
  <indirect_ref 0x7ffff7366a40
     type <array_type 0x7ffff722f0a8
         type <record_type 0x7ffff7223690 tile_type2 BLK
...
     arg:0 <nop_expr 0x7ffff728a7a0
         arg:0 <component_ref 0x7ffff7289b70 type <pointer_type 0x7ffff7424738>
             arg:0 <component_ref 0x7ffff7341210 type <record_type 0x7ffff722f000 array01_tile_type2>
                 arg:0 <var_decl 0x7ffff72324c0 chunk> arg:1 <field_decl 0x7ffff7230140 tiles>

* * *

Testcase attached (modified version of your testcase).

Tobias
map-subarray-13.f90 (text/x-fortran, 1.5 KB)
! { dg-do run }

! PR fortran/120505

! Check that a nested allocatable DT component is mapped properly even when the
! first component is *not* mapped.

module m

  type field_type
    real(kind=8), allocatable :: density0(:,:), density1(:,:)
  end type field_type

  type tile_type
    type(field_type),allocatable :: field(:)
  end type tile_type

  type tile_type2
    type(tile_type),allocatable :: tiles_inner(:)
  end type tile_type2

  type chunk_type
    real(kind=8), allocatable :: left_rcv_buffer(:)
    type(tile_type2), allocatable :: tiles(:)
  end type chunk_type

  type(chunk_type) :: chunk

end

use m

allocate(chunk%tiles(1))
allocate(chunk%tiles(1)%tiles_inner(1))
allocate(chunk%tiles(1)%tiles_inner(1)%field(1))
chunk%tiles(1)%tiles_inner(1)%field(1)%density1 = reshape([1,2,3,4],[2,2])
allocate(chunk%left_rcv_buffer(1))

!$omp target enter data &
!$omp   map(to: chunk%tiles(1)%tiles_inner(1)%field(1)%density1) &
!$omp   map(to: chunk%left_rcv_buffer)

!$omp target
  if (any (chunk%tiles(1)%tiles_inner(1)%field(1)%density1 /= reshape([1,2,3,4],[2,2]))) stop 1
  chunk%tiles(1)%tiles_inner(1)%field(1)%density1 = chunk%tiles(1)%tiles_inner(1)%field(1)%density1 + 5
  chunk%left_rcv_buffer(1) = 42.0_8
!$omp end target

!$omp target exit data &
!$omp   map(from: chunk%tiles(1)%tiles_inner(1)%field(1)%density1) &
!$omp   map(from: chunk%left_rcv_buffer)

if (any (chunk%tiles(1)%tiles_inner(1)%field(1)%density1 /= 5 + reshape([1,2,3,4],[2,2]))) stop 1
if (chunk%left_rcv_buffer(1) /= 42.0_8) stop 1

end
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.