diff --git a/flang/lib/evaluate/call.h b/flang/lib/evaluate/call.h index 6bcf8089d349..d91dc33b25b1 100644 --- a/flang/lib/evaluate/call.h +++ b/flang/lib/evaluate/call.h @@ -37,6 +37,7 @@ class Component; class IntrinsicProcTable; } namespace Fortran::evaluate::characteristics { +struct DummyArgument; struct Procedure; } @@ -106,6 +107,8 @@ public: std::optional keyword; bool isAlternateReturn{false}; // when true, "value" is a label number + bool Matches(const characteristics::DummyArgument &) const; + // TODO: Mark legacy %VAL and %REF arguments private: diff --git a/flang/lib/semantics/check-io.h b/flang/lib/semantics/check-io.h index a462e458b9ed..a5b313ae68a4 100644 --- a/flang/lib/semantics/check-io.h +++ b/flang/lib/semantics/check-io.h @@ -12,8 +12,8 @@ // See the License for the specific language governing permissions and // limitations under the License. -#ifndef FORTRAN_SEMANTICS_IO_H_ -#define FORTRAN_SEMANTICS_IO_H_ +#ifndef FORTRAN_SEMANTICS_CHECK_IO_H_ +#define FORTRAN_SEMANTICS_CHECK_IO_H_ #include "semantics.h" #include "tools.h" @@ -141,4 +141,4 @@ private: }; } -#endif // FORTRAN_SEMANTICS_IO_H_ +#endif // FORTRAN_SEMANTICS_CHECK_IO_H_ diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 4e782750372f..4b50d7939701 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1513,17 +1513,42 @@ std::optional ExpressionAnalyzer::AnalyzeActualArgument( MaybeExpr ExpressionAnalyzer::Analyze( const parser::FunctionReference &funcRef) { + return AnalyzeCall(funcRef.v, false); +} + +void ExpressionAnalyzer::Analyze(const parser::CallStmt &call) { + AnalyzeCall(call.v, true); +} + +MaybeExpr ExpressionAnalyzer::AnalyzeCall( + const parser::Call &call, bool isSubroutine) { + auto save{GetContextualMessages().SetLocation(call.source)}; + if (auto arguments{AnalyzeArguments(call, isSubroutine)}) { + // TODO: map non-intrinsic generic procedure to specific procedure + if (std::optional callee{Procedure( + std::get(call.t), *arguments)}) { + if (isSubroutine) { + // TODO + } else { + return MakeFunctionRef(std::move(*callee)); + } + } + } + return std::nullopt; +} + +std::optional ExpressionAnalyzer::AnalyzeArguments( + const parser::Call &call, bool isSubroutine) { + evaluate::ActualArguments arguments; // 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. - auto save{GetContextualMessages().SetLocation(funcRef.v.source)}; - ActualArguments arguments; - for (const auto &arg : - std::get>(funcRef.v.t)) { - std::optional actual; + // TODO: map non-intrinsic generic procedure to specific procedure + for (const auto &arg : std::get>(call.t)) { + std::optional actual; std::visit( common::visitors{ [&](const common::Indirection &x) { @@ -1532,7 +1557,9 @@ MaybeExpr ExpressionAnalyzer::Analyze( actual = AnalyzeActualArgument(x.value()); }, [&](const parser::AltReturnSpec &) { - Say("alternate return specification may not appear on function reference"_err_en_US); + if (!isSubroutine) { + Say("alternate return specification may not appear on function reference"_err_en_US); + } }, [&](const parser::ActualArg::PercentRef &) { Say("TODO: %REF() argument"_err_en_US); @@ -1551,15 +1578,7 @@ MaybeExpr ExpressionAnalyzer::Analyze( return std::nullopt; } } - - // TODO: map non-intrinsic generic procedure to specific procedure - if (std::optional callee{Procedure( - std::get(funcRef.v.t), arguments)}) { - if (MaybeExpr funcRef{MakeFunctionRef(std::move(*callee))}) { - return funcRef; - } - } - return std::nullopt; + return arguments; } // Unary operations @@ -2152,8 +2171,18 @@ evaluate::Expr AnalyzeKindSelector( return analyzer.AnalyzeKindSelector(category, selector); } +ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {} + bool ExprChecker::Walk(const parser::Program &program) { parser::Walk(program, *this); return !context_.AnyFatalError(); } + +CallChecker::CallChecker(SemanticsContext &context) : analyzer_{context} {} + +void CallChecker::Enter(const parser::CallStmt &call) { + analyzer_.Analyze(call); +} + +void CallChecker::Leave(const parser::CallStmt &) {} } diff --git a/flang/lib/semantics/expression.h b/flang/lib/semantics/expression.h index 5547ecaeba6e..7f73821d8c53 100644 --- a/flang/lib/semantics/expression.h +++ b/flang/lib/semantics/expression.h @@ -235,6 +235,8 @@ public: } MaybeExpr Analyze(const parser::StructureComponent &); + void Analyze(const parser::CallStmt &); + protected: int IntegerTypeSpecKind(const parser::IntegerTypeSpec &); @@ -317,6 +319,10 @@ private: ProcedureDesignator procedureDesignator; ActualArguments arguments; }; + + MaybeExpr AnalyzeCall(const parser::Call &, bool isSubroutine); + std::optional AnalyzeArguments( + const parser::Call &, bool isSubroutine); std::optional Procedure( const parser::ProcedureDesignator &, ActualArguments &); bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory, @@ -373,7 +379,7 @@ evaluate::Expr AnalyzeKindSelector( // decorated with typed representations for top-level expressions. class ExprChecker { public: - explicit ExprChecker(SemanticsContext &context) : context_{context} {} + explicit ExprChecker(SemanticsContext &); template bool Pre(const A &) { return true; } template void Post(const A &) {} @@ -412,5 +418,18 @@ public: private: SemanticsContext &context_; }; + +// Semantic analysis of all CALL statements in a parse tree. +// (Function references are processed as primary expressions.) +class CallChecker { +public: + explicit CallChecker(SemanticsContext &); + void Enter(const parser::CallStmt &); + void Leave(const parser::CallStmt &); + +private: + evaluate::ExpressionAnalyzer analyzer_; +}; + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_EXPRESSION_H_ diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index fbb54647bc41..a948d0fed67a 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -100,7 +100,7 @@ private: using StatementSemanticsPass1 = ExprChecker; using StatementSemanticsPass2 = SemanticsVisitor;