[flang-commits] [flang] 0cfadb3 - [flang] Allow NULL() actual argument for pointer dummy

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-01-21T16:37:35-08:00
New Revision: 0cfadb37f4fef016998cb412270cfe87b0683090

URL: https://github.com/llvm/llvm-project/commit/0cfadb37f4fef016998cb412270cfe87b0683090
DIFF: https://github.com/llvm/llvm-project/commit/0cfadb37f4fef016998cb412270cfe87b0683090.diff

LOG: [flang] Allow NULL() actual argument for pointer dummy

Fixes a bogus error message about an actual argument not being an
object.

Differential Revision: https://reviews.llvm.org/D95176

Added: 
    

Modified: 
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ffae3410a852..1bd0b0ab6f08 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -139,8 +139,8 @@ static bool DefersSameTypeParameters(
 static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
     characteristics::TypeAndShape &actualType, bool isElemental,
-    bool actualIsArrayElement, evaluate::FoldingContext &context,
-    const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic) {
+    evaluate::FoldingContext &context, const Scope *scope,
+    const evaluate::SpecificIntrinsic *intrinsic) {
 
   // Basic type & rank checking
   parser::ContextualMessages &messages{context.messages()};
@@ -153,7 +153,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
                    characteristics::TypeAndShape::Attr::AssumedRank)) {
     } else if (!dummy.type.attrs().test(
                    characteristics::TypeAndShape::Attr::AssumedShape) &&
-        (actualType.Rank() > 0 || actualIsArrayElement)) {
+        (actualType.Rank() > 0 || IsArrayElement(actual))) {
       // Sequence association (15.5.2.11) applies -- rank need not match
       // if the actual argument is an array or array element designator.
     } else {
@@ -271,8 +271,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           ? actualLastSymbol->detailsIf<ObjectEntityDetails>()
           : nullptr};
   int actualRank{evaluate::GetRank(actualType.shape())};
-  bool actualIsPointer{(actualLastSymbol && IsPointer(*actualLastSymbol)) ||
-      evaluate::IsNullPointer(actual)};
+  bool actualIsPointer{evaluate::IsObjectPointer(actual, context)};
   if (dummy.type.attrs().test(
           characteristics::TypeAndShape::Attr::AssumedShape)) {
     // 15.5.2.4(16)
@@ -293,7 +292,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           "Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
           dummyName);
     }
-    if (actualLastSymbol && actualLastSymbol->Rank() == 0 &&
+    if (!IsArrayElement(actual) &&
+        !(actualType.type().category() == TypeCategory::Character &&
+            actualType.type().kind() == 1) &&
         !(dummy.type.type().IsAssumedType() && dummyIsAssumedSize)) {
       messages.Say(
           "Whole scalar actual argument may not be associated with a %s array"_err_en_US,
@@ -624,15 +625,18 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                 arg.set_dummyIntent(object.intent);
                 bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
                 CheckExplicitDataArg(object, dummyName, *expr, *type,
-                    isElemental, IsArrayElement(*expr), context, scope,
-                    intrinsic);
+                    isElemental, context, scope, intrinsic);
               } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                   std::holds_alternative<evaluate::BOZLiteralConstant>(
                       expr->u)) {
                 // ok
               } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                   evaluate::IsNullPointer(*expr)) {
-                // ok, calling ASSOCIATED(NULL())
+                // ok, ASSOCIATED(NULL())
+              } else if (object.attrs.test(
+                             characteristics::DummyDataObject::Attr::Pointer) &&
+                  evaluate::IsNullPointer(*expr)) {
+                // ok, FOO(NULL())
               } else {
                 messages.Say(
                     "Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,