Revert "[Flang] Add partial support for lowering procedure pointer as…

…signment. (#70461)" This reverts commit e07fec1. This change appears to have broken following buildbots: https://lab.llvm.org/buildbot/#/builders/176 https://lab.llvm.org/buildbot/#/builders/179 https://lab.llvm.org/buildbot/#/builders/184 https://lab.llvm.org/buildbot/#/builders/197 https://lab.llvm.org/buildbot/#/builders/198 All bots fails in testsuite where following tests seems broken: (eg: https://lab.llvm.org/buildbot/#/builders/176/builds/7131) test-suite::gfortran-regression-compile-regression__proc_ptr_46_f90.test test-suite::gfortran-regression-compile-regression__proc_ptr_37_f90.test
llvm · Nov 23, 2023 · 49f55d1 · 49f55d1
1 parent 7414c0d
commit 49f55d1
Show file tree

Hide file tree

Showing 17 changed files with 51 additions and 562 deletions.
diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h
@@ -382,8 +382,6 @@ class BoxAnalyzer : public fir::details::matcher<BoxAnalyzer> {
 
   /// Run the analysis on `sym`.
   void analyze(const Fortran::semantics::Symbol &sym) {
-    if (Fortran::semantics::IsProcedurePointer(sym))
-      return;
     if (symIsArray(sym)) {
       bool isConstant = !isAssumedSize(sym);
       llvm::SmallVector<int64_t> lbounds;

diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
@@ -111,8 +111,7 @@ class CallInterface {
     CharBoxValueAttribute, // BoxChar with VALUE
     // Passing a character procedure as a <procedure address, result length>
     // tuple.
-    CharProcTuple,
-    BoxProcRef
+    CharProcTuple
   };
   /// Different properties of an entity that can be passed/returned.
   /// One-to-One mapping with PassEntityBy but for
@@ -125,8 +124,7 @@ class CallInterface {
     CharProcTuple,
     Box,
     MutableBox,
-    Value,
-    BoxProcRef
+    Value
   };
 
   using FortranEntity = typename PassedEntityTypes<T>::FortranEntity;

diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
@@ -19,8 +19,6 @@
 
 namespace mlir {
 class Location;
-class Value;
-class Type;
 }
 namespace fir {
 class ExtendedValue;
@@ -31,9 +29,6 @@ class EntityWithAttributes;
 namespace Fortran::evaluate {
 struct ProcedureDesignator;
 }
-namespace Fortran::semantics {
-class Symbol;
-}
 
 namespace Fortran::lower {
 class AbstractConverter;
@@ -55,10 +50,5 @@ hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR(
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
 
-/// Generate initialization for procedure pointer to procedure target.
-mlir::Value
-convertProcedureDesignatorInitialTarget(Fortran::lower::AbstractConverter &,
-                                        mlir::Location,
-                                        const Fortran::semantics::Symbol &sym);
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -677,10 +677,6 @@ mlir::Value genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
 /// to keep all the lower bound and explicit parameter information.
 fir::BoxValue createBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
                              const fir::ExtendedValue &exv);
-
-/// Generate Null BoxProc for procedure pointer null initialization.
-mlir::Value createNullBoxProc(fir::FirOpBuilder &builder, mlir::Location loc,
-                              mlir::Type boxType);
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -58,9 +58,6 @@ class Entity : public mlir::Value {
   bool isValue() const { return isFortranValue(*this); }
   bool isVariable() const { return !isValue(); }
   bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
-  bool isProcedurePointer() const {
-    return hlfir::isBoxProcAddressType(getType());
-  }
   bool isBoxAddressOrValue() const {
     return hlfir::isBoxAddressOrValueType(getType());
   }

diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h
@@ -67,12 +67,6 @@ inline bool isBoxAddressType(mlir::Type type) {
   return type && type.isa<fir::BaseBoxType>();
 }
 
-/// Is this a fir.boxproc address type?
-inline bool isBoxProcAddressType(mlir::Type type) {
-  type = fir::dyn_cast_ptrEleTy(type);
-  return type && type.isa<fir::BoxProcType>();
-}
-
 /// Is this a fir.box or fir.class address or value type?
 inline bool isBoxAddressOrValueType(mlir::Type type) {
   return fir::unwrapRefType(type).isa<fir::BaseBoxType>();

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
@@ -3095,17 +3095,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       const Fortran::lower::SomeExpr *expr =
           Fortran::semantics::GetExpr(pointerObject);
       assert(expr);
-      if (Fortran::evaluate::IsProcedurePointer(*expr)) {
-        Fortran::lower::StatementContext stmtCtx;
-        hlfir::Entity pptr = Fortran::lower::convertExprToHLFIR(
-            loc, *this, *expr, localSymbols, stmtCtx);
-        auto boxTy{
-            Fortran::lower::getUntypedBoxProcType(builder->getContext())};
-        hlfir::Entity nullBoxProc(
-            fir::factory::createNullBoxProc(*builder, loc, boxTy));
-        builder->createStoreWithConvert(loc, nullBoxProc, pptr);
-        return;
-      }
       fir::MutableBoxValue box = genExprMutableBox(loc, *expr);
       fir::factory::disassociateMutableBox(*builder, loc, box);
     }
@@ -3252,24 +3241,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       mlir::Location loc, const Fortran::evaluate::Assignment &assign,
       const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
     Fortran::lower::StatementContext stmtCtx;
-
-    if (!lowerToHighLevelFIR() && Fortran::evaluate::IsProcedure(assign.rhs))
+    if (Fortran::evaluate::IsProcedure(assign.rhs))
       TODO(loc, "procedure pointer assignment");
-    if (Fortran::evaluate::IsProcedurePointer(assign.lhs)) {
-      hlfir::Entity lhs = Fortran::lower::convertExprToHLFIR(
-          loc, *this, assign.lhs, localSymbols, stmtCtx);
-      if (Fortran::evaluate::IsNullProcedurePointer(assign.rhs)) {
-        auto boxTy{Fortran::lower::getUntypedBoxProcType(&getMLIRContext())};
-        hlfir::Entity rhs(
-            fir::factory::createNullBoxProc(*builder, loc, boxTy));
-        builder->createStoreWithConvert(loc, rhs, lhs);
-        return;
-      }
-      hlfir::Entity rhs(getBase(Fortran::lower::convertExprToAddress(
-          loc, *this, assign.rhs, localSymbols, stmtCtx)));
-      builder->createStoreWithConvert(loc, rhs, lhs);
-      return;
-    }
 
     std::optional<Fortran::evaluate::DynamicType> lhsType =
         assign.lhs.GetType();

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
@@ -23,10 +23,6 @@
 #include "flang/Semantics/tools.h"
 #include <optional>
 
-static mlir::FunctionType
-getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc,
-                 Fortran::lower::AbstractConverter &converter);
-
 mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
   llvm::SmallVector<mlir::Type> resultTys;
   llvm::SmallVector<mlir::Type> inputTys;
@@ -1059,24 +1055,15 @@ class Fortran::lower::CallInterfaceImpl {
       const DummyCharacteristics *characteristics,
       const Fortran::evaluate::characteristics::DummyProcedure &proc,
       const FortranEntity &entity) {
-    if (!interface.converter.getLoweringOptions().getLowerToHighLevelFIR() &&
-        proc.attrs.test(
+    if (proc.attrs.test(
             Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer))
       TODO(interface.converter.getCurrentLocation(),
            "procedure pointer arguments");
+    // Otherwise, it is a dummy procedure.
     const Fortran::evaluate::characteristics::Procedure &procedure =
         proc.procedure.value();
     mlir::Type funcType =
         getProcedureDesignatorType(&procedure, interface.converter);
-    if (proc.attrs.test(Fortran::evaluate::characteristics::DummyProcedure::
-                            Attr::Pointer)) {
-      // Prodecure pointer dummy argument.
-      funcType = fir::ReferenceType::get(funcType);
-      addFirOperand(funcType, nextPassedArgPosition(), Property::BoxProcRef);
-      addPassedArg(PassEntityBy::BoxProcRef, entity, characteristics);
-      return;
-    }
-    // Otherwise, it is a dummy procedure.
     std::optional<Fortran::evaluate::DynamicType> resultTy =
         getResultDynamicType(procedure);
     if (resultTy && mustPassLengthWithDummyProcedure(procedure)) {
@@ -1100,40 +1087,37 @@ class Fortran::lower::CallInterfaceImpl {
   void handleExplicitResult(
       const Fortran::evaluate::characteristics::FunctionResult &result) {
     using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr;
-    mlir::Type mlirType;
-    if (auto proc{result.IsProcedurePointer()})
-      mlirType = fir::BoxProcType::get(
-          &mlirContext, getProcedureType(*proc, interface.converter));
-    else {
-      const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
-          result.GetTypeAndShape();
-      assert(typeAndShape && "expect type for non proc pointer result");
-      mlirType = translateDynamicType(typeAndShape->type());
-      fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
-      const auto *resTypeAndShape{result.GetTypeAndShape()};
-      bool resIsPolymorphic =
-          resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
-      bool resIsAssumedType =
-          resTypeAndShape && resTypeAndShape->type().IsAssumedType();
-      if (!bounds.empty())
-        mlirType = fir::SequenceType::get(bounds, mlirType);
-      if (result.attrs.test(Attr::Allocatable))
-        mlirType = fir::wrapInClassOrBoxType(
-            fir::HeapType::get(mlirType), resIsPolymorphic, resIsAssumedType);
-      if (result.attrs.test(Attr::Pointer))
-        mlirType =
-            fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
-                                      resIsPolymorphic, resIsAssumedType);
-
-      if (fir::isa_char(mlirType)) {
-        // Character scalar results must be passed as arguments in lowering so
-        // that an assumed length character function callee can access the
-        // result length. A function with a result requiring an explicit
-        // interface does not have to be compatible with assumed length
-        // function, but most compilers supports it.
-        handleImplicitCharacterResult(typeAndShape->type());
-        return;
-      }
+
+    if (result.IsProcedurePointer())
+      TODO(interface.converter.getCurrentLocation(),
+           "procedure pointer results");
+    const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
+        result.GetTypeAndShape();
+    assert(typeAndShape && "expect type for non proc pointer result");
+    mlir::Type mlirType = translateDynamicType(typeAndShape->type());
+    fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
+    const auto *resTypeAndShape{result.GetTypeAndShape()};
+    bool resIsPolymorphic =
+        resTypeAndShape && resTypeAndShape->type().IsPolymorphic();
+    bool resIsAssumedType =
+        resTypeAndShape && resTypeAndShape->type().IsAssumedType();
+    if (!bounds.empty())
+      mlirType = fir::SequenceType::get(bounds, mlirType);
+    if (result.attrs.test(Attr::Allocatable))
+      mlirType = fir::wrapInClassOrBoxType(fir::HeapType::get(mlirType),
+                                           resIsPolymorphic, resIsAssumedType);
+    if (result.attrs.test(Attr::Pointer))
+      mlirType = fir::wrapInClassOrBoxType(fir::PointerType::get(mlirType),
+                                           resIsPolymorphic, resIsAssumedType);
+
+    if (fir::isa_char(mlirType)) {
+      // Character scalar results must be passed as arguments in lowering so
+      // that an assumed length character function callee can access the result
+      // length. A function with a result requiring an explicit interface does
+      // not have to be compatible with assumed length function, but most
+      // compilers supports it.
+      handleImplicitCharacterResult(typeAndShape->type());
+      return;
     }
 
     addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
@@ -1550,10 +1534,3 @@ bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) {
   return ty.isa<fir::ReferenceType>() &&
          fir::isa_integer(fir::unwrapRefType(ty));
 }
-
-// Return the mlir::FunctionType of a procedure
-static mlir::FunctionType
-getProcedureType(const Fortran::evaluate::characteristics::Procedure &proc,
-                 Fortran::lower::AbstractConverter &converter) {
-  return SignatureBuilder{proc, converter, false}.genFunctionType();
-}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
@@ -175,10 +175,6 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
       std::tie(funcPointer, charFuncPointerLength) =
           fir::factory::extractCharacterProcedureTuple(builder, loc,
                                                        funcPointer);
-    // Reference to a procedure pointer. Load its value, the address of the
-    // procedure it points to.
-    if (Fortran::semantics::IsProcedurePointer(sym))
-      funcPointer = builder.create<fir::LoadOp>(loc, funcPointer);
   }
 
   mlir::IndexType idxTy = builder.getIndexType();
@@ -874,39 +870,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
-  // Handle the procedure pointer actual arguments.
-  if (actual.isProcedurePointer()) {
-    // Procedure pointer actual to procedure pointer dummy.
-    if (hlfir::isBoxProcAddressType(dummyType))
-      return PreparedDummyArgument{actual, /*cleanups=*/{}};
-    // Procedure pointer actual to procedure dummy.
-    if (hlfir::isFortranProcedureValue(dummyType)) {
-      actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
-      return PreparedDummyArgument{actual, /*cleanups=*/{}};
-    }
-  }
-
-  // NULL() actual to procedure pointer dummy
-  if (Fortran::evaluate::IsNullProcedurePointer(expr) &&
-      hlfir::isBoxProcAddressType(dummyType)) {
-    auto boxTy{Fortran::lower::getUntypedBoxProcType(builder.getContext())};
-    auto tempBoxProc{builder.createTemporary(loc, boxTy)};
-    hlfir::Entity nullBoxProc(
-        fir::factory::createNullBoxProc(builder, loc, boxTy));
-    builder.create<fir::StoreOp>(loc, nullBoxProc, tempBoxProc);
-    return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
-  }
-
+  // Do nothing if this is a procedure argument. It is already a
+  // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
   if (actual.isProcedure()) {
-    // Procedure actual to procedure pointer dummy.
-    if (hlfir::isBoxProcAddressType(dummyType)) {
-      auto tempBoxProc{builder.createTemporary(loc, actual.getType())};
-      builder.create<fir::StoreOp>(loc, actual, tempBoxProc);
-      return PreparedDummyArgument{tempBoxProc, /*cleanups=*/{}};
-    }
-    // Procedure actual to procedure dummy.
-    // Do nothing if this is a procedure argument. It is already a
-    // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
     if (actual.getType() != dummyType)
       actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, /*cleanups=*/{}};
@@ -1192,7 +1158,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
     case PassBy::CharBoxValueAttribute:
     case PassBy::Box:
     case PassBy::BaseAddress:
-    case PassBy::BoxProcRef:
     case PassBy::BoxChar: {
       PreparedDummyArgument preparedDummy =
           prepareUserCallActualArgument(loc, builder, *preparedActual, argTy,
@@ -1209,8 +1174,6 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
       break;
     case PassBy::CharProcTuple: {
       hlfir::Entity actual = preparedActual->getActual(loc, builder);
-      if (actual.isProcedurePointer())
-        actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
       if (!fir::isCharacterProcedureTuple(actual.getType()))
         actual = fixProcedureDummyMismatch(loc, builder, actual, argTy);
       caller.placeInput(arg, actual);
@@ -1532,8 +1495,6 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
     }
 
     hlfir::Entity actual = arg.value()->getActual(loc, builder);
-    if (actual.isProcedurePointer())
-      TODO(loc, "Procedure pointer as actual argument to intrinsics.");
     switch (argRules.lowerAs) {
     case fir::LowerIntrinsicArgAs::Value:
       operands.emplace_back(
@@ -2188,10 +2149,8 @@ genProcedureRef(CallContext &callContext) {
         TODO(loc, "assumed type actual argument");
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
-        if ((arg.passBy !=
-             Fortran::lower::CallerInterface::PassEntityBy::MutableBox) &&
-            (arg.passBy !=
-             Fortran::lower::CallerInterface::PassEntityBy::BoxProcRef)) {
+        if (arg.passBy !=
+            Fortran::lower::CallerInterface::PassEntityBy::MutableBox) {
           assert(
               arg.isOptional() &&
               "NULL must be passed only to pointer, allocatable, or OPTIONAL");

diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
@@ -4845,9 +4845,6 @@ class ArrayExprLowering {
         }
         // See C15100 and C15101
         fir::emitFatalError(loc, "cannot be POINTER, ALLOCATABLE");
-      case PassBy::BoxProcRef:
-        // Procedure pointer: no action here.
-        break;
       }
     }
 

diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1425,9 +1425,7 @@ class HlfirBuilder {
   }
 
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
-    TODO(
-        getLoc(),
-        "lowering function references that return procedure pointers to HLFIR");
+    TODO(getLoc(), "lowering ProcRef to HLFIR");
   }
 
   template <typename T>