[flang] Refine handling of NULL() actual to non-optional allocatable … (llvm#116126)

…dummy

We presently allow a NULL() actual argument to associate with a
non-optional dummy allocatable argument only under INTENT(IN). This is
too strict, as it precludes the case of a dummy argument with default
intent. Continue to require that the actual argument be definable under
INTENT(OUT) and INTENT(IN OUT), and (contra XLF) interpret NULL() as
being an expression, not a definable variable, even when it is given an
allocatable MOLD.

Fixes llvm#115984.

Author: klausler

flang/include/flang/Support/Fortran-features.h

@@ -74,7 +74,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     IndexVarRedefinition, IncompatibleImplicitInterfaces,
     VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg,
     MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation,
-    CompatibleDeclarationsFromDistinctModules)
+    CompatibleDeclarationsFromDistinctModules,
+    NullActualForDefaultIntentAllocatable)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;

flang/lib/Semantics/check-call.cpp

@@ -793,21 +793,21 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
       }
     } else if (actualIsNull) {
       if (dummyIsOptional) {
-      } else if (dummy.intent == common::Intent::In) {
-        // Extension (Intel, NAG, XLF): a NULL() pointer is an acceptable
-        // actual argument for an INTENT(IN) allocatable dummy, and it
-        // is treated as an unassociated allocatable.
-        if (context.ShouldWarn(
-                common::LanguageFeature::NullActualForAllocatable)) {
-          messages.Say(common::LanguageFeature::NullActualForAllocatable,
-              "Allocatable %s is associated with a null pointer"_port_en_US,
-              dummyName);
-        }
-      } else {
+      } else if (dummy.intent == common::Intent::Default &&
+          context.ShouldWarn(
+              common::UsageWarning::NullActualForDefaultIntentAllocatable)) {
         messages.Say(
-            "A null pointer may not be associated with allocatable %s without INTENT(IN)"_err_en_US,
+            "A null pointer should not be associated with allocatable %s without INTENT(IN)"_warn_en_US,
+            dummyName);
+      } else if (dummy.intent == common::Intent::In &&
+          context.ShouldWarn(
+              common::LanguageFeature::NullActualForAllocatable)) {
+        messages.Say(common::LanguageFeature::NullActualForAllocatable,
+            "Allocatable %s is associated with a null pointer"_port_en_US,
             dummyName);
       }
+      // INTENT(OUT) and INTENT(IN OUT) cases are caught elsewhere as being
+      // undefinable actual arguments.
     } else {
       messages.Say(
           "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
@@ -1292,19 +1292,24 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                 } else if (object.attrs.test(characteristics::DummyDataObject::
                                    Attr::Allocatable) &&
                     evaluate::IsNullPointer(*expr)) {
-                  if (object.intent == common::Intent::In) {
-                    // Extension (Intel, NAG, XLF); see CheckExplicitDataArg.
-                    if (context.ShouldWarn(common::LanguageFeature::
-                                NullActualForAllocatable)) {
-                      messages.Say(
-                          common::LanguageFeature::NullActualForAllocatable,
-                          "Allocatable %s is associated with NULL()"_port_en_US,
-                          dummyName);
-                    }
-                  } else {
+                  if (object.intent == common::Intent::Out ||
+                      object.intent == common::Intent::InOut) {
                     messages.Say(
-                        "NULL() actual argument '%s' may not be associated with allocatable %s without INTENT(IN)"_err_en_US,
+                        "NULL() actual argument '%s' may not be associated with allocatable dummy argument %s that is INTENT(OUT) or INTENT(IN OUT)"_err_en_US,
                         expr->AsFortran(), dummyName);
+                  } else if (object.intent == common::Intent::Default &&
+                      context.ShouldWarn(common::UsageWarning::
+                              NullActualForDefaultIntentAllocatable)) {
+                    messages.Say(common::UsageWarning::
+                                     NullActualForDefaultIntentAllocatable,
+                        "NULL() actual argument '%s' should not be associated with allocatable dummy argument %s without INTENT(IN)"_warn_en_US,
+                        expr->AsFortran(), dummyName);
+                  } else if (context.ShouldWarn(common::LanguageFeature::
+                                     NullActualForAllocatable)) {
+                    messages.Say(
+                        common::LanguageFeature::NullActualForAllocatable,
+                        "Allocatable %s is associated with %s"_port_en_US,
+                        dummyName, expr->AsFortran());
                   }
                 } else {
                   messages.Say(

flang/lib/Support/Fortran-features.cpp

@@ -84,8 +84,10 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnUsage_.set(UsageWarning::UndefinedFunctionResult);
   warnUsage_.set(UsageWarning::UselessIomsg);
   warnUsage_.set(UsageWarning::UnsignedLiteralTruncation);
+  warnUsage_.set(UsageWarning::NullActualForDefaultIntentAllocatable);
   // New warnings, on by default
   warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
+  warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
 }
 
 // Ignore case and any inserted punctuation (like '-'/'_')

flang/test/Semantics/call27.f90

@@ -1,12 +1,26 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Catch NULL() actual argument association with allocatable dummy argument
 program test
-  !ERROR: NULL() actual argument 'NULL()' may not be associated with allocatable dummy argument 'a=' without INTENT(IN)
+  real, allocatable :: a
+  !ERROR: NULL() actual argument 'NULL()' may not be associated with allocatable dummy argument dummy argument 'a=' that is INTENT(OUT) or INTENT(IN OUT)
+  call foo0(null())
+  !WARNING: NULL() actual argument 'NULL()' should not be associated with allocatable dummy argument dummy argument 'a=' without INTENT(IN)
   call foo1(null())
   !PORTABILITY: Allocatable dummy argument 'a=' is associated with NULL()
   call foo2(null())
   call foo3(null()) ! ok
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'a=' is not definable
+  !BECAUSE: 'null(mold=a)' is a null pointer
+  call foo0(null(mold=a))
+  !WARNING: A null pointer should not be associated with allocatable dummy argument 'a=' without INTENT(IN)
+  call foo1(null(mold=a))
+  !PORTABILITY: Allocatable dummy argument 'a=' is associated with a null pointer
+  call foo2(null(mold=a))
+  call foo3(null(mold=a)) ! ok
  contains
+  subroutine foo0(a)
+    real, allocatable, intent(in out) :: a
+  end subroutine
   subroutine foo1(a)
     real, allocatable :: a
   end subroutine