[flang] Allow host-associated INTENT(OUT) in specification expr.

flang/docs/Extensions.md

@@ -825,6 +825,19 @@ print *, [(j,j=1,10)]
   of these values in violation of the restriction in f23 clause 17.11.42 set
   the mode to ieee_nearest.
 
+* Some compilers allow an `INTENT(OUT)` dummy argument's value to appear
+  via host association in a specification expression.  A non-host-associated
+  use is an error because an `INTENT(OUT)` dummy argument's value is not
+  defined.  The argument put forth to accept this usage in a `BLOCK` construct
+  or inner procedure is that the language in 10.1.11 (specification expressions)
+  allows any host-associated object to appear, but that's unconvincing
+  because it would also allow a host-associated `OPTIONAL` dummy argument to
+  be used in a nested scope, and that doesn't make sense.  This compiler
+  accepts an `INTENT(OUT)` non-`OPTIONAL` host-associated value to appear
+  in a specification expression via host association with a portability
+  warning since such values may have become defined by the time the nested
+  expression's value is required.
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the

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

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

flang/lib/Evaluate/check-expression.cpp

@@ -545,6 +545,8 @@ class CheckSpecificationExprHelper
         !IsAllocatable(ultimate) && object &&
         (ultimate.test(Symbol::Flag::InDataStmt) ||
             object->init().has_value())};
+    bool hasHostAssociation{
+        &symbol.owner() != &scope_ || &ultimate.owner() != &scope_};
     if (const auto *assoc{
             ultimate.detailsIf<semantics::AssocEntityDetails>()}) {
       return (*this)(assoc->expr());
@@ -563,16 +565,30 @@ class CheckSpecificationExprHelper
       } else if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
         return "reference to OPTIONAL dummy argument '"s +
             ultimate.name().ToString() + "'";
-      } else if (!inInquiry_ &&
+      } else if (!inInquiry_ && !hasHostAssociation &&
           ultimate.attrs().test(semantics::Attr::INTENT_OUT)) {
         return "reference to INTENT(OUT) dummy argument '"s +
             ultimate.name().ToString() + "'";
-      } else if (ultimate.has<semantics::ObjectEntityDetails>()) {
-        return std::nullopt;
-      } else {
+      } else if (!ultimate.has<semantics::ObjectEntityDetails>()) {
         return "dummy procedure argument";
+      } else {
+        // Sketchy case: some compilers allow an INTENT(OUT) dummy argument
+        // to be used in a specification expression if it is host-associated.
+        // The arguments raised in support this usage, however, depend on
+        // a reading of the standard that would also accept an OPTIONAL
+        // host-associated dummy argument, and that doesn't seem like a
+        // good idea.
+        if (!inInquiry_ && hasHostAssociation &&
+            ultimate.attrs().test(semantics::Attr::INTENT_OUT) &&
+            context_.languageFeatures().ShouldWarn(
+                common::UsageWarning::HostAssociatedIntentOutInSpecExpr)) {
+          context_.messages().Say(
+              "specification expression refers to host-associated INTENT(OUT) dummy argument '%s'"_port_en_US,
+              ultimate.name());
+        }
+        return std::nullopt;
       }
-    } else if (&symbol.owner() != &scope_ || &ultimate.owner() != &scope_) {
+    } else if (hasHostAssociation) {
       return std::nullopt; // host association is in play
     } else if (isInitialized &&
         context_.languageFeatures().IsEnabled(
@@ -582,7 +598,7 @@ class CheckSpecificationExprHelper
               common::LanguageFeature::SavedLocalInSpecExpr)) {
         context_.messages().Say(common::LanguageFeature::SavedLocalInSpecExpr,
             "specification expression refers to local object '%s' (initialized and saved)"_port_en_US,
-            ultimate.name().ToString());
+            ultimate.name());
       }
       return std::nullopt;
     } else if (const auto *object{
@@ -831,9 +847,9 @@ bool CheckSpecificationExprHelper::IsPermissibleInquiry(
 template <typename A>
 void CheckSpecificationExpr(const A &x, const semantics::Scope &scope,
     FoldingContext &context, bool forElementalFunctionResult) {
-  CheckSpecificationExprHelper helper{
+  CheckSpecificationExprHelper errors{
       scope, context, forElementalFunctionResult};
-  if (auto why{helper(x)}) {
+  if (auto why{errors(x)}) {
     context.messages().Say("Invalid specification expression%s: %s"_err_en_US,
         forElementalFunctionResult ? " for elemental function result" : "",
         *why);

flang/lib/Support/Fortran-features.cpp

@@ -86,6 +86,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnUsage_.set(UsageWarning::UnsignedLiteralTruncation);
   warnUsage_.set(UsageWarning::NullActualForDefaultIntentAllocatable);
   warnUsage_.set(UsageWarning::UseAssociationIntoSameNameSubprogram);
+  warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr);
   // New warnings, on by default
   warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
   warnLanguage_.set(LanguageFeature::NullActualForAllocatable);

flang/test/Semantics/spec-expr.f90

@@ -28,6 +28,19 @@ subroutine s2(inArg, inoutArg, outArg, optArg)
   real, dimension(optArg) :: realVar4
 
   outArg = 3
+  block
+    !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg'
+    real a(outArg)
+    !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optarg'
+    real b(optArg)
+  end block
+ contains
+  subroutine s2inner
+    !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg'
+    real a(outArg)
+    !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optarg'
+    real b(optArg)
+  end
 end subroutine s2
 
 ! an object designator with a base object that is in a common block,