diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h index 0e2932fa1ab85..a77dcedea9020 100644 --- a/flang/include/flang/Lower/ConvertVariable.h +++ b/flang/include/flang/Lower/ConvertVariable.h @@ -25,6 +25,7 @@ namespace fir { class ExtendedValue; class FirOpBuilder; class GlobalOp; +class FortranVariableFlagsAttr; } // namespace fir namespace Fortran ::lower { @@ -110,5 +111,10 @@ void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter, mlir::Location loc, const Fortran::semantics::Symbol &typeInfoSym); +/// Translate the Fortran attributes of \p sym into the FIR variable attribute +/// representation. +fir::FortranVariableFlagsAttr +translateSymbolAttributes(mlir::MLIRContext *mlirContext, + const Fortran::semantics::Symbol &sym); } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp index 566840c62ba1f..09c4c7a20e6fd 100644 --- a/flang/lib/Lower/ConvertExprToHLFIR.cpp +++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -17,6 +17,7 @@ #include "flang/Lower/ConvertCall.h" #include "flang/Lower/ConvertConstant.h" #include "flang/Lower/ConvertType.h" +#include "flang/Lower/ConvertVariable.h" #include "flang/Lower/IntrinsicCall.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" @@ -136,12 +137,17 @@ class HlfirDesignatorBuilder { const T &designatorNode) { mlir::Type designatorType = computeDesignatorType(resultValueType, partInfo, designatorNode); + return genDesignate(designatorType, partInfo, /*attributes=*/{}); + } + fir::FortranVariableOpInterface + genDesignate(mlir::Type designatorType, PartInfo &partInfo, + fir::FortranVariableFlagsAttr attributes) { std::optional complexPart; auto designate = getBuilder().create( getLoc(), designatorType, partInfo.base.getBase(), partInfo.componentName, partInfo.componentShape, partInfo.subscripts, partInfo.substring, complexPart, partInfo.resultShape, - partInfo.typeParams); + partInfo.typeParams, attributes); return mlir::cast( designate.getOperation()); } @@ -157,6 +163,17 @@ class HlfirDesignatorBuilder { fir::FortranVariableOpInterface gen(const Fortran::evaluate::Component &component) { PartInfo partInfo; + if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol())) { + // Generate whole allocatable or pointer component reference. The + // hlfir.designate result will be a pointer/allocatable. + auto [_, componentType] = visitComponentImpl( + component, partInfo, /*dereferencePointerAndAllocComponents=*/false); + mlir::Type designatorType = fir::ReferenceType::get(componentType); + fir::FortranVariableFlagsAttr attributes = + Fortran::lower::translateSymbolAttributes(getBuilder().getContext(), + component.GetLastSymbol()); + return genDesignate(designatorType, partInfo, attributes); + } mlir::Type resultType = visit(component, partInfo); return genDesignate(resultType, partInfo, component); } @@ -280,7 +297,8 @@ class HlfirDesignatorBuilder { PartInfo &partInfo) { mlir::Type baseType; if (const auto *component = arrayRef.base().UnwrapComponent()) - baseType = visitComponentImpl(*component, partInfo).second; + baseType = hlfir::getFortranElementOrSequenceType( + visitComponentImpl(*component, partInfo).second); else baseType = visit(arrayRef.base().GetLastSymbol(), partInfo); @@ -428,6 +446,8 @@ class HlfirDesignatorBuilder { // array. The code below determines the shape of the component reference if // any. auto [baseType, componentType] = visitComponentImpl(component, partInfo); + mlir::Type componentBaseType = + hlfir::getFortranElementOrSequenceType(componentType); if (partInfo.base.isArray()) { // For array%scalar_comp, the result shape is // the one of the base. Compute it here. Note that the lower bounds of the @@ -436,13 +456,13 @@ class HlfirDesignatorBuilder { partInfo.resultShape = hlfir::genShape(loc, getBuilder(), partInfo.base); assert(!partInfo.componentShape && "Fortran designators can only have one ranked part"); - return changeElementType(baseType, componentType); + return changeElementType(baseType, componentBaseType); } // scalar%array_comp or scalar%scalar. In any case the shape of this // part-ref is coming from the component. partInfo.resultShape = partInfo.componentShape; partInfo.componentShape = {}; - return componentType; + return componentBaseType; } // Returns the pair, computes partInfo.base, @@ -451,7 +471,8 @@ class HlfirDesignatorBuilder { // processing a following ArrayRef, if any, and in "visit" otherwise. std::pair visitComponentImpl(const Fortran::evaluate::Component &component, - PartInfo &partInfo) { + PartInfo &partInfo, + bool dereferencePointerAndAllocComponents = true) { fir::FirOpBuilder &builder = getBuilder(); // Break the Designator visit here: if the base is an array-ref, a // coarray-ref, or another component, this creates another hlfir.designate @@ -473,10 +494,11 @@ class HlfirDesignatorBuilder { if (recordType.isDependentType()) TODO(getLoc(), "Designate derived type with length parameters in HLFIR"); mlir::Type fieldType = recordType.getType(partInfo.componentName); - fieldType = hlfir::getFortranElementOrSequenceType(fieldType); - partInfo.componentShape = genComponentShape(componentSym, fieldType); + mlir::Type fieldBaseType = + hlfir::getFortranElementOrSequenceType(fieldType); + partInfo.componentShape = genComponentShape(componentSym, fieldBaseType); - mlir::Type fieldEleType = hlfir::getFortranElementType(fieldType); + mlir::Type fieldEleType = hlfir::getFortranElementType(fieldBaseType); if (fir::isRecordWithTypeParameters(fieldEleType)) TODO(loc, "lower a component that is a parameterized derived type to HLFIR"); @@ -496,7 +518,8 @@ class HlfirDesignatorBuilder { // For pointers and allocatables, if there is a substring, complex part or // array ref, the designator should be broken here and the pointer or // allocatable dereferenced. - if (Fortran::semantics::IsAllocatableOrPointer(componentSym)) + if (Fortran::semantics::IsAllocatableOrPointer(componentSym) && + dereferencePointerAndAllocComponents) TODO(loc, "lowering ref to allocatable or pointer component to HLFIR"); return {baseType, fieldType}; diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index fff076bb05498..83b56567d5f24 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1311,9 +1311,8 @@ recoverShapeVector(llvm::ArrayRef shapeVec, mlir::Value initVal) { return result; } -static fir::FortranVariableFlagsAttr -translateSymbolAttributes(mlir::MLIRContext *mlirContext, - const Fortran::semantics::Symbol &sym) { +fir::FortranVariableFlagsAttr Fortran::lower::translateSymbolAttributes( + mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym) { fir::FortranVariableFlagsEnum flags = fir::FortranVariableFlagsEnum::None; const auto &attrs = sym.attrs(); if (attrs.test(Fortran::semantics::Attr::ALLOCATABLE)) @@ -1372,7 +1371,7 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, lenParams.emplace_back(len); auto name = Fortran::lower::mangle::mangleName(sym); fir::FortranVariableFlagsAttr attributes = - translateSymbolAttributes(builder.getContext(), sym); + Fortran::lower::translateSymbolAttributes(builder.getContext(), sym); auto newBase = builder.create( loc, base, name, shapeOrShift, lenParams, attributes); symMap.addVariableDefinition(sym, newBase, force); @@ -1411,7 +1410,7 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter, fir::FirOpBuilder &builder = converter.getFirOpBuilder(); const mlir::Location loc = genLocation(converter, sym); fir::FortranVariableFlagsAttr attributes = - translateSymbolAttributes(builder.getContext(), sym); + Fortran::lower::translateSymbolAttributes(builder.getContext(), sym); auto name = Fortran::lower::mangle::mangleName(sym); hlfir::EntityWithAttributes declare = hlfir::genDeclare(loc, builder, exv, name, attributes); diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp index c426cddbd135e..5487defb69dc5 100644 --- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp +++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp @@ -214,11 +214,19 @@ class DesignateOpConversion // - scalar%array(indices) [substring| complex part] mlir::Type componentType = baseEleTy.cast().getType( designate.getComponent().value()); - if (componentType.isa()) - TODO(loc, - "addressing parametrized derived type automatic components"); mlir::Type coorTy = fir::ReferenceType::get(componentType); base = builder.create(loc, coorTy, base, fieldIndex); + if (componentType.isa()) { + auto variableInterface = mlir::cast( + designate.getOperation()); + if (variableInterface.isAllocatable() || + variableInterface.isPointer()) { + rewriter.replaceOp(designate, base); + return mlir::success(); + } + TODO(loc, + "addressing parametrized derived type automatic components"); + } baseEleTy = hlfir::getFortranElementType(componentType); shape = designate.getComponentShape(); } else { diff --git a/flang/test/Lower/HLFIR/allocatable-and-pointer-components.f90 b/flang/test/Lower/HLFIR/allocatable-and-pointer-components.f90 new file mode 100644 index 0000000000000..c29b62aef251d --- /dev/null +++ b/flang/test/Lower/HLFIR/allocatable-and-pointer-components.f90 @@ -0,0 +1,119 @@ +! Test lowering of whole allocatable and pointer components to HLFIR +! RUN: bbc -emit-fir -hlfir -o - %s -I nw | FileCheck %s + +module def_test_types + type t1 + real, pointer :: p(:) + end type + type t2 + real, allocatable :: a(:) + end type + type t3 + real, pointer, contiguous :: p_contiguous(:) + end type + type t4 + character(:), pointer :: char_p(:) + end type + type t5 + character(10), allocatable :: char_a(:) + end type + interface + subroutine takes_pointer(y) + real, pointer :: y(:) + end subroutine + subroutine takes_contiguous_pointer(y) + real, pointer, contiguous :: y(:) + end subroutine + subroutine takes_allocatable(y) + real, allocatable :: y(:) + end subroutine + subroutine takes_char_pointer(y) + character(:), pointer :: y(:) + end subroutine + subroutine takes_char_alloc_cst_len(y) + character(10), allocatable :: y(:) + end subroutine + subroutine takes_array(y) + real :: y(*) + end subroutine + subroutine takes_char_array(y) + character(*) :: y(*) + end subroutine + + end interface +end module + +subroutine passing_pointer(x) + use def_test_types + implicit none + type(t1) :: x + call takes_pointer(x%p) +end subroutine +! CHECK-LABEL: func.func @_QPpassing_pointer( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: fir.call @_QPtakes_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref>>>) -> () + +subroutine passing_allocatable(x) + use def_test_types + implicit none + type(t2) :: x + call takes_allocatable(x%a) + call takes_array(x%a) +end subroutine +! CHECK-LABEL: func.func @_QPpassing_allocatable( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: fir.call @_QPtakes_allocatable(%[[VAL_2]]) {{.*}}: (!fir.ref>>>) -> () +! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"a"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref>) -> () + +subroutine passing_contiguous_pointer(x) + use def_test_types + type(t3) :: x + call takes_contiguous_pointer(x%p_contiguous) + call takes_array(x%p_contiguous) +end subroutine +! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: fir.call @_QPtakes_contiguous_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref>>>) -> () +! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"p_contiguous"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> +! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref>>> +! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr>) -> !fir.ref> +! CHECK: fir.call @_QPtakes_array(%[[VAL_6]]) {{.*}}: (!fir.ref>) -> () + +subroutine passing_char_pointer(x) + use def_test_types + implicit none + type(t4) :: x + call takes_char_pointer(x%char_p) +end subroutine +! CHECK-LABEL: func.func @_QPpassing_char_pointer( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0{"char_p"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>) -> !fir.ref>>>> +! CHECK: fir.call @_QPtakes_char_pointer(%[[VAL_2]]) {{.*}}: (!fir.ref>>>>) -> () + +subroutine passing_char_alloc_cst_len(x) + use def_test_types + implicit none + type(t5) :: x + call takes_char_alloc_cst_len(x%char_a) + call takes_char_array(x%char_a) +end subroutine +! CHECK-LABEL: func.func @_QPpassing_char_alloc_cst_len( +! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {{.*}}Ex +! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"} typeparams %[[VAL_2]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>, index) -> !fir.ref>>>> +! CHECK: fir.call @_QPtakes_char_alloc_cst_len(%[[VAL_3]]) {{.*}}: (!fir.ref>>>>) -> () +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_1]]#0{"char_a"} typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>, index) -> !fir.ref>>>> +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref>>>> +! CHECK: %[[VAL_7:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>>) -> !fir.heap>> +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.heap>>) -> !fir.ref> +! CHECK: %[[VAL_9:.*]] = fir.emboxchar %[[VAL_8]], %[[VAL_4]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPtakes_char_array(%[[VAL_9]]) {{.*}}: (!fir.boxchar<1>) -> ()