1*5137c209Sagozillon!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s --check-prefixes="HLFIRDIALECT" 2*5137c209Sagozillon 3*5137c209Sagozillon!HLFIRDIALECT: func.func @_QPlocal_variable_intrinsic_size(%[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "a"}) { 4*5137c209Sagozillon!HLFIRDIALECT: %[[SZ_DATA:.*]] = fir.alloca index 5*5137c209Sagozillon!HLFIRDIALECT: %[[DECLARE:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope {{.*}} {uniq_name = "_QFlocal_variable_intrinsic_sizeEa"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>) 6*5137c209Sagozillon!HLFIRDIALECT: %[[DIMENSIONS:.*]]:3 = fir.box_dims %[[DECLARE]]#0, %{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index) 7*5137c209Sagozillon!HLFIRDIALECT: fir.store %[[DIMENSIONS]]#1 to %[[SZ_DATA]] : !fir.ref<index> 8*5137c209Sagozillon!HLFIRDIALECT: %[[SIZE_SEL:.*]] = arith.select {{.*}}, {{.*}}, {{.*}} : index 9*5137c209Sagozillon!HLFIRDIALECT: %[[B_ALLOCA:.*]] = fir.alloca !fir.array<?xf32>, %[[SIZE_SEL]] {bindc_name = "b", uniq_name = "_QFlocal_variable_intrinsic_sizeEb"} 10*5137c209Sagozillon!HLFIRDIALECT: %[[B_SHAPE:.*]] = fir.shape %[[SIZE_SEL]] : (index) -> !fir.shape<1> 11*5137c209Sagozillon!HLFIRDIALECT: %[[B_DECLARE:.*]]:2 = hlfir.declare %[[B_ALLOCA]](%[[B_SHAPE]]) {uniq_name = "_QFlocal_variable_intrinsic_sizeEb"} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.array<?xf32>>) 12*5137c209Sagozillon!HLFIRDIALECT: %[[BOUNDS:.*]] = omp.map.bounds lower_bound({{.*}} : index) upper_bound({{.*}} : index) extent({{.*}} : index) stride({{.*}} : index) start_idx({{.*}} : index) {stride_in_bytes = true} 13*5137c209Sagozillon!HLFIRDIALECT: %[[MAP_DATA_B:.*]] = omp.map.info var_ptr(%[[B_DECLARE]]#1 : !fir.ref<!fir.array<?xf32>>, f32) map_clauses(tofrom) capture(ByRef) bounds(%[[BOUNDS]]) -> !fir.ref<!fir.array<?xf32>> {name = "b"} 14*5137c209Sagozillon!HLFIRDIALECT: %[[MAP_DATA_SZ:.*]] = omp.map.info var_ptr(%[[SZ_DATA]] : !fir.ref<index>, index) map_clauses(implicit, exit_release_or_enter_alloc) capture(ByCopy) -> !fir.ref<index> {name = ""} 15*5137c209Sagozillon!HLFIRDIALECT: omp.target map_entries(%[[MAP_DATA_B]] -> %[[ARG1:.*]], %[[MAP_DATA_SZ]] -> %[[ARG2:.*]] : !fir.ref<!fir.array<?xf32>>, !fir.ref<index>) { 16*5137c209Sagozillon!HLFIRDIALECT: %[[SZ_LD:.*]] = fir.load %[[ARG2]] : !fir.ref<index> 17*5137c209Sagozillon!HLFIRDIALECT: %[[SZ_CONV:.*]] = fir.convert %[[SZ_LD]] : (index) -> i64 18*5137c209Sagozillon!HLFIRDIALECT: %[[SZ_CONV2:.*]] = fir.convert %[[SZ_CONV]] : (i64) -> index 19*5137c209Sagozillon!HLFIRDIALECT: %[[SEL_SZ:.*]] = arith.cmpi sgt, %[[SZ_CONV2]], %{{.*}} : index 20*5137c209Sagozillon!HLFIRDIALECT: %[[SEL_SZ2:.*]] = arith.select %[[SEL_SZ]], %[[SZ_CONV2]], %{{.*}} : index 21*5137c209Sagozillon!HLFIRDIALECT: %[[SHAPE:.*]] = fir.shape %[[SEL_SZ2]] : (index) -> !fir.shape<1> 22*5137c209Sagozillon!HLFIRDIALECT: %{{.*}} = hlfir.declare %[[ARG1]](%[[SHAPE]]) {uniq_name = "_QFlocal_variable_intrinsic_sizeEb"} : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>) -> (!fir.box<!fir.array<?xf32>>, !fir.ref<!fir.array<?xf32>>) 23*5137c209Sagozillon 24*5137c209Sagozillonsubroutine local_variable_intrinsic_size(a) 25*5137c209Sagozillon implicit none 26*5137c209Sagozillon real, dimension(:) :: a 27*5137c209Sagozillon real, dimension(size(a, 1)) :: b 28*5137c209Sagozillon 29*5137c209Sagozillon!$omp target map(tofrom: b) 30*5137c209Sagozillon b(5) = 5 31*5137c209Sagozillon!$omp end target 32*5137c209Sagozillonend subroutine 33