[flang] Portability warnings for an ambiguous ASSOCIATED() case

[klausler]

Summary

The standard's specification for the ASSOCIATED() intrinsic function
describes its optional second argument (TARGET=) as being required
to be a valid target for a pointer assignment statement in which the
first argument (POINTER=) was the left-hand side. Some Fortran compilers
apparently interpret this text as a requirement that the POINTER= argument
actually be a valid left-hand side to a pointer assignment statement,
and emit an error if it is not so. This particularly affects the
use of an explicit NULL pointer as the first argument.

Such usage is well-defined, benign, useful, and supported by at least
two other compilers, so we should continue to accept it. This patch
adds a portability warning and some documentation.

In order to implement the portability warning in the best way, the
special checks on calls to the ASSOCIATED() intrinsic function have
been moved from intrinsic processing to Semantics/check-calls.cpp,
whence they have access to semantics' toolchest. Special checks for
other intrinsic functions might also migrate in the future in order
to keep them all in one place.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Extensions.md

   scope, with a portability warning, since that global name is not actually
   capable of being "used" in its scope.
 
+* In the definition of the `ASSOCIATED` intrinsic function (16.9.16), its optional
+  second argument `TARGET=` is required to be "allowable as the data-target or
+  proc-target in a pointer assignment statement (10.2.2) in which POINTER is
+  data-pointer-object or proc-pointer-object."  Some Fortran compilers
+  interpret this to require that the first argument (`POINTER=`) be a valid
+  left-hand side for a pointer assignment statement -- in particular, it
+  cannot be `NULL()`, but also it is required to be modifiable.
+  As there is  no good reason to disallow (say) an `INTENT(IN)` pointer here,
+  or even `NULL()` as a well-defined case that is always `.FALSE.`,
+  this compiler doesn't require the `POINTER=` argument to be a valid
+  left-hand side for a pointer assignment statement, and we emit a
+  portability warning when it is not.
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the

flang/include/flang/Evaluate/tools.h

 // Procedure and pointer detection predicates
 bool IsProcedure(const Expr<SomeType> &);
 bool IsFunction(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> &);

flang/lib/Evaluate/intrinsics.cpp

   }
 }
 
