diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -5639,6 +5639,13 @@ builder.getContext(), charTy.getFKind()), seqTy.getDimension())); } + llvm::SmallVector lbounds; + llvm::SmallVector nonDeferredLenParams; + if (!slice) { + lbounds = + fir::factory::getNonDefaultLowerBounds(builder, loc, extMemref); + nonDeferredLenParams = fir::factory::getNonDeferredLenParams(extMemref); + } mlir::Value embox = memref.getType().isa() ? builder.create(loc, boxTy, memref, shape, slice) @@ -5647,7 +5654,9 @@ .create(loc, boxTy, memref, shape, slice, fir::getTypeParams(extMemref)) .getResult(); - return [=](IterSpace) -> ExtValue { return fir::BoxValue(embox); }; + return [=](IterSpace) -> ExtValue { + return fir::BoxValue(embox, lbounds, nonDeferredLenParams); + }; } auto eleTy = arrTy.cast().getEleTy(); if (isReferentiallyOpaque()) { diff --git a/flang/test/Lower/parent-component.f90 b/flang/test/Lower/parent-component.f90 --- a/flang/test/Lower/parent-component.f90 +++ b/flang/test/Lower/parent-component.f90 @@ -135,7 +135,9 @@ ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box>>, index) -> (index, index, index) ! CHECK: %[[C1:.*]] = arith.constant 1 : index - ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1> + ! CHECK: %[[BOUND_OFFSET:.*]] = arith.subi %[[LOAD_LB0]], %[[C1]] : index + ! CHECK: %[[UB:.*]] = arith.addi %[[BOX_DIMS]]#1, %[[BOUND_OFFSET]] : index + ! CHECK: %[[SLICE:.*]] = fir.slice %[[LOAD_LB0]], %[[UB]], %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1> ! CHECK: %[[BOX:.*]] = fir.embox %[[MEM]](%[[SHAPE_SHIFT]]) [%[[SLICE]]] : (!fir.heap>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box>> ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box>>) -> !fir.box ! CHECK: %[[IS_CONTIGOUS:.*]] = fir.call @_FortranAIsContiguous(%[[BOX_NONE]]) {{.*}}: (!fir.box) -> i1 @@ -156,7 +158,9 @@ ! CHECK: %[[C0:.*]] = arith.constant 0 : index ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box>>, index) -> (index, index, index) ! CHECK: %[[C1:.*]] = arith.constant 1 : index - ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIMS]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1> + ! CHECK: %[[BOUND_OFFSET:.*]] = arith.subi %[[LOAD_LB0]], %[[C1]] : index + ! CHECK: %[[UB:.*]] = arith.addi %[[BOX_DIMS]]#1, %[[BOUND_OFFSET]] : index + ! CHECK: %[[SLICE:.*]] = fir.slice %[[LOAD_LB0]], %[[UB]], %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1> ! CHECK: %[[BOX:.*]] = fir.embox %[[LOAD_ALLOC]](%[[SHAPE_SHIFT]]) [%[[SLICE]]] : (!fir.heap>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.box>> ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box>>) -> !fir.box ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}}: (!fir.ref, !fir.box) -> i1 diff --git a/flang/test/Lower/pointer-assignments.f90 b/flang/test/Lower/pointer-assignments.f90 --- a/flang/test/Lower/pointer-assignments.f90 +++ b/flang/test/Lower/pointer-assignments.f90 @@ -67,6 +67,26 @@ p => x end subroutine +! Test that the lhs takes the bounds from rhs. +! CHECK-LABEL: func @_QPtest_pointer_component( +! CHECK-SAME: %[[temp:.*]]: !fir.ref>>}>> {fir.bindc_name = "temp"}, %[[temp_ptr:.*]]: !fir.ref>>> {fir.bindc_name = "temp_ptr"}) { +subroutine test_pointer_component(temp, temp_ptr) + type mytype + real, pointer :: ptr(:) + end type mytype + type(mytype) :: temp + real, pointer :: temp_ptr(:) + ! CHECK: %[[ptr_addr:.*]] = fir.coordinate_of %[[temp]], %{{.*}} : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> + ! CHECK: %[[ptr:.*]] = fir.load %[[ptr_addr]] : !fir.ref>>> + ! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[ptr]], %{{.*}} : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[shift:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> + ! CHECK: %[[arr_box:.*]] = fir.rebox %[[ptr]](%[[shift]]) : (!fir.box>>, !fir.shift<1>) -> !fir.box> + ! CHECK: %[[shift2:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1> + ! CHECK: %[[final_box:.*]] = fir.rebox %[[arr_box]](%[[shift2]]) : (!fir.box>, !fir.shift<1>) -> !fir.box>> + ! CHECK: fir.store %[[final_box]] to %[[temp_ptr]] : !fir.ref>>> + temp_ptr => temp%ptr +end subroutine + ! ----------------------------------------------------------------------------- ! Test pointer assignments with bound specs to contiguous right-hand side ! -----------------------------------------------------------------------------