[flang-commits] [flang] 05756e6 - [flang] Add more support for alternate returns
Tim Keith via flang-commits
flang-commits at lists.llvm.org
Wed Jul 1 17:28:53 PDT 2020
Author: Tim Keith
Date: 2020-07-01T17:28:01-07:00
New Revision: 05756e6937d58c357b0b7e37ff3e9a8f7dd0d485
URL: https://github.com/llvm/llvm-project/commit/05756e6937d58c357b0b7e37ff3e9a8f7dd0d485
DIFF: https://github.com/llvm/llvm-project/commit/05756e6937d58c357b0b7e37ff3e9a8f7dd0d485.diff
LOG: [flang] Add more support for alternate returns
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.
Differential Revision: https://reviews.llvm.org/D83007
Added:
Modified:
flang/include/flang/Evaluate/call.h
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/label01.F90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 15fe5b879dc4..3ad77ceecc56 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -190,8 +190,10 @@ struct ProcedureDesignator {
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_; }
@@ -202,12 +204,14 @@ class ProcedureRef {
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 {
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 86a766bf963c..7f58751da061 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -100,6 +100,7 @@ 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,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 1e7d1d582a34..733ef32f752a 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2006,7 +2006,8 @@ 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()) {
@@ -2016,8 +2017,10 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
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});
}
}
}
@@ -2678,6 +2681,7 @@ void ArgumentAnalyzer::Analyze(
// 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
@@ -2690,6 +2694,7 @@ void ArgumentAnalyzer::Analyze(
"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);
@@ -2704,7 +2709,7 @@ void ArgumentAnalyzer::Analyze(
actual->set_keyword(argKW->v.source);
}
actuals_.emplace_back(std::move(*actual));
- } else {
+ } else if (!isAltReturn) {
fatalErrors_ = true;
}
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index e5ba3994b82d..889b5b26eafc 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1292,4 +1292,13 @@ void LabelEnforce::SayWithConstruct(SemanticsContext &context,
.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
diff --git a/flang/test/Semantics/label01.F90 b/flang/test/Semantics/label01.F90
index 4e7b9643480b..36a4fa56a543 100644
--- a/flang/test/Semantics/label01.F90
+++ b/flang/test/Semantics/label01.F90
@@ -1,13 +1,12 @@
! 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)
More information about the flang-commits
mailing list