[flang] rebase

Original-commit: flang-compiler/f18@2691da3836
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-10-11 15:41:11 -07:00
parent b8d4f79d59
commit 4c37c06597
10 changed files with 87 additions and 89 deletions

View File

@ -526,6 +526,7 @@ Procedure::Procedure(FunctionResult &&fr, DummyArguments &&args, Attrs a)
: functionResult{std::move(fr)}, dummyArguments{std::move(args)}, attrs{a} {}
Procedure::Procedure(DummyArguments &&args, Attrs a)
: dummyArguments{std::move(args)}, attrs{a} {}
Procedure::~Procedure() = default;
bool Procedure::operator==(const Procedure &that) const {
return attrs == that.attrs && dummyArguments == that.dummyArguments &&

View File

@ -224,6 +224,7 @@ struct Procedure {
Procedure(FunctionResult &&, DummyArguments &&, Attrs);
Procedure(DummyArguments &&, Attrs); // for subroutines and NULL()
DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
~Procedure();
bool operator==(const Procedure &) const;
// Characterizes the procedure represented by a symbol, which may be an

View File

@ -229,12 +229,15 @@ public:
pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {}
parser::ContextualMessages &messages() { return messages_; }
const common::IntrinsicTypeDefaultKinds &defaults() { return defaults_; }
const parser::ContextualMessages &messages() const { return messages_; }
const common::IntrinsicTypeDefaultKinds &defaults() const {
return defaults_;
}
Rounding rounding() const { return rounding_; }
bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
bool bigEndian() const { return bigEndian_; }
const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
HostIntrinsicProceduresLibrary &hostIntrinsicsLibrary() {
const HostIntrinsicProceduresLibrary &hostIntrinsicsLibrary() const {
return hostIntrinsicsLibrary_;
}
const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }

View File

@ -176,7 +176,7 @@ template<template<typename> typename ConstantContainer, typename TR,
typename... TA>
std::optional<HostProcedureWrapper<ConstantContainer, TR, TA...>>
HostIntrinsicProceduresLibrary::GetHostProcedureWrapper(
const std::string &name) {
const std::string &name) const {
if constexpr (host::HostTypeExists<TR, TA...>()) {
auto rteProcRange{procedures_.equal_range(name)};
const TypeCode resTypeCode{typeCodeOf<TR>};

View File

@ -104,7 +104,7 @@ public:
template<template<typename> typename ConstantContainer, typename TR,
typename... TA>
std::optional<HostProcedureWrapper<ConstantContainer, TR, TA...>>
GetHostProcedureWrapper(const std::string &name);
GetHostProcedureWrapper(const std::string &name) const;
private:
std::multimap<std::string, const HostRuntimeIntrinsicProcedure> procedures_;

View File

@ -102,6 +102,7 @@ public:
kind_ = ClassKind;
}
}
CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(DynamicType)
// A rare use case used for representing the characteristics of an
// intrinsic function like REAL() that accepts a typeless BOZ literal

View File

@ -307,43 +307,34 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
const Scope &scope) {
auto &messages{context.messages()};
std::visit(
common::visitors{
[&](const characteristics::DummyDataObject &object) {
if (const auto *expr{arg.UnwrapExpr()}) {
if (auto type{characteristics::TypeAndShape::Characterize(
*expr, context)}) {
CheckExplicitDataArg(
object, *expr, *type, proc, context, scope);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) {
// ok
} else {
messages.Say(
"Actual argument is not a variable or typed expression"_err_en_US);
}
} else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
// An assumed-type dummy is being forwarded.
if (!object.type.type().IsAssumedType()) {
messages.Say(
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US,
assumed->name());
}
} else {
messages.Say(
"Actual argument is not an expression or variable"_err_en_US);
}
},
[&](const characteristics::DummyProcedure &) {
// TODO check effective procedure compatibility
},
[&](const characteristics::AlternateReturn &) {
// TODO check alternate return
},
},
dummy.u);
return true; // TODO: return false when error detected
if (const auto *object{
std::get_if<characteristics::DummyDataObject>(&dummy.u)}) {
if (const auto *expr{arg.UnwrapExpr()}) {
if (auto type{
characteristics::TypeAndShape::Characterize(*expr, context)}) {
CheckExplicitDataArg(*object, *expr, *type, proc, context, scope);
} else if (object->type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u)) {
// ok
} else {
messages.Say(
"Actual argument is not a variable or typed expression"_err_en_US);
}
} else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
// An assumed-type dummy is being forwarded.
if (!object->type.type().IsAssumedType()) {
messages.Say(
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US,
assumed->name());
}
} else {
messages.Say(
"Actual argument is not an expression or variable"_err_en_US);
}
} else {
// TODO check actual procedure compatibility
// TODO check alternate return
}
}
static void RearrangeArguments(const characteristics::Procedure &proc,
@ -355,7 +346,6 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(
"Too many actual arguments (%zd) passed to procedure that expects only %zd"_err_en_US,
actuals.size(), proc.dummyArguments.size());
return false;
}
std::map<std::string, evaluate::ActualArgument> kwArgs;
for (auto &x : actuals) {
@ -367,7 +357,6 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x->keyword,
"Argument keyword '%s=' appears on more than one effective argument in this procedure reference"_err_en_US,
*x->keyword);
return false;
}
x.reset();
}
@ -384,7 +373,6 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x.keyword,
"Keyword argument '%s=' has already been specified positionally (#%d) in this procedure reference"_err_en_US,
*x.keyword, index + 1);
return false;
} else {
actuals[index] = std::move(x);
}
@ -398,49 +386,50 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x.keyword,
"Argument keyword '%s=' is not recognized for this procedure reference"_err_en_US,
*x.keyword);
return false;
}
}
return true;
}
bool CheckExplicitInterface(const characteristics::Procedure &proc,
ActualArguments &actuals, FoldingContext &context, const Scope &scope) {
parser::ContextualMessages &messages{context.messages()};
if (!RearrangeArguments(proc, actuals, messages)) {
return false;
}
int index{0};
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments[index++]};
if (actual.has_value()) {
if (!CheckExplicitInterfaceArg(*actual, dummy, context, scope)) {
return false;
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
const Scope &scope) {
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
evaluate::FoldingContext localContext{context, messages};
RearrangeArguments(proc, actuals, messages);
if (buffer.empty()) {
int index{0};
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments.at(index++)};
if (actual.has_value()) {
CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope);
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
"Dummy argument #%d is not OPTIONAL and is not associated with "
"an actual argument in this procedure reference"_err_en_US,
index);
} else {
messages.Say(
"Dummy argument '%s' (#%d) is not OPTIONAL and is not associated "
"with an actual argument in this procedure reference"_err_en_US,
dummy.name, index);
}
}
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
"Dummy argument #%d is not OPTIONAL and is not associated with an "
"actual argument in this procedure reference"_err_en_US,
index);
} else {
messages.Say(
"Dummy argument '%s' (#%d) is not OPTIONAL and is not associated "
"with an actual argument in this procedure reference"_err_en_US,
dummy.name, index);
}
return false;
}
}
return true;
return buffer;
}
void CheckArguments(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
const Scope &scope, bool treatingExternalAsImplicit) {
bool explicitInterface{proc.HasExplicitInterface()};
if (explicitInterface()) {
CheckExplicitInterface(proc, actuals, context, scope);
if (explicitInterface) {
auto buffer{CheckExplicitInterface(proc, actuals, context, scope)};
if (auto *msgs{context.messages().messages()}) {
msgs->Merge(std::move(buffer));
}
}
if (!explicitInterface || treatingExternalAsImplicit) {
parser::Messages buffer;

View File

@ -20,6 +20,7 @@
#include "../evaluate/call.h"
namespace Fortran::parser {
class Messages;
class ContextualMessages;
}
namespace Fortran::evaluate::characteristics {
@ -41,8 +42,9 @@ void CheckArguments(const evaluate::characteristics::Procedure &,
bool treatingExternalAsImplicit = false);
// Check actual arguments against a procedure with an explicit interface.
// Report an error and return false if not compatible.
bool CheckExplicitInterface(
const characteristics::Procedure &, ActualArguments &, FoldingContext &);
// Reports a buffer of errors when not compatible.
parser::Messages CheckExplicitInterface(
const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
const evaluate::FoldingContext &, const Scope &);
}
#endif

View File

@ -1559,20 +1559,18 @@ static bool CheckCompatibleArguments(
return true;
}
const Symbol *ExpressionAnalyzer::ResolveGeneric(
const Symbol &symbol, ActualArguments &actuals) {
const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
ActualArguments &actuals, const semantics::Scope &scope) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const auto &details{symbol.get<semantics::GenericDetails>()};
for (const Symbol *specific : details.specificProcs()) {
if (std::optional<characteristics::Procedure> procedure{
characteristics::Procedure::Characterize(
ProcedureDesignator{*specific}, context_.intrinsics())}) {
parser::Messages buffer;
parser::ContextualMessages messages{
context_.foldingContext().messages().at(), &buffer};
FoldingContext localContext{context_.foldingContext(), messages};
ActualArguments localActuals{actuals};
if (CheckExplicitInterface(*procedure, localActuals, localContext) &&
auto messages{CheckExplicitInterface(
*procedure, localActuals, GetFoldingContext(), scope)};
if (messages.empty() &&
CheckCompatibleArguments(*procedure, localActuals)) {
if (!procedure->IsElemental()) {
return specific; // takes priority over elemental match
@ -1592,7 +1590,8 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(
auto ExpressionAnalyzer::GetCalleeAndArguments(
const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
bool isSubroutine) -> std::optional<CalleeAndArguments> {
bool isSubroutine, const semantics::Scope &scope)
-> std::optional<CalleeAndArguments> {
return std::visit(
common::visitors{
[&](const parser::Name &n) -> std::optional<CalleeAndArguments> {
@ -1615,7 +1614,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
}
CheckForBadRecursion(n.source, ultimate);
if (ultimate.has<semantics::GenericDetails>()) {
symbol = ResolveGeneric(ultimate, arguments);
symbol = ResolveGeneric(ultimate, arguments, scope);
}
if (symbol) {
return CalleeAndArguments{
@ -1721,7 +1720,8 @@ MaybeExpr ExpressionAnalyzer::AnalyzeCall(
// TODO: map non-intrinsic generic procedure to specific procedure
if (std::optional<CalleeAndArguments> callee{
GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
std::move(*arguments), isSubroutine)}) {
std::move(*arguments), isSubroutine,
context_.FindScope(call.source))}) {
if (isSubroutine) {
CheckCall(call.source, callee->procedureDesignator, callee->arguments);
// TODO: Package the subroutine call as an expr in the parse tree

View File

@ -326,10 +326,11 @@ private:
const parser::Call &, bool isSubroutine);
std::optional<characteristics::Procedure> CheckCall(
parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
const Symbol *ResolveGeneric(const Symbol &, ActualArguments &);
const Symbol *ResolveGeneric(
const Symbol &, ActualArguments &, const semantics::Scope &);
std::optional<CalleeAndArguments> GetCalleeAndArguments(
const parser::ProcedureDesignator &, ActualArguments &&,
bool isSubroutine);
bool isSubroutine, const semantics::Scope &);
void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,