-static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
-  bool ok{true};
-  if (const auto &pointerArg{call.arguments[0]}) {
-    if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
-      if (const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)}) {
-        if (!pointerSymbol->attrs().test(semantics::Attr::POINTER)) {
-          AttachDeclaration(context.messages().Say(pointerArg->sourceLocation(),
-                                "POINTER= argument of ASSOCIATED() must be a "
-                                "POINTER"_err_en_US),
-              *pointerSymbol);
-        } else {
-          if (const auto &targetArg{call.arguments[1]}) {
-            if (const auto *targetExpr{targetArg->UnwrapExpr()}) {
-              std::optional<characteristics::Procedure> pointerProc, targetProc;
-              const auto *targetProcDesignator{
-                  UnwrapExpr<ProcedureDesignator>(*targetExpr)};
-              const Symbol *targetSymbol{GetLastSymbol(*targetExpr)};
-              bool isCall{false};
-              std::string targetName;
-              if (const auto *targetProcRef{// target is a function call
-                      std::get_if<ProcedureRef>(&targetExpr->u)}) {
-                if (auto targetRefedChars{
-                        characteristics::Procedure::Characterize(
-                            *targetProcRef, context)}) {
-                  targetProc = *targetRefedChars;
-                  targetName = targetProcRef->proc().GetName() + "()";
-                  isCall = true;
-                }
-              } else if (targetProcDesignator) {
-                targetProc = characteristics::Procedure::Characterize(
-                    *targetProcDesignator, context);
-                targetName = targetProcDesignator->GetName();
-              } else if (targetSymbol) {
-                if (IsProcedure(*targetSymbol)) {
-                  // proc that's not a call
-                  targetProc = characteristics::Procedure::Characterize(
-                      *targetSymbol, context);
-                }
-                targetName = targetSymbol->name().ToString();
-              }
-              if (IsProcedure(*pointerSymbol)) {
-                pointerProc = characteristics::Procedure::Characterize(
-                    *pointerSymbol, context);
-              }
-              if (pointerProc) {
-                if (targetProc) {
-                  // procedure pointer and procedure target
-                  std::string whyNot;
-                  const SpecificIntrinsic *specificIntrinsic{nullptr};
-                  if (targetProcDesignator) {
-                    specificIntrinsic =
-                        targetProcDesignator->GetSpecificIntrinsic();
-                  }
-                  if (std::optional<parser::MessageFixedText> msg{
-                          CheckProcCompatibility(isCall, pointerProc,
-                              &*targetProc, specificIntrinsic, whyNot)}) {
-                    msg->set_severity(parser::Severity::Warning);
-                    AttachDeclaration(
-                        context.messages().Say(std::move(*msg),
-                            "pointer '" + pointerSymbol->name().ToString() +
-                                "'",
-                            targetName, whyNot),
-                        *pointerSymbol);
-                  }
-                } else if (!IsNullProcedurePointer(*targetExpr)) {
-                  // procedure pointer and object target
-                  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(), targetName),
-                      *pointerSymbol);
-                }
-              } else if (targetProc) {
-                // object pointer and procedure target
-                AttachDeclaration(
-                    context.messages().Say(
-                        "POINTER= argument '%s' is an object pointer "
-                        "but the TARGET= argument '%s' is a "
-                        "procedure designator"_err_en_US,
-                        pointerSymbol->name(), targetName),
-                    *pointerSymbol);
-              } else if (targetSymbol) {
-                // object pointer and target
-                SymbolVector symbols{GetSymbolVector(*targetExpr)};
-                CHECK(!symbols.empty());
-                if (!GetLastTarget(symbols)) {
-                  parser::Message *msg{context.messages().Say(
-                      targetArg->sourceLocation(),
-                      "TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
-                      targetExpr->AsFortran())};
-                  for (SymbolRef ref : symbols) {
-                    msg = AttachDeclaration(msg, *ref);
-                  }
-                } else if (HasVectorSubscript(*targetExpr) ||
-                    ExtractCoarrayRef(*targetExpr)) {
-                  context.messages().Say(targetArg->sourceLocation(),
-                      "TARGET= argument '%s' may not have a vector subscript or coindexing"_err_en_US,
-                      targetExpr->AsFortran());
-                }
-                if (const auto pointerType{pointerArg->GetType()}) {
-                  if (const auto targetType{targetArg->GetType()}) {
-                    ok = pointerType->IsTkCompatibleWith(*targetType);
-                  }
-                }
-              }
-            }
-          }
-        }
-      }
-    }
-  } else {
-    // No arguments to ASSOCIATED()
-    ok = false;
-  }
-  if (!ok) {
-    context.messages().Say(
-        "Arguments of ASSOCIATED() must be a POINTER and an optional valid target"_err_en_US);
-  }
-  return ok;
-}
-
 static bool CheckForNonPositiveValues(FoldingContext &context,
     const ActualArgument &arg, const std::string &procName,
     const std::string &argName) {

 }
 
 // Applies any semantic checks peculiar to an intrinsic.
+// TODO: Move the rest of these checks to Semantics/check-call.cpp, which is
+// where ASSOCIATED() is now validated.
 static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
   bool ok{true};
   const std::string &name{call.specificIntrinsic.name};

           "Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
     }
   } else if (name == "associated") {
-    return CheckAssociated(call, context);
+    // Now handled in Semantics/check-call.cpp
   } else if (name == "atomic_and" || name == "atomic_or" ||
       name == "atomic_xor") {
     return CheckForCoindexedObject(context, call.arguments[2], name, "stat");

flang/lib/Evaluate/tools.cpp

   return designator && designator->GetType().has_value();
 }
 
+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);
+}
+
 bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
   return common::visit(common::visitors{
                            [](const NullPointer &) { return true; },

flang/lib/Semantics/check-call.h

     bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic);
 
-// Checks actual arguments against a procedure with an explicit interface.
-// Reports a buffer of errors when not compatible.
-parser::Messages CheckExplicitInterface(
-    const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
-    const evaluate::FoldingContext &, const Scope &,
-    const evaluate::SpecificIntrinsic *intrinsic);
-
 // Checks actual arguments for the purpose of resolving a generic interface.
 bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
     evaluate::ActualArguments &, const evaluate::FoldingContext &,

flang/lib/Semantics/check-call.cpp

   return true;
 }
 
