[flang-commits] [flang] [flang] Accept pointer-valued function results as ASSOCIATED() arguments (PR #66238)

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Wed Sep 13 09:47:34 PDT 2023


https://github.com/klausler created https://github.com/llvm/llvm-project/pull/66238:

The POINTER= and TARGET= arguments to the intrinsic function ASSOCIATED() can be the results of references to functions that return object pointers or procedure pointers.  NULL() was working well but not program-defined pointer-valued functions.  Correct the validation of ASSOCIATED() and extend the infrastructure used to detect and characterize procedures and pointers.

>From 2f240b51bba2245402693fb2c55f62b5648d3044 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 1 Sep 2023 15:28:01 -0700
Subject: [PATCH] [flang] Accept pointer-valued function results as
 ASSOCIATED() arguments

The POINTER= and TARGET= arguments to the intrinsic function
ASSOCIATED() can be the results of references to functions that
return object pointers or procedure pointers.  NULL() was working
well but not program-defined pointer-valued functions.  Correct the
validation of ASSOCIATED() and extend the infrastructure used to
detect and characterize procedures and pointers.
---
 .../include/flang/Evaluate/characteristics.h  |   2 +
 flang/include/flang/Evaluate/tools.h          |  36 ++++--
 flang/lib/Evaluate/characteristics.cpp        |  16 +++
 flang/lib/Evaluate/fold-complex.cpp           |   2 +-
 flang/lib/Evaluate/intrinsics.cpp             |   6 +-
 flang/lib/Evaluate/tools.cpp                  |  61 ++++-------
 flang/lib/Lower/ConvertCall.cpp               |   9 +-
 flang/lib/Lower/ConvertExpr.cpp               |  33 +++---
 flang/lib/Lower/ConvertVariable.cpp           |   2 +-
 flang/lib/Lower/CustomIntrinsicCall.cpp       |  28 ++---
 flang/lib/Semantics/check-call.cpp            | 103 +++++++-----------
 flang/test/Semantics/associate01.f90          |   8 +-
 flang/test/Semantics/associated.f90           |  47 ++++++--
 flang/test/Semantics/call09.f90               |  14 +--
 flang/test/Semantics/call24.f90               |   2 +-
 15 files changed, 191 insertions(+), 178 deletions(-)

diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 932f3220c2bcbbb..20750dfad8ce06e 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -349,6 +349,8 @@ struct Procedure {
       const ProcedureDesignator &, FoldingContext &);
   static std::optional<Procedure> Characterize(
       const ProcedureRef &, FoldingContext &);
+  static std::optional<Procedure> Characterize(
+      const Expr<SomeType> &, FoldingContext &);
   // Characterizes the procedure being referenced, deducing dummy argument
   // types from actual arguments in the case of an implicit interface.
   static std::optional<Procedure> FromActuals(
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index b3f8f4a67a7b5dd..6caad5db4b39b2d 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -243,6 +243,29 @@ auto UnwrapConvertedExpr(B &x) -> common::Constify<A, B> * {
   return nullptr;
 }
 
+// UnwrapProcedureRef() returns a pointer to a ProcedureRef when the whole
+// expression is a reference to a procedure.
+template <typename A> inline const ProcedureRef *UnwrapProcedureRef(const A &) {
+  return nullptr;
+}
+
+inline const ProcedureRef *UnwrapProcedureRef(const ProcedureRef &proc) {
+  // Reference to subroutine or to a function that returns
+  // an object pointer or procedure pointer
+  return &proc;
+}
+
+template <typename T>
+inline const ProcedureRef *UnwrapProcedureRef(const FunctionRef<T> &func) {
+  return &func; // reference to a function returning a non-pointer
+}
+
+template <typename T>
+inline const ProcedureRef *UnwrapProcedureRef(const Expr<T> &expr) {
+  return common::visit(
+      [](const auto &x) { return UnwrapProcedureRef(x); }, expr.u);
+}
+
 // When an expression is a "bare" LEN= derived type parameter inquiry,
 // possibly wrapped in integer kind conversions &/or parentheses, return
 // a pointer to the Symbol with TypeParamDetails.
@@ -894,10 +917,6 @@ template <typename A> const Symbol *GetLastSymbol(const A &x) {
   }
 }
 
-// If a function reference constitutes an entire expression, return a pointer
-// to its PrcedureRef.
-const ProcedureRef *GetProcedureRef(const Expr<SomeType> &);
-
 // For everyday variables: if GetLastSymbol() succeeds on the argument, return
 // its set of attributes, otherwise the empty set.  Also works on variables that
 // are pointer results of functions.
@@ -912,7 +931,7 @@ template <typename A> semantics::Attrs GetAttrs(const A &x) {
 template <>
 inline semantics::Attrs GetAttrs<Expr<SomeType>>(const Expr<SomeType> &x) {
   if (IsVariable(x)) {
-    if (const auto *procRef{GetProcedureRef(x)}) {
+    if (const auto *procRef{UnwrapProcedureRef(x)}) {
       if (const Symbol * interface{procRef->proc().GetInterfaceSymbol()}) {
         if (const auto *details{
                 interface->detailsIf<semantics::SubprogramDetails>()}) {
@@ -963,24 +982,25 @@ std::optional<BaseObject> GetBaseObject(const std::optional<A> &x) {
 
 // Like IsAllocatableOrPointer, but accepts pointer function results as being
 // pointers too.
-bool IsAllocatableOrPointerObject(const Expr<SomeType> &, FoldingContext &);
+bool IsAllocatableOrPointerObject(const Expr<SomeType> &);
 
 bool IsAllocatableDesignator(const Expr<SomeType> &);
 
 // Procedure and pointer detection predicates
 bool IsProcedure(const Expr<SomeType> &);
 bool IsFunction(const Expr<SomeType> &);
+bool IsPointer(const Expr<SomeType> &);
 bool IsProcedurePointer(const Expr<SomeType> &);
 bool IsProcedurePointerTarget(const Expr<SomeType> &);
 bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD= or type
 bool IsNullObjectPointer(const Expr<SomeType> &);
 bool IsNullProcedurePointer(const Expr<SomeType> &);
 bool IsNullPointer(const Expr<SomeType> &);
-bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
+bool IsObjectPointer(const Expr<SomeType> &);
 
 // Can Expr be passed as absent to an optional dummy argument.
 // See 15.5.2.12 point 1 for more details.
-bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);
+bool MayBePassedAsAbsentOptional(const Expr<SomeType> &);
 
 // Extracts the chain of symbols from a designator, which has perhaps been
 // wrapped in an Expr<>, removing all of the (co)subscripts.  The
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 8d52eabc16d502b..6daa113abe64255 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -1268,6 +1268,22 @@ std::optional<Procedure> Procedure::Characterize(
   return std::nullopt;
 }
 
+std::optional<Procedure> Procedure::Characterize(
+    const Expr<SomeType> &expr, FoldingContext &context) {
+  if (const auto *procRef{UnwrapProcedureRef(expr)}) {
+    return Characterize(*procRef, context);
+  } else if (const auto *procDesignator{
+                 std::get_if<ProcedureDesignator>(&expr.u)}) {
+    return Characterize(*procDesignator, context);
+  } else if (const Symbol * symbol{UnwrapWholeSymbolOrComponentDataRef(expr)}) {
+    return Characterize(*symbol, context);
+  } else {
+    context.messages().Say(
+        "Expression '%s' is not a procedure"_err_en_US, expr.AsFortran());
+    return std::nullopt;
+  }
+}
+
 std::optional<Procedure> Procedure::FromActuals(const ProcedureDesignator &proc,
     const ActualArguments &args, FoldingContext &context) {
   auto callee{Characterize(proc, context)};
diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp
index 520121ad254de77..e40e3a37df14948 100644
--- a/flang/lib/Evaluate/fold-complex.cpp
+++ b/flang/lib/Evaluate/fold-complex.cpp
@@ -47,7 +47,7 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
           // into a complex constructor so that lowering can deal with the
           // optional aspect (there is no optional aspect with the complex
           // constructor).
-          if (MayBePassedAsAbsentOptional(*args[1]->UnwrapExpr(), context)) {
+          if (MayBePassedAsAbsentOptional(*args[1]->UnwrapExpr())) {
             return Expr<T>{std::move(funcRef)};
           }
         }
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 030e5b2fd2c6d9d..448e9aae6d5403e 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2577,7 +2577,7 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
       arguments[0]) {
     if (Expr<SomeType> * mold{arguments[0]->UnwrapExpr()}) {
       bool isProcPtrTarget{IsProcedurePointerTarget(*mold)};
-      if (isProcPtrTarget || IsAllocatableOrPointerObject(*mold, context)) {
+      if (isProcPtrTarget || IsAllocatableOrPointerObject(*mold)) {
         characteristics::DummyArguments args;
         std::optional<characteristics::FunctionResult> fResult;
         if (isProcPtrTarget) {
@@ -2747,7 +2747,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
     CheckForCoindexedObject(context, arguments[0], "c_loc", "x");
     const auto *expr{arguments[0].value().UnwrapExpr()};
     if (expr &&
-        !(IsObjectPointer(*expr, context) ||
+        !(IsObjectPointer(*expr) ||
             (IsVariable(*expr) && GetLastTarget(GetSymbolVector(*expr))))) {
       context.messages().Say(arguments[0]->sourceLocation(),
           "C_LOC() argument must be a data pointer or target"_err_en_US);
@@ -3094,7 +3094,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
       for (const auto &arg : arguments) {
         if (const auto *expr{arg->UnwrapExpr()}) {
           optionalCount +=
-              Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, context);
+              Fortran::evaluate::MayBePassedAsAbsentOptional(*expr);
         }
       }
       if (arguments.size() - optionalCount > 1) {
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index d2fa5c9b5f36be6..0392adc60adb4e6 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -740,16 +740,25 @@ bool IsFunction(const Expr<SomeType> &expr) {
   return designator && designator->GetType().has_value();
 }
 
+bool IsPointer(const Expr<SomeType> &expr) {
+  return IsObjectPointer(expr) || IsProcedurePointer(expr);
+}
+
 bool IsProcedurePointer(const Expr<SomeType> &expr) {
-  return common::visit(common::visitors{
-                           [](const NullPointer &) { return true; },
-                           [](const ProcedureRef &) { return false; },
-                           [&](const auto &) {
-                             const Symbol *last{GetLastSymbol(expr)};
-                             return last && IsProcedurePointer(*last);
-                           },
-                       },
-      expr.u);
+  if (IsNullProcedurePointer(expr)) {
+    return true;
+  } else if (const auto *funcRef{UnwrapProcedureRef(expr)}) {
+    if (const Symbol * proc{funcRef->proc().GetSymbol()}) {
+      const Symbol *result{FindFunctionResult(*proc)};
+      return result && IsProcedurePointer(*result);
+    } else {
+      return false;
+    }
+  } else if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) {
+    return IsProcedurePointer(proc->GetSymbol());
+  } else {
+    return false;
+  }
 }
 
 bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
@@ -765,23 +774,7 @@ bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
       expr.u);
 }
 
-template <typename A> inline const ProcedureRef *UnwrapProcedureRef(const A &) {
-  return nullptr;
-}
-
-template <typename T>
-inline const ProcedureRef *UnwrapProcedureRef(const FunctionRef<T> &func) {
-  return &func;
-}
-
-template <typename T>
-inline const ProcedureRef *UnwrapProcedureRef(const Expr<T> &expr) {
-  return common::visit(
-      [](const auto &x) { return UnwrapProcedureRef(x); }, expr.u);
-}
-
-// IsObjectPointer()
-bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
+bool IsObjectPointer(const Expr<SomeType> &expr) {
   if (IsNullObjectPointer(expr)) {
     return true;
   } else if (IsProcedurePointerTarget(expr)) {
@@ -795,10 +788,6 @@ bool IsObjectPointer(const Expr<SomeType> &expr, FoldingContext &context) {
   }
 }
 
-const ProcedureRef *GetProcedureRef(const Expr<SomeType> &expr) {
-  return UnwrapProcedureRef(expr);
-}
-
 // IsNullPointer() & variations
 
 template <bool IS_PROC_PTR> struct IsNullPointerHelper {
@@ -872,7 +861,7 @@ bool IsBareNullPointer(const Expr<SomeType> *expr) {
 // GetSymbolVector()
 auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
   if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
-    if (IsVariable(details->expr()) && !GetProcedureRef(*details->expr())) {
+    if (IsVariable(details->expr()) && !UnwrapProcedureRef(*details->expr())) {
       // associate(x => variable that is not a pointer returned by a function)
       return (*this)(details->expr());
     }
@@ -1155,12 +1144,11 @@ std::optional<Expr<SomeType>> DataConstantConversionExtension(
   return std::nullopt;
 }
 
-bool IsAllocatableOrPointerObject(
-    const Expr<SomeType> &expr, FoldingContext &context) {
+bool IsAllocatableOrPointerObject(const Expr<SomeType> &expr) {
   const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
   return (sym &&
              semantics::IsAllocatableOrObjectPointer(&sym->GetUltimate())) ||
-      evaluate::IsObjectPointer(expr, context);
+      evaluate::IsObjectPointer(expr);
 }
 
 bool IsAllocatableDesignator(const Expr<SomeType> &expr) {
@@ -1172,15 +1160,14 @@ bool IsAllocatableDesignator(const Expr<SomeType> &expr) {
   return false;
 }
 
-bool MayBePassedAsAbsentOptional(
-    const Expr<SomeType> &expr, FoldingContext &context) {
+bool MayBePassedAsAbsentOptional(const Expr<SomeType> &expr) {
   const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
   // 15.5.2.12 1. is pretty clear that an unallocated allocatable/pointer actual
   // may be passed to a non-allocatable/non-pointer optional dummy. Note that
   // other compilers (like nag, nvfortran, ifort, gfortran and xlf) seems to
   // ignore this point in intrinsic contexts (e.g CMPLX argument).
   return (sym && semantics::IsOptional(*sym)) ||
-      IsAllocatableOrPointerObject(expr, context);
+      IsAllocatableOrPointerObject(expr);
 }
 
 std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 15915b02aebaa70..fbf8eac642af2a7 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1165,8 +1165,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
         continue;
       }
       if (fir::isPointerType(argTy) &&
-          !Fortran::evaluate::IsObjectPointer(
-              *expr, callContext.converter.getFoldingContext())) {
+          !Fortran::evaluate::IsObjectPointer(*expr)) {
         // Passing a non POINTER actual argument to a POINTER dummy argument.
         // Create a pointer of the dummy argument type and assign the actual
         // argument to it.
@@ -1814,13 +1813,11 @@ genIsPresentIfArgMaybeAbsent(mlir::Location loc, hlfir::Entity actual,
                              const Fortran::lower::SomeExpr &expr,
                              CallContext &callContext,
                              bool passAsAllocatableOrPointer) {
-  if (!Fortran::evaluate::MayBePassedAsAbsentOptional(
-          expr, callContext.converter.getFoldingContext()))
+  if (!Fortran::evaluate::MayBePassedAsAbsentOptional(expr))
     return std::nullopt;
   fir::FirOpBuilder &builder = callContext.getBuilder();
   if (!passAsAllocatableOrPointer &&
-      Fortran::evaluate::IsAllocatableOrPointerObject(
-          expr, callContext.converter.getFoldingContext())) {
+      Fortran::evaluate::IsAllocatableOrPointerObject(expr)) {
     // Passing Allocatable/Pointer to non-pointer/non-allocatable OPTIONAL.
     // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated, it is
     // as if the argument was absent. The main care here is to not do a
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index a9298be5532d905..26519d204460c67 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1782,8 +1782,7 @@ class ScalarExprLowering {
   /// Helper to lower intrinsic arguments for inquiry intrinsic.
   ExtValue
   lowerIntrinsicArgumentAsInquired(const Fortran::lower::SomeExpr &expr) {
-    if (Fortran::evaluate::IsAllocatableOrPointerObject(
-            expr, converter.getFoldingContext()))
+    if (Fortran::evaluate::IsAllocatableOrPointerObject(expr))
       return genMutableBoxValue(expr);
     /// Do not create temps for array sections whose properties only need to be
     /// inquired: create a descriptor that will be inquired.
@@ -1918,8 +1917,7 @@ class ScalarExprLowering {
       fir::ArgLoweringRule argRules =
           fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
       if (argRules.handleDynamicOptional &&
-          Fortran::evaluate::MayBePassedAsAbsentOptional(
-              *expr, converter.getFoldingContext())) {
+          Fortran::evaluate::MayBePassedAsAbsentOptional(*expr)) {
         ExtValue optional = lowerIntrinsicArgumentAsInquired(*expr);
         mlir::Value isPresent = genActualIsPresentTest(builder, loc, optional);
         switch (argRules.lowerAs) {
@@ -2392,8 +2390,7 @@ class ScalarExprLowering {
   std::pair<ExtValue, mlir::Value>
   prepareActualThatMayBeAbsent(const Fortran::lower::SomeExpr &expr) {
     mlir::Location loc = getLoc();
-    if (Fortran::evaluate::IsAllocatableOrPointerObject(
-            expr, converter.getFoldingContext())) {
+    if (Fortran::evaluate::IsAllocatableOrPointerObject(expr)) {
       // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated,
       // it is as if the argument was absent. The main care here is to
       // not do a copy-in/copy-out because the temp address, even though
@@ -2496,8 +2493,8 @@ class ScalarExprLowering {
         // not passed.
         return {genTempExtAddr(expr), std::nullopt};
       ExtValue baseAddr;
-      if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
-                                  expr, converter.getFoldingContext())) {
+      if (arg.isOptional() &&
+          Fortran::evaluate::MayBePassedAsAbsentOptional(expr)) {
         auto [actualArgBind, isPresent] = prepareActualThatMayBeAbsent(expr);
         const ExtValue &actualArg = actualArgBind;
         if (!needsCopy)
@@ -2631,8 +2628,7 @@ class ScalarExprLowering {
           continue;
         }
         if (fir::isPointerType(argTy) &&
-            !Fortran::evaluate::IsObjectPointer(
-                *expr, converter.getFoldingContext())) {
+            !Fortran::evaluate::IsObjectPointer(*expr)) {
           // Passing a non POINTER actual argument to a POINTER dummy argument.
           // Create a pointer of the dummy argument type and assign the actual
           // argument to it.
@@ -2759,8 +2755,7 @@ class ScalarExprLowering {
           }
 
         } else if (arg.isOptional() &&
-                   Fortran::evaluate::IsAllocatableOrPointerObject(
-                       *expr, converter.getFoldingContext())) {
+                   Fortran::evaluate::IsAllocatableOrPointerObject(*expr)) {
           // Before lowering to an address, handle the allocatable/pointer
           // actual argument to optional fir.box dummy. It is legal to pass
           // unallocated/disassociated entity to an optional. In this case, an
@@ -3355,8 +3350,7 @@ class ArrayExprLowering {
     setPointerAssignmentBounds(lbounds, ubounds);
     if (rhs.Rank() == 0 ||
         (Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(rhs) &&
-         Fortran::evaluate::IsAllocatableOrPointerObject(
-             rhs, converter.getFoldingContext()))) {
+         Fortran::evaluate::IsAllocatableOrPointerObject(rhs))) {
       lowerScalarAssignment(lhs, rhs);
       return;
     }
@@ -4684,8 +4678,7 @@ class ArrayExprLowering {
         fir::ArgLoweringRule argRules =
             fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
         if (argRules.handleDynamicOptional &&
-            Fortran::evaluate::MayBePassedAsAbsentOptional(
-                *expr, converter.getFoldingContext())) {
+            Fortran::evaluate::MayBePassedAsAbsentOptional(*expr)) {
           // Currently, there is not elemental intrinsic that requires lowering
           // a potentially absent argument to something else than a value (apart
           // from character MAX/MIN that are handled elsewhere.)
@@ -4768,8 +4761,8 @@ class ArrayExprLowering {
       LLVM_DEBUG(expr->AsFortran(llvm::dbgs()
                                  << "argument: " << arg.firArgument << " = [")
                  << "]\n");
-      if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
-                                  *expr, converter.getFoldingContext()))
+      if (arg.isOptional() &&
+          Fortran::evaluate::MayBePassedAsAbsentOptional(*expr))
         TODO(loc,
              "passing dynamically optional argument to elemental procedures");
       switch (arg.passBy) {
@@ -5925,8 +5918,8 @@ class ArrayExprLowering {
         fir::valueHasFirAttribute(base, fir::getOptionalAttrName());
     mlir::Type baseType = fir::unwrapRefType(base.getType());
     const bool isBox = baseType.isa<fir::BoxType>();
-    const bool isAllocOrPtr = Fortran::evaluate::IsAllocatableOrPointerObject(
-        expr, converter.getFoldingContext());
+    const bool isAllocOrPtr =
+        Fortran::evaluate::IsAllocatableOrPointerObject(expr);
     mlir::Type arrType = fir::unwrapPassByRefType(baseType);
     mlir::Type eleType = fir::unwrapSequenceType(arrType);
     ExtValue exv = optionalArg;
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 03a7cca1ab69817..eeba4e94ac5a44d 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -251,7 +251,7 @@ mlir::Value Fortran::lower::genInitialDataTarget(
   // type. The return box is correctly created as a fir.box<fir.ptr<T>> where
   // T is extracted from the MOLD argument.
   if (const Fortran::evaluate::ProcedureRef *procRef =
-          Fortran::evaluate::GetProcedureRef(initialTarget)) {
+          Fortran::evaluate::UnwrapProcedureRef(initialTarget)) {
     const Fortran::evaluate::SpecificIntrinsic *intrinsic =
         procRef->proc().GetSpecificIntrinsic();
     if (intrinsic && intrinsic->name == "null") {
diff --git a/flang/lib/Lower/CustomIntrinsicCall.cpp b/flang/lib/Lower/CustomIntrinsicCall.cpp
index 9cf93785d240e2e..439fc3d915b4e42 100644
--- a/flang/lib/Lower/CustomIntrinsicCall.cpp
+++ b/flang/lib/Lower/CustomIntrinsicCall.cpp
@@ -24,8 +24,7 @@
 /// runtime? This is a special case because MIN and MAX can have any number of
 /// arguments.
 static bool isMinOrMaxWithDynamicallyOptionalArg(
-    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContext) {
+    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {
   if (name != "min" && name != "max")
     return false;
   const auto &args = procRef.arguments();
@@ -35,7 +34,7 @@ static bool isMinOrMaxWithDynamicallyOptionalArg(
   for (std::size_t i = 2; i < argSize; ++i) {
     if (auto *expr =
             Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(args[i]))
-      if (Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContext))
+      if (Fortran::evaluate::MayBePassedAsAbsentOptional(*expr))
         return true;
   }
   return false;
@@ -45,14 +44,12 @@ static bool isMinOrMaxWithDynamicallyOptionalArg(
 /// at runtime? This is a special case because the SIZE value to be applied
 /// when absent is not zero.
 static bool isIshftcWithDynamicallyOptionalArg(
-    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContext) {
+    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {
   if (name != "ishftc" || procRef.arguments().size() < 3)
     return false;
   auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(
       procRef.arguments()[2]);
-  return expr &&
-         Fortran::evaluate::MayBePassedAsAbsentOptional(*expr, foldingContext);
+  return expr && Fortran::evaluate::MayBePassedAsAbsentOptional(*expr);
 }
 
 /// Is this a call to ASSOCIATED where the TARGET is an OPTIONAL (but not a
@@ -67,8 +64,7 @@ static bool isIshftcWithDynamicallyOptionalArg(
 /// TARGET that are OPTIONAL get conditionally emboxed here to convey the
 /// optional aspect to the runtime.
 static bool isAssociatedWithDynamicallyOptionalArg(
-    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef,
-    Fortran::evaluate::FoldingContext &foldingContext) {
+    llvm::StringRef name, const Fortran::evaluate::ProcedureRef &procRef) {
   if (name != "associated" || procRef.arguments().size() < 2)
     return false;
   auto *expr = Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(
@@ -84,10 +80,9 @@ bool Fortran::lower::intrinsicRequiresCustomOptionalHandling(
     const Fortran::evaluate::SpecificIntrinsic &intrinsic,
     AbstractConverter &converter) {
   llvm::StringRef name = intrinsic.name;
-  Fortran::evaluate::FoldingContext &fldCtx = converter.getFoldingContext();
-  return isMinOrMaxWithDynamicallyOptionalArg(name, procRef, fldCtx) ||
-         isIshftcWithDynamicallyOptionalArg(name, procRef, fldCtx) ||
-         isAssociatedWithDynamicallyOptionalArg(name, procRef, fldCtx);
+  return isMinOrMaxWithDynamicallyOptionalArg(name, procRef) ||
+         isIshftcWithDynamicallyOptionalArg(name, procRef) ||
+         isAssociatedWithDynamicallyOptionalArg(name, procRef);
 }
 
 /// Generate the FIR+MLIR operations for the generic intrinsic \p name
@@ -130,8 +125,8 @@ static void prepareMinOrMaxArguments(
         Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
     if (!expr)
       continue;
-    if (arg.index() <= 1 || !Fortran::evaluate::MayBePassedAsAbsentOptional(
-                                *expr, converter.getFoldingContext())) {
+    if (arg.index() <= 1 ||
+        !Fortran::evaluate::MayBePassedAsAbsentOptional(*expr)) {
       // Non optional arguments.
       prepareOtherArgument(*expr, fir::LowerIntrinsicArgAs::Value);
     } else {
@@ -204,8 +199,7 @@ static void prepareIshftcArguments(
         Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
     assert(expr && "expected all ISHFTC argument to be textually present here");
     if (arg.index() == 2) {
-      assert(Fortran::evaluate::MayBePassedAsAbsentOptional(
-                 *expr, converter.getFoldingContext()) &&
+      assert(Fortran::evaluate::MayBePassedAsAbsentOptional(*expr) &&
              "expected ISHFTC SIZE arg to be dynamically optional");
       prepareOptionalArgument(*expr);
     } else {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c48c382218dc9bb..ec68001bb8a2f80 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -461,7 +461,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           ? actualLastSymbol->detailsIf<ObjectEntityDetails>()
           : nullptr};
   int actualRank{actualType.Rank()};
-  bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
+  bool actualIsPointer{evaluate::IsObjectPointer(actual)};
   bool dummyIsAssumedRank{dummy.type.attrs().test(
       characteristics::TypeAndShape::Attr::AssumedRank)};
   if (dummy.type.attrs().test(
@@ -992,7 +992,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
         // 15.5.2.9(5) -- dummy procedure POINTER
         // Interface compatibility has already been checked above
         messages.Say(
-            "Actual argument associated with procedure pointer %s must be a POINTER unless INTENT(IN)"_err_en_US,
+            "Actual argument associated with procedure pointer %s must be a pointer unless INTENT(IN)"_err_en_US,
             dummyName);
       }
     }
@@ -1243,12 +1243,9 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
   }
   if (const auto &pointerArg{arguments[0]}) {
     if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
-      const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)};
-      if (pointerSymbol && !IsPointer(pointerSymbol->GetUltimate())) {
-        evaluate::AttachDeclaration(
-            context.messages().Say(pointerArg->sourceLocation(),
-                "POINTER= argument of ASSOCIATED() must be a POINTER"_err_en_US),
-            *pointerSymbol);
+      if (!IsPointer(*pointerExpr)) {
+        context.messages().Say(pointerArg->sourceLocation(),
+            "POINTER= argument of ASSOCIATED() must be a pointer"_err_en_US);
         return;
       }
       if (const auto &targetArg{arguments[1]}) {
@@ -1261,7 +1258,7 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
             !evaluate::IsProcedurePointer(*pointerExpr)) {
           context.messages().Say(pointerArg->sourceLocation(),
               "POINTER= argument of ASSOCIATED() should be a pointer"_port_en_US);
-        } else if (scope) {
+        } else if (scope && !evaluate::UnwrapProcedureRef(*pointerExpr)) {
           if (auto whyNot{WhyNotDefinable(pointerArg->sourceLocation().value_or(
                                               context.messages().at()),
                   *scope,
@@ -1273,59 +1270,37 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
             }
           }
         }
-        if (const auto *targetExpr{targetArg->UnwrapExpr()};
-            targetExpr && pointerSymbol) {
-          if (IsProcedure(*pointerSymbol)) {
+        if (const auto *targetExpr{targetArg->UnwrapExpr()}) {
+          if (IsProcedurePointer(*pointerExpr) &&
+              !IsBareNullPointer(pointerExpr)) { // POINTER= is a procedure
             if (auto pointerProc{characteristics::Procedure::Characterize(
-                    *pointerSymbol, context)}) {
-              // Characterize the target procedure
-              std::optional<characteristics::Procedure> targetProc;
-              const auto *targetProcDesignator{
-                  evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(
-                      *targetExpr)};
-              bool isCall{false};
-              std::string targetName;
-              if (IsProcedure(*targetExpr) ||
-                  IsNullProcedurePointer(*targetExpr)) {
-                if (const auto *targetProcRef{
-                        std::get_if<evaluate::ProcedureRef>(&targetExpr->u)}) {
-                  // target is a function call returning a procedure pointer
-                  targetProc = characteristics::Procedure::Characterize(
-                      *targetProcRef, context);
-                  isCall = true;
-                  targetName = targetProcRef->proc().GetName() + "()";
-                } else if (targetProcDesignator) {
-                  targetProc = characteristics::Procedure::Characterize(
-                      *targetProcDesignator, context);
-                  targetName = targetProcDesignator->GetName();
-                } else if (const Symbol * targSym{GetLastSymbol(*targetExpr)}) {
-                  targetProc = characteristics::Procedure::Characterize(
-                      *targSym, context);
-                  targetName = targSym->name().ToString();
-                }
-              }
-              if (targetProc) {
-                std::string whyNot;
-                const evaluate::SpecificIntrinsic *specificIntrinsic{
-                    targetProcDesignator
-                        ? targetProcDesignator->GetSpecificIntrinsic()
-                        : nullptr};
-                if (std::optional<parser::MessageFixedText> msg{
-                        CheckProcCompatibility(isCall, pointerProc,
-                            &*targetProc, specificIntrinsic, whyNot)}) {
-                  msg->set_severity(parser::Severity::Warning);
-                  evaluate::AttachDeclaration(
-                      context.messages().Say(std::move(*msg),
-                          "pointer '" + pointerSymbol->name().ToString() + "'",
-                          targetName, whyNot),
-                      *pointerSymbol);
+                    *pointerExpr, context)}) {
+              if (IsBareNullPointer(targetExpr)) {
+              } else if (IsProcedurePointerTarget(*targetExpr)) {
+                if (auto targetProc{characteristics::Procedure::Characterize(
+                        *targetExpr, context)}) {
+                  bool isCall{!!UnwrapProcedureRef(*targetExpr)};
+                  std::string whyNot;
+                  const auto *targetProcDesignator{
+                      evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(
+                          *targetExpr)};
+                  const evaluate::SpecificIntrinsic *specificIntrinsic{
+                      targetProcDesignator
+                          ? targetProcDesignator->GetSpecificIntrinsic()
+                          : nullptr};
+                  if (std::optional<parser::MessageFixedText> msg{
+                          CheckProcCompatibility(isCall, pointerProc,
+                              &*targetProc, specificIntrinsic, whyNot)}) {
+                    msg->set_severity(parser::Severity::Warning);
+                    context.messages().Say(std::move(*msg),
+                        "pointer '" + pointerExpr->AsFortran() + "'",
+                        targetExpr->AsFortran(), whyNot);
+                  }
                 }
               } else if (!IsNullProcedurePointer(*targetExpr)) {
-                evaluate::AttachDeclaration(
-                    context.messages().Say(
-                        "POINTER= argument '%s' is a procedure pointer but the TARGET= argument '%s' is not a procedure or procedure pointer"_err_en_US,
-                        pointerSymbol->name(), targetExpr->AsFortran()),
-                    *pointerSymbol);
+                context.messages().Say(
+                    "POINTER= argument '%s' is a procedure pointer but the TARGET= argument '%s' is not a procedure or procedure pointer"_err_en_US,
+                    pointerExpr->AsFortran(), targetExpr->AsFortran());
               }
             }
           } else if (IsVariable(*targetExpr) || IsNullPointer(*targetExpr)) {
@@ -1353,11 +1328,9 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
               }
             }
           } else {
-            evaluate::AttachDeclaration(
-                context.messages().Say(
-                    "POINTER= argument '%s' is an object pointer but the TARGET= argument '%s' is not a variable"_err_en_US,
-                    pointerSymbol->name(), targetExpr->AsFortran()),
-                *pointerSymbol);
+            context.messages().Say(
+                "POINTER= argument '%s' is an object pointer but the TARGET= argument '%s' is not a variable"_err_en_US,
+                pointerExpr->AsFortran(), targetExpr->AsFortran());
           }
         }
       }
@@ -1368,7 +1341,7 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
   }
   if (!ok) {
     context.messages().Say(
-        "Arguments of ASSOCIATED() must be a POINTER and an optional valid target"_err_en_US);
+        "Arguments of ASSOCIATED() must be a pointer and an optional valid target"_err_en_US);
   }
 }
 
diff --git a/flang/test/Semantics/associate01.f90 b/flang/test/Semantics/associate01.f90
index 6f8e52077990e23..deafea695e84f24 100644
--- a/flang/test/Semantics/associate01.f90
+++ b/flang/test/Semantics/associate01.f90
@@ -23,24 +23,24 @@ subroutine test
     integer, pointer :: ip
     associate (sel => iptr(itarget))
       ip => sel
-      !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+      !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
       if (.not. associated(sel)) stop
     end associate
     associate (sel => tv%iptr(itarget))
       ip => sel
-      !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+      !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
       if (.not. associated(sel)) stop
     end associate
     associate (sel => (iptr(itarget)))
       !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
       ip => sel
-      !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+      !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
       if (.not. associated(sel)) stop
     end associate
     associate (sel => 0 + iptr(itarget))
       !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
       ip => sel
-      !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+      !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
       if (.not. associated(sel)) stop
     end associate
   end subroutine
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 7229f8ad4ece09b..1737970ac3988d0 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -20,7 +20,7 @@ integer function abstractIntFunc(x)
     type(t1), pointer :: t1ptr(:)
   end type t2
 
-  contains
+ contains
   integer function intFunc(x)
     integer, intent(in) :: x
     intFunc = x
@@ -48,6 +48,17 @@ subroutine subrCannotBeCalledfromImplicit(i)
     integer :: i(:)
   end subroutine subrCannotBeCalledfromImplicit
 
+  function objPtrFunc(x)
+    integer, target :: x
+    integer, pointer :: objPtrFunc
+    objPtrFunc => x
+  end
+
+  function procPtrFunc
+    procedure(intFunc), pointer :: procPtrFunc
+    procPtrFunc => intFunc
+  end
+
   subroutine test(assumedRank)
     real, pointer, intent(in out) :: assumedRank(..)
     integer :: intVar
@@ -116,16 +127,16 @@ subroutine test(assumedRank)
     lVar = associated(null(), null(intPointerVar1)) !OK
     !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
     lVar = associated(null(intPointerVar1), null()) !OK
-    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+    !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
     lVar = associated(intVar)
-    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+    !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
     lVar = associated(intVar, intVar)
-    !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
+    !ERROR: POINTER= argument of ASSOCIATED() must be a pointer
     lVar = associated(intAllocVar)
-    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
+    !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target
     lVar = associated(intPointerVar1, targetRealVar)
     lVar = associated(intPointerVar1, targetIntVar1) !OK
-    !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
+    !ERROR: Arguments of ASSOCIATED() must be a pointer and an optional valid target
     lVar = associated(intPointerVar1, targetIntVar2)
     lVar = associated(intPointerVar1) !OK
     lVar = associated(intPointerVar1, intPointerVar2) !OK
@@ -157,10 +168,30 @@ subroutine test(assumedRank)
     intProcPointer1 => null(intProcPointer2) ! ok
     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
     intProcPointer1 =>null() ! ok
-    lvar = associated(intProcPointer1, null()) ! ok
+    lvar = associated(intProcPointer1, null())
     intPointerVar1 => null(intPointerVar1) ! ok
     lvar = associated (intPointerVar1, null(intPointerVar1)) ! ok
 
+    ! Functions (other than NULL) returning pointers
+    lVar = associated(objPtrFunc(targetIntVar1)) ! ok
+    !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
+    lVar = associated(objPtrFunc(targetIntVar1), targetIntVar1) ! ok
+    !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
+    lVar = associated(objPtrFunc(targetIntVar1), objPtrFunc(targetIntVar1)) ! ok
+    lVar = associated(procPtrFunc()) ! ok
+    lVar = associated(procPtrFunc(), intFunc) ! ok
+    lVar = associated(procPtrFunc(), procPtrFunc()) ! ok
+    !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'intfunc' is not a variable
+    !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
+    lVar = associated(objPtrFunc(targetIntVar1), intFunc)
+    !ERROR: POINTER= argument 'objptrfunc(targetintvar1)' is an object pointer but the TARGET= argument 'procptrfunc()' is not a variable
+    !PORTABILITY: POINTER= argument of ASSOCIATED() should be a pointer
+    lVar = associated(objPtrFunc(targetIntVar1), procPtrFunc())
+    !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'objptrfunc(targetintvar1)' is not a procedure or procedure pointer
+    lVar = associated(procPtrFunc(), objPtrFunc(targetIntVar1))
+    !ERROR: POINTER= argument 'procptrfunc()' is a procedure pointer but the TARGET= argument 'targetintvar1' is not a procedure or procedure pointer
+    lVar = associated(procPtrFunc(), targetIntVar1)
+
     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer
     intprocPointer1 => intVar
     !ERROR: POINTER= argument 'intprocpointer1' is a procedure pointer but the TARGET= argument 'intvar' is not a procedure or procedure pointer
@@ -180,7 +211,7 @@ subroutine test(assumedRank)
     lvar = associated (intProcPointer1, targetIntVar1)
     !ERROR: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null' that is an incompatible procedure pointer: function results have distinct types: INTEGER(4) vs REAL(4)
     intProcPointer1 => null(mold=realProcPointer1)
-    !WARNING: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null()' that is an incompatible procedure pointer: function results have distinct types: INTEGER(4) vs REAL(4)
+    !WARNING: Procedure pointer 'intprocpointer1' associated with result of reference to function 'null(mold=realprocpointer1)' that is an incompatible procedure pointer: function results have distinct types: INTEGER(4) vs REAL(4)
     lvar = associated(intProcPointer1, null(mold=realProcPointer1))
     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
     pureFuncPointer => intProc
diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index 463f03bc62ff489..0c28e391c937007 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -82,27 +82,27 @@ subroutine test1 ! 15.5.2.9(5)
     call s01(null(intPtr))
     !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
     call s01(B"0101")
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02(realfunc)
     call s02(p) ! ok
     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
     call s02(ip)
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02(procptr())
     call s02(null()) ! ok
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s05(null())
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02(sin)
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02b(realfunc)
     call s02b(p) ! ok
     !ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
     call s02b(ip)
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02b(procptr())
     call s02b(null())
-    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
     call s02b(sin)
   end subroutine
 
diff --git a/flang/test/Semantics/call24.f90 b/flang/test/Semantics/call24.f90
index 7d2ba9ff80d4018..5fbb441908167f8 100644
--- a/flang/test/Semantics/call24.f90
+++ b/flang/test/Semantics/call24.f90
@@ -36,7 +36,7 @@ subroutine test()
 
   !ERROR: References to the procedure 'bar' require an explicit interface
   !WARNING: If the procedure's interface were explicit, this reference would be in error
-  !BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' must be a POINTER unless INTENT(IN)
+  !BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' must be a pointer unless INTENT(IN)
   call bar(sin)
 
   !ERROR: References to the procedure 'baz' require an explicit interface



More information about the flang-commits mailing list