flang/test/Lower/pointer-initial-target-2.f90

   1 ! Test lowering of pointer initial target
   2 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
   3
   4 ! This tests focus on the scope context of initial data target.
   5 ! More complete tests regarding the initial data target expression
   6 ! are done in pointer-initial-target.f90.
   7
   8 ! Test pointer initial data target with pointer in common blocks
   9 block data
  10   real, pointer :: p
  11   real, save, target :: b
  12   common /a/ p
  13   data p /b/
  14 ! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
  15   ! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
  16   ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
  17   ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<f32>
  18   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<f32>) -> !fir.box<!fir.ptr<f32>>
  19   ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[rebox]], [0 : index] : (tuple<!fir.box<!fir.ptr<f32>>>, !fir.box<!fir.ptr<f32>>) -> tuple<!fir.box<!fir.ptr<f32>>>
  20   ! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
  21 end block data
  22
  23 ! Test two common depending on each others because of initial data
  24 ! targets
  25 block data tied
  26   real, target :: x1 = 42
  27   real, target :: x2 = 43
  28   real, pointer :: p1 => x2
  29   real, pointer :: p2 => x1
  30   common /c1/ x1, p1
  31   common /c2/ x2, p2
  32 ! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
  33   ! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
  34 ! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
  35   ! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
  36 end block data
  37
  38 ! Test pointer in a common with initial target in the same common.
  39 block data bdsnake
  40   integer, target :: b = 42
  41   integer, pointer :: p => b
  42   common /snake/ p, b
  43 ! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
  44   ! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
  45   ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
  46   ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
  47   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
  48   ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
  49   ! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<i32>
  50   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<i32>) -> !fir.box<!fir.ptr<i32>>
  51   ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[rebox]], [0 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, !fir.box<!fir.ptr<i32>>) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
  52   ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
  53   ! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>
  54 end block data
  55
  56 ! Test pointer initial data target in modules
  57 module some_mod
  58   real, target :: x(100)
  59   real, pointer :: p(:) => x
  60 ! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
  61   ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
  62   ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
  63   ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<100xf32>>
  64   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  65   ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
  66 end module
  67
  68 ! Test initial data target in a common block
  69 module some_mod_2
  70   real, target :: x(100), y(10:209)
  71   common /com/ x, y
  72   save :: /com/
  73   real, pointer :: p(:) => y
  74 ! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
  75   ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
  76   ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
  77   ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
  78   ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
  79   ! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
  80   ! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<200xf32>>
  81   ! CHECK: %[[shift:.*]] = fir.shift %c10{{.*}} : (index) -> !fir.shift<1>
  82   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]](%[[shift]]) : (!fir.box<!fir.array<200xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
  83   ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
  84 end module