+// ASSOCIATED (16.9.16)
+static void CheckAssociated(evaluate::ActualArguments &arguments,
+    evaluate::FoldingContext &context, const Scope *scope) {
+  bool ok{true};
+  if (arguments.size() < 2) {
+    return;
+  }
+  if (const auto &pointerArg{arguments[0]}) {
+    if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
+      const Symbol *pointerSymbol{GetLastSymbol(*pointerExpr)};
+      if (pointerSymbol && !IsPointer(*pointerSymbol)) {
+        evaluate::AttachDeclaration(
+            context.messages().Say(pointerArg->sourceLocation(),
+                "POINTER= argument of ASSOCIATED() must be a POINTER"_err_en_US),
+            *pointerSymbol);
+        return;
+      }
+      if (const auto &targetArg{arguments[1]}) {
+        // The standard requires that the POINTER= argument be a valid LHS for
+        // a pointer assignment when the TARGET= argument is present.  This,
+        // perhaps unintentionally, excludes function results, including NULL(),
+        // from being used there, as well as INTENT(IN) dummy pointers.
+        // Allow this usage as a benign extension with a portability warning.
+        if (!evaluate::ExtractDataRef(*pointerExpr) &&
+            !evaluate::IsProcedurePointer(*pointerExpr)) {
+          context.messages().Say(pointerArg->sourceLocation(),
+              "POINTER= argument of ASSOCIATED() should be a pointer"_port_en_US);
+        } else if (scope) {
+          if (auto whyNot{WhyNotDefinable(pointerArg->sourceLocation().value_or(
+                                              context.messages().at()),
+                  *scope,
+                  DefinabilityFlags{DefinabilityFlag::PointerDefinition},
+                  *pointerExpr)}) {
+            if (auto *msg{context.messages().Say(pointerArg->sourceLocation(),
+                    "POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement"_port_en_US)}) {
+              msg->Attach(std::move(*whyNot));
+            }
+          }
+        }
+        const auto *targetExpr{targetArg->UnwrapExpr()};
+        if (targetExpr && pointerSymbol) {
+          std::optional<characteristics::Procedure> pointerProc, targetProc;
+          const auto *targetProcDesignator{
+              evaluate::UnwrapExpr<evaluate::ProcedureDesignator>(*targetExpr)};
+          const Symbol *targetSymbol{GetLastSymbol(*targetExpr)};
+          bool isCall{false};
+          std::string targetName;
+          if (const auto *targetProcRef{// target is a function call
+                  std::get_if<evaluate::ProcedureRef>(&targetExpr->u)}) {
+            if (auto targetRefedChars{characteristics::Procedure::Characterize(
+                    *targetProcRef, context)}) {
+              targetProc = *targetRefedChars;
+              targetName = targetProcRef->proc().GetName() + "()";
+              isCall = true;
+            }
+          } else if (targetProcDesignator) {
+            targetProc = characteristics::Procedure::Characterize(
+                *targetProcDesignator, context);
+            targetName = targetProcDesignator->GetName();
+          } else if (targetSymbol) {
+            if (IsProcedure(*targetSymbol)) {
+              // proc that's not a call
+              targetProc = characteristics::Procedure::Characterize(
+                  *targetSymbol, context);
+            }
+            targetName = targetSymbol->name().ToString();
+          }
+          if (pointerSymbol && IsProcedure(*pointerSymbol)) {
+            pointerProc = characteristics::Procedure::Characterize(
+                *pointerSymbol, context);
+          }
+          if (pointerProc) {
+            if (targetProc) {
+              // procedure pointer and procedure target
+              std::string whyNot;
+              const evaluate::SpecificIntrinsic *specificIntrinsic{nullptr};
+              if (targetProcDesignator) {
+                specificIntrinsic =
+                    targetProcDesignator->GetSpecificIntrinsic();
+              }
+              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);
+              }
+            } else if (!IsNullProcedurePointer(*targetExpr)) {
+              // procedure pointer and object target
+              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(), targetName),
+                  *pointerSymbol);
+            }
+          } else if (targetProc) {
+            // object pointer and procedure target
+            evaluate::AttachDeclaration(
+                context.messages().Say(
+                    "POINTER= argument '%s' is an object pointer but the TARGET= argument '%s' is a procedure designator"_err_en_US,
+                    pointerSymbol->name(), targetName),
+                *pointerSymbol);
+          } else if (targetSymbol) {
+            // object pointer and target
+            SymbolVector symbols{GetSymbolVector(*targetExpr)};
+            CHECK(!symbols.empty());
+            if (!evaluate::GetLastTarget(symbols)) {
+              parser::Message *msg{context.messages().Say(
+                  targetArg->sourceLocation(),
+                  "TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
+                  targetExpr->AsFortran())};
+              for (SymbolRef ref : symbols) {
+                msg = evaluate::AttachDeclaration(msg, *ref);
+              }
+            } else if (HasVectorSubscript(*targetExpr) ||
+                ExtractCoarrayRef(*targetExpr)) {
+              context.messages().Say(targetArg->sourceLocation(),
+                  "TARGET= argument '%s' may not have a vector subscript or coindexing"_err_en_US,
+                  targetExpr->AsFortran());
+            }
+            if (const auto pointerType{pointerArg->GetType()}) {
+              if (const auto targetType{targetArg->GetType()}) {
+                ok = pointerType->IsTkCompatibleWith(*targetType);
+              }
+            }
+          }
+        }
+      }
+    }
+  } else {
+    // No arguments to ASSOCIATED()
+    ok = false;
+  }
+  if (!ok) {
+    context.messages().Say(
+        "Arguments of ASSOCIATED() must be a POINTER and an optional valid target"_err_en_US);
+  }
+}
+
+static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
+    evaluate::FoldingContext &context, const Scope *scope,
+    const evaluate::SpecificIntrinsic &intrinsic) {
+  if (intrinsic.name == "associated") {
+    CheckAssociated(arguments, context, scope);
+  }
+}
+
 static parser::Messages CheckExplicitInterface(
     const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
     const evaluate::FoldingContext &context, const Scope *scope,

   parser::ContextualMessages messages{context.messages().at(), &buffer};
   RearrangeArguments(proc, actuals, messages);
   evaluate::FoldingContext localContext{context, messages};
-  if (buffer.empty()) {
-    int index{0};
-    for (auto &actual : actuals) {
-      const auto &dummy{proc.dummyArguments.at(index++)};
-      if (actual) {
-        CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
-            intrinsic, allowActualArgumentConversions);
-      } else if (!dummy.IsOptional()) {
-        if (dummy.name.empty()) {
-          messages.Say(
-              "Dummy argument #%d is not OPTIONAL and is not associated with "
-              "an actual argument in this procedure reference"_err_en_US,
-              index);
-        } else {
-          messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
-                       "associated with an actual argument in this procedure "
-                       "reference"_err_en_US,
-              dummy.name, index);
-        }
+  if (!buffer.empty()) {
+    return buffer;
+  }
+  int index{0};
+  for (auto &actual : actuals) {
+    const auto &dummy{proc.dummyArguments.at(index++)};
+    if (actual) {
+      CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
+          intrinsic, allowActualArgumentConversions);
+    } else if (!dummy.IsOptional()) {
+      if (dummy.name.empty()) {
+        messages.Say(
+            "Dummy argument #%d is not OPTIONAL and is not associated with "
+            "an actual argument in this procedure reference"_err_en_US,
+            index);
+      } else {
+        messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
+                     "associated with an actual argument in this procedure "
+                     "reference"_err_en_US,
+            dummy.name, index);
       }
     }
-    if (proc.IsElemental() && !buffer.AnyFatalError()) {
-      CheckElementalConformance(messages, proc, actuals, localContext);
-    }
+  }
+  if (proc.IsElemental() && !buffer.AnyFatalError()) {
+    CheckElementalConformance(messages, proc, actuals, localContext);
+  }
+  if (intrinsic) {
+    CheckSpecificIntrinsic(actuals, localContext, scope, *intrinsic);
   }
   return buffer;
 }
 
-parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
-    evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
-    const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
-  return CheckExplicitInterface(
-      proc, actuals, context, &scope, intrinsic, true);
-}
-
 bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
     evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
     bool allowActualArgumentConversions) {

     }
   }
   if (explicitInterface) {
-    auto buffer{
-        CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
+    auto buffer{CheckExplicitInterface(
+        proc, actuals, context, &scope, intrinsic, true)};
     if (!buffer.empty()) {
       if (treatingExternalAsImplicit && !buffer.empty()) {
         if (auto *msg{messages.Say(

flang/lib/Semantics/definable.cpp

       }
     }
   }
+  if (evaluate::IsNullPointer(expr)) {
+    return parser::Message{
+        at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()};
+  }
   return parser::Message{
       at, "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
 }

flang/lib/Semantics/expression.cpp

           "References to the procedure '%s' require an explicit interface"_err_en_US,
           DEREF(procSymbol).name());
     }
-    // Checks for ASSOCIATED() are done in intrinsic table processing
     const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
-    bool procIsAssociated{
-        specificIntrinsic && specificIntrinsic->name == "associated"};
-    if (!procIsAssociated) {
-      bool procIsDummy{procSymbol && IsDummy(*procSymbol)};
-      if (chars->functionResult &&
-          chars->functionResult->IsAssumedLengthCharacter() &&
-          !specificIntrinsic && !procIsDummy) {
+    bool procIsDummy{procSymbol && IsDummy(*procSymbol)};
+    if (chars->functionResult &&
+        chars->functionResult->IsAssumedLengthCharacter() &&
+        !specificIntrinsic && !procIsDummy) {
+      Say(callSite,
+          "Assumed-length character function must be defined with a length to be called"_err_en_US);
+    }
+    ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
+        context_.FindScope(callSite), treatExternalAsImplicit,
+        specificIntrinsic);
+    if (procSymbol && !IsPureProcedure(*procSymbol)) {
+      if (const semantics::Scope *
+          pure{semantics::FindPureProcedureContaining(
+              context_.FindScope(callSite))}) {
         Say(callSite,
-            "Assumed-length character function must be defined with a length to be called"_err_en_US);
-      }
-      ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
-          context_.FindScope(callSite), treatExternalAsImplicit,
-          specificIntrinsic);
-      if (procSymbol && !IsPureProcedure(*procSymbol)) {
-        if (const semantics::Scope *pure{semantics::FindPureProcedureContaining(
-                context_.FindScope(callSite))}) {
-          Say(callSite,
-              "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
-              procSymbol->name(), DEREF(pure->symbol()).name());
-        }
+            "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
+            procSymbol->name(), DEREF(pure->symbol()).name());
       }
     }
   }

