[flang] Add more support for alternate returns

[tskeith]

Summary

Add hasAlternateReturns to evaluate::ProcedureRef.

Add HasAlternateReturns to test subprogram symbols.

Fix label01.F90 test: It was checking that "error: " didn't appear in
the output. But that was erroneously matching a warning that ends
"would be in error:". So change it to check for ": error: " instead.

flang/include/flang/Evaluate/call.h

struct ProcedureDesignator {
   std::variant<SpecificIntrinsic, SymbolRef,
       common::CopyableIndirection<Component>>
       u;
 };
 
 class ProcedureRef {
 public:
   CLASS_BOILERPLATE(ProcedureRef)
-  ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a)
-      : proc_{std::move(p)}, arguments_(std::move(a)) {}
+  ProcedureRef(ProcedureDesignator &&p, ActualArguments &&a,
+      bool hasAlternateReturns = false)
+      : proc_{std::move(p)}, arguments_{std::move(a)},
+        hasAlternateReturns_{hasAlternateReturns} {}
   ~ProcedureRef();
 
   ProcedureDesignator &proc() { return proc_; }
   const ProcedureDesignator &proc() const { return proc_; }
   ActualArguments &arguments() { return arguments_; }
   const ActualArguments &arguments() const { return arguments_; }
 
   std::optional<Expr<SubscriptInteger>> LEN() const;
   int Rank() const;
   bool IsElemental() const { return proc_.IsElemental(); }
+  bool hasAlternateReturns() const { return hasAlternateReturns_; }
   bool operator==(const ProcedureRef &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
 protected:
   ProcedureDesignator proc_;
   ActualArguments arguments_;
+  bool hasAlternateReturns_;
 };
 
 template <typename A> class FunctionRef : public ProcedureRef {
 public:
   using Result = A;
   CLASS_BOILERPLATE(FunctionRef)
   explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
   FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)

flang/include/flang/Semantics/tools.h

 bool IsIsoCType(const DerivedTypeSpec *);
 bool IsEventTypeOrLockType(const DerivedTypeSpec *);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false);
 bool HasIntrinsicTypeName(const Symbol &);
 bool IsSeparateModuleProcedureInterface(const Symbol *);
 bool IsAutomatic(const Symbol &);
+bool HasAlternateReturns(const Symbol &);
 
 // Return an ultimate component of type that matches predicate, or nullptr.
 const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
     const std::function<bool(const Symbol &)> &predicate);
 const Symbol *FindUltimateComponent(
     const Symbol &symbol, const std::function<bool(const Symbol &)> &predicate);
 
 // Returns an immediate component of type that matches predicate, or nullptr.

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
   }
   return std::nullopt;
 }
 
 void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
   const parser::Call &call{callStmt.v};
   auto restorer{GetContextualMessages().SetLocation(call.source)};
   ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */};
-  for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
+  const auto &actualArgList{std::get<std::list<parser::ActualArgSpec>>(call.t)};
+  for (const auto &arg : actualArgList) {
     analyzer.Analyze(arg, true /* is subroutine call */);
   }
   if (!analyzer.fatalErrors()) {
     if (std::optional<CalleeAndArguments> callee{
             GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
                 analyzer.GetActuals(), true /* subroutine */)}) {
       ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
       CHECK(proc);
       if (CheckCall(call.source, *proc, callee->arguments)) {
-        callStmt.typedCall.reset(
-            new ProcedureRef{std::move(*proc), std::move(callee->arguments)});
+        bool hasAlternateReturns{
+            analyzer.GetActuals().size() < actualArgList.size()};
+        callStmt.typedCall.reset(new ProcedureRef{std::move(*proc),
+            std::move(callee->arguments), hasAlternateReturns});
       }
     }
   }
 }
 
 const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
   if (!x.typedAssignment) {
     ArgumentAnalyzer analyzer{*this};
void ArgumentAnalyzer::Analyze(
     const parser::ActualArgSpec &arg, bool isSubroutine) {
   // TODO: C1002: Allow a whole assumed-size array to appear if the dummy
   // argument would accept it.  Handle by special-casing the context
   // ActualArg -> Variable -> Designator.
   // TODO: Actual arguments that are procedures and procedure pointers need to
   // be detected and represented (they're not expressions).
   // TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
   std::optional<ActualArgument> actual;
+  bool isAltReturn{false};
   std::visit(common::visitors{
                  [&](const common::Indirection<parser::Expr> &x) {
                    // TODO: Distinguish & handle procedure name and
                    // proc-component-ref
                    actual = AnalyzeExpr(x.value());
                  },
                  [&](const parser::AltReturnSpec &) {
                    if (!isSubroutine) {
                      context_.Say(
                          "alternate return specification may not appear on"
                          " function reference"_err_en_US);
                    }
+                   isAltReturn = true;
                  },
                  [&](const parser::ActualArg::PercentRef &) {
                    context_.Say("TODO: %REF() argument"_err_en_US);
                  },
                  [&](const parser::ActualArg::PercentVal &) {
                    context_.Say("TODO: %VAL() argument"_err_en_US);
                  },
              },
       std::get<parser::ActualArg>(arg.t).u);
   if (actual) {
     if (const auto &argKW{std::get<std::optional<parser::Keyword>>(arg.t)}) {
       actual->set_keyword(argKW->v.source);
     }
     actuals_.emplace_back(std::move(*actual));
-  } else {
+  } else if (!isAltReturn) {
     fatalErrors_ = true;
   }
 }
 
 bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
   CHECK(actuals_.size() == 2);
   return semantics::IsIntrinsicRelational(
       opr, *GetType(0), GetRank(0), *GetType(1), GetRank(1));

flang/lib/Semantics/tools.cpp

 
 void LabelEnforce::SayWithConstruct(SemanticsContext &context,
     parser::CharBlock stmtLocation, parser::MessageFormattedText &&message,
     parser::CharBlock constructLocation) {
   context.Say(stmtLocation, message)
       .Attach(constructLocation, GetEnclosingConstructMsg());
 }
 
+bool HasAlternateReturns(const Symbol &subprogram) {
+  for (const auto *dummyArg : subprogram.get<SubprogramDetails>().dummyArgs()) {
+    if (!dummyArg) {
+      return true;
+    }
+  }
+  return false;
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/label01.F90

 ! RUN: %f18 -funparse-with-symbols -DSTRICT_F18 -Mstandard %s 2>&1 | FileCheck %s
 ! RUN: %f18 -funparse-with-symbols -DARCHAIC_FORTRAN %s 2>&1 | FileCheck %s
-! CHECK-NOT: error:{{[[:space:]]}}
+! CHECK-NOT: :{{[[:space:]]}}error:{{[[:space:]]}}
 ! FIXME: the above check line does not work because diags are not emitted with error: in them.
 
 ! these are the conformance tests
 ! define STRICT_F18 to eliminate tests of features not in F18
 ! define ARCHAIC_FORTRAN to add test of feature found in Fortran before F95
 
-
 subroutine sub00(a,b,n,m)
   integer :: n, m
   real a(n)
   real :: b(m)
 1 print *, n, m
 1234 print *, a(n), b(1)
 99999 print *, a(1), b(m)
 end subroutine sub00