[flang-commits] [flang] 562bfe1 - [flang] Complain about more cases of calls to insufficiently defined procedures
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jun 16 18:21:10 PDT 2021
Author: peter klausler
Date: 2021-06-16T18:20:59-07:00
New Revision: 562bfe1274a17698c445ee3d7bb4a7911d74f657
URL: https://github.com/llvm/llvm-project/commit/562bfe1274a17698c445ee3d7bb4a7911d74f657
DIFF: https://github.com/llvm/llvm-project/commit/562bfe1274a17698c445ee3d7bb4a7911d74f657.diff
LOG: [flang] Complain about more cases of calls to insufficiently defined procedures
When a function is called in a specification expression, it must be
sufficiently defined, and cannot be a recursive call (10.1.11(5)).
The best fix for this is to change the contract for the procedure
characterization infrastructure to catch and report such errors,
and to guarantee that it does emit errors on failed characterizations.
Some call sites were adjusted to avoid cascades.
Differential Revision: https://reviews.llvm.org/D104330
Added:
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve102.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 8006f7a09c048..619f3c96b4076 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -295,11 +295,11 @@ struct Procedure {
bool operator==(const Procedure &) const;
bool operator!=(const Procedure &that) const { return !(*this == that); }
- // Characterizes the procedure represented by a symbol, which may be an
+ // Characterizes a procedure. If a Symbol, it may be an
// "unrestricted specific intrinsic function".
+ // Error messages are produced when a procedure cannot be characterized.
static std::optional<Procedure> Characterize(
const semantics::Symbol &, FoldingContext &);
- // This function is the initial point of entry for characterizing procedure
static std::optional<Procedure> Characterize(
const ProcedureDesignator &, FoldingContext &);
static std::optional<Procedure> Characterize(
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 80f5f23fa53be..3fd0025dc83f2 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -468,7 +468,23 @@ static std::optional<Procedure> CharacterizeProcedure(
[&](const semantics::HostAssocDetails &assoc) {
return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
},
- [](const auto &) { return std::optional<Procedure>{}; },
+ [&](const semantics::EntityDetails &) {
+ context.messages().Say(
+ "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
+ symbol.name());
+ return std::optional<Procedure>{};
+ },
+ [&](const semantics::SubprogramNameDetails &) {
+ context.messages().Say(
+ "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
+ symbol.name());
+ return std::optional<Procedure>{};
+ },
+ [&](const auto &) {
+ context.messages().Say(
+ "'%s' is not a procedure"_err_en_US, symbol.name());
+ return std::optional<Procedure>{};
+ },
},
symbol.details());
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index a63f845c03e0a..c8d8b02d58abc 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1863,8 +1863,9 @@ SpecificCall IntrinsicProcTable::Implementation::HandleNull(
// MOLD= procedure pointer
const Symbol *last{GetLastSymbol(*mold)};
CHECK(last);
- auto procPointer{
- characteristics::Procedure::Characterize(*last, context)};
+ auto procPointer{IsProcedure(*last)
+ ? characteristics::Procedure::Characterize(*last, context)
+ : std::nullopt};
// procPointer is null if there was an error with the analysis
// associated with the procedure pointer
if (procPointer) {
@@ -2000,12 +2001,9 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
"POINTER"_err_en_US),
*pointerSymbol);
} else {
- const auto pointerProc{characteristics::Procedure::Characterize(
- *pointerSymbol, context)};
if (const auto &targetArg{call.arguments[1]}) {
if (const auto *targetExpr{targetArg->UnwrapExpr()}) {
- std::optional<characteristics::Procedure> targetProc{
- std::nullopt};
+ std::optional<characteristics::Procedure> pointerProc, targetProc;
const Symbol *targetSymbol{GetLastSymbol(*targetExpr)};
bool isCall{false};
std::string targetName;
@@ -2018,13 +2016,18 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
targetName = targetProcRef->proc().GetName() + "()";
isCall = true;
}
- } else if (targetSymbol && !targetProc) {
+ } else if (targetSymbol) {
// proc that's not a call
- targetProc = characteristics::Procedure::Characterize(
- *targetSymbol, context);
+ if (IsProcedure(*targetSymbol)) {
+ targetProc = characteristics::Procedure::Characterize(
+ *targetSymbol, context);
+ }
targetName = targetSymbol->name().ToString();
}
-
+ if (IsProcedure(*pointerSymbol)) {
+ pointerProc = characteristics::Procedure::Characterize(
+ *pointerSymbol, context);
+ }
if (pointerProc) {
if (targetProc) {
// procedure pointer and procedure target
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 56c126b5bc1c8..ddf0a011b2f77 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -822,7 +822,9 @@ void CheckHelper::CheckSubprogram(
} else if (FindSeparateModuleSubprogramInterface(subprogram)) {
error = "ENTRY may not appear in a separate module procedure"_err_en_US;
} else if (subprogramDetails && details.isFunction() &&
- subprogramDetails->isFunction()) {
+ subprogramDetails->isFunction() &&
+ !context_.HasError(details.result()) &&
+ !context_.HasError(subprogramDetails->result())) {
auto result{FunctionResult::Characterize(
details.result(), context_.foldingContext())};
auto subpResult{FunctionResult::Characterize(
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 42d6a2ac20070..95943b3837bc4 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1860,6 +1860,7 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
Say(sc.component.source, "'%s' is not a procedure"_err_en_US,
sc.component.source),
*sym);
+ return std::nullopt;
}
if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
if (sym->has<semantics::GenericDetails>()) {
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 171e2ba02477c..afa15522127d3 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -44,11 +44,13 @@ class PointerAssignmentChecker {
: context_{context}, source_{source}, description_{description} {}
PointerAssignmentChecker(evaluate::FoldingContext &context, const Symbol &lhs)
: context_{context}, source_{lhs.name()},
- description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs},
- procedure_{Procedure::Characterize(lhs, context)} {
+ description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
set_lhsType(TypeAndShape::Characterize(lhs, context));
set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
set_isVolatile(lhs.attrs().test(Attr::VOLATILE));
+ if (IsProcedure(lhs)) {
+ procedure_ = Procedure::Characterize(lhs, context);
+ }
}
PointerAssignmentChecker &set_lhsType(std::optional<TypeAndShape> &&);
PointerAssignmentChecker &set_isContiguous(bool);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index efba039fe9b33..5ab4d39590d9c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3102,6 +3102,7 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
Say2(effectiveResultName.source,
"'%s' was previously declared as an item that may not be used as a function result"_err_en_US,
resultSymbol->name(), "Previous declaration of '%s'"_en_US);
+ context().SetError(*resultSymbol);
}},
resultSymbol->details());
} else if (inExecutionPart_) {
diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90
index aae461d108d81..77b5e10369fe5 100644
--- a/flang/test/Semantics/resolve102.f90
+++ b/flang/test/Semantics/resolve102.f90
@@ -85,3 +85,18 @@ program threeCycle
call p2
call p3
end program
+
+module mutualSpecExprs
+contains
+ pure integer function f(n)
+ integer, intent(in) :: n
+ real arr(g(n))
+ f = size(arr)
+ end function
+ pure integer function g(n)
+ integer, intent(in) :: n
+ !ERROR: Procedure 'f' is referenced before being sufficiently defined in a context where it must be so
+ real arr(f(n))
+ g = size(arr)
+ end function
+end
More information about the flang-commits
mailing list