flang/test/Evaluate/folding06.f90

   integer, pointer :: int_pointer
   integer, allocatable :: int_allocatable
   logical, parameter :: test_Assoc1 = .not.(associated(null()))
+  !WARN: portability: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
+  !WARN: because: 'NULL()' is a null pointer
   logical, parameter :: test_Assoc2 = .not.(associated(null(), null()))
   logical, parameter :: test_Assoc3 = .not.(associated(null(int_pointer)))
   logical, parameter :: test_Assoc4 = .not.(associated(null(int_allocatable)))
+  !WARN: portability: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
+  !WARN: because: 'NULL()' is a null pointer
   logical, parameter :: test_Assoc5 = .not.(associated(null(), null(int_pointer)))
+  !WARN: portability: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
+  !WARN: because: 'NULL()' is a null pointer
   logical, parameter :: test_Assoc6 = .not.(associated(null(), null(int_allocatable)))
 
   type A

flang/test/Semantics/associated.f90

     lVar = associated(null(intAllocVar)) !OK
     lVar = associated(null()) !OK
     lVar = associated(null(intPointerVar1)) !OK
+    !PORTABILITY: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
+    !BECAUSE: 'NULL()' is a null pointer
     lVar = associated(null(), null()) !OK
     lVar = associated(intPointerVar1, null(intPointerVar2)) !OK
     lVar = associated(intPointerVar1, null()) !OK
+    !PORTABILITY: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement
+    !BECAUSE: 'NULL()' is a null pointer
     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
     lVar = associated(intVar)

     !ERROR: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
     intProcPointer1 => elementalProc
     !WARNING: Procedure pointer 'intprocpointer1' associated with incompatible procedure designator 'elementalproc': incompatible procedure attributes: Elemental
+    !ERROR: Non-intrinsic ELEMENTAL procedure 'elementalproc' may not be passed as an actual argument
     lvar = associated(intProcPointer1, elementalProc)
     !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is a procedure designator
     lvar = associated (intPointerVar1, intFunc)