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

[Peter Klausler via Phabricator via llvm-commits]

klausler created this revision.
klausler added a reviewer: tskeith.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
klausler requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

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


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D95176

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


Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -139,8 +139,8 @@
 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 @@
                    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 @@
           ? 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 @@
           "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 @@
                 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,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D95176.318323.patch
Type: text/x-patch
Size: 3501 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210121/eee009c3/attachment-0001.bin>