// Messages from prescanning have ProvenanceRange values for their locations,
// while messages from later phases have CharBlock values, since the
// conversion of cooked source stream locations to provenances is not
- // free and needs to be deferred, since many messages created during parsing
+ // free and needs to be deferred, and many messages created during parsing
// are speculative. Messages with ProvenanceRange locations are ordered
// before others for sorting.
return std::visit(
class ArgumentAnalyzer {
public:
explicit ArgumentAnalyzer(ExpressionAnalyzer &context) : context_{context} {}
+ ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source)
+ : context_{context}, source_{source} {}
bool fatalErrors() const { return fatalErrors_; }
ActualArguments &&GetActuals() {
CHECK(!fatalErrors_);
// Find and return a user-defined operator or report an error.
// The provided message is used if there is no such operator.
- MaybeExpr TryDefinedOp(const char *, parser::MessageFixedText &&);
+ MaybeExpr TryDefinedOp(
+ const char *, parser::MessageFixedText &&, bool isUserOp = false);
template<typename E>
MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) {
return TryDefinedOp(
std::optional<parser::StructureConstructor> *structureConstructor) {
const parser::Call &call{funcRef.v};
auto restorer{GetContextualMessages().SetLocation(call.source)};
- ArgumentAnalyzer analyzer{*this};
+ ArgumentAnalyzer analyzer{*this, call.source};
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
analyzer.Analyze(arg, false /* not subroutine call */);
}
void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
const parser::Call &call{callStmt.v};
auto restorer{GetContextualMessages().SetLocation(call.source)};
- ArgumentAnalyzer analyzer{*this};
+ ArgumentAnalyzer analyzer{*this, call.source};
for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
analyzer.Analyze(arg, true /* is subroutine call */);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
- ArgumentAnalyzer analyzer{*this};
+ ArgumentAnalyzer analyzer{*this, name.source};
analyzer.Analyze(std::get<1>(x.t));
- if (!analyzer.fatalErrors()) {
- if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
- CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
- return MakeFunctionRef(name.source,
- std::move(std::get<ProcedureDesignator>(callee->u)),
- std::move(callee->arguments));
- }
- }
- return std::nullopt;
+ return analyzer.TryDefinedOp(name.source.ToString().c_str(),
+ "No operator %s defined for %s"_err_en_US, true);
}
+
// Binary (dyadic) operations
template<template<typename> class OPR>
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
- ArgumentAnalyzer analyzer{*this};
+ ArgumentAnalyzer analyzer{*this, name.source};
analyzer.Analyze(std::get<1>(x.t));
analyzer.Analyze(std::get<2>(x.t));
- if (!analyzer.fatalErrors()) {
- if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
- CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
- return MakeFunctionRef(name.source,
- std::move(std::get<ProcedureDesignator>(callee->u)),
- std::move(callee->arguments));
- }
- }
- return std::nullopt;
+ return analyzer.TryDefinedOp(name.source.ToString().c_str(),
+ "No operator %s defined for %s and %s"_err_en_US, true);
}
static void CheckFuncRefToArrayElementRefHasSubscripts(
}
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
- const char *opr, parser::MessageFixedText &&error) {
+ const char *opr, parser::MessageFixedText &&error, bool isUserOp) {
if (AnyUntypedOperand()) {
context_.Say(
std::move(error), ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
}
{
auto restorer{context_.GetContextualMessages().DiscardMessages()};
- std::string oprNameString{"operator("s + opr + ')'};
+ std::string oprNameString{
+ isUserOp ? std::string{opr} : "operator("s + opr + ')'};
parser::CharBlock oprName{oprNameString};
const auto &scope{context_.context().FindScope(source_)};
if (Symbol * symbol{scope.FindSymbol(oprName)}) {
- parser::Name name{source_, symbol};
+ parser::Name name{symbol->name(), symbol};
if (auto result{context_.AnalyzeDefinedOp(name, GetActuals())}) {
return result;
}
MaybeExpr ArgumentAnalyzer::TryBoundOp(const Symbol &symbol, int passIndex) {
ActualArguments localActuals{actuals_};
- const auto *proc{GetBindingResolution(GetType(passIndex), symbol)};
+ const Symbol *proc{GetBindingResolution(GetType(passIndex), symbol)};
if (!proc) {
proc = &symbol;
- localActuals[passIndex]->set_isPassedObject();
+ localActuals.at(passIndex).value().set_isPassedObject();
}
return context_.MakeFunctionRef(
source_, ProcedureDesignator{*proc}, std::move(localActuals));
if (!type || !type->scope()) {
return nullptr;
}
- const Symbol *symbol{type->scope()->FindSymbol(oprName)};
+ const Symbol *symbol{type->scope()->FindComponent(oprName)};
if (!symbol) {
return nullptr;
}
Say(name,
"Logical constant '%s' may not be used as a defined operator"_err_en_US);
} else {
- Say(name, "Defined operator '%s' not found"_err_en_US);
+ // Resolved later in expression semantics
+ MakePlaceholder(name, MiscDetails::Kind::TypeBoundDefinedOp);
}
return false;
}
if (auto *scope{globalScope_.FindScope(source)}) {
return *scope;
} else {
- common::die("invalid source location");
+ common::die("SemanticsContext::FindScope(): invalid source location");
}
}
class MiscDetails {
public:
ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe,
- ComplexPartIm, KindParamInquiry, LenParamInquiry,
- SelectTypeAssociateName);
+ ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName,
+ TypeBoundDefinedOp);
MiscDetails(Kind kind) : kind_{kind} {}
Kind kind() const { return kind_; }
}
bool IsGenericDefinedOp(const Symbol &symbol) {
- const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()};
- return details && details->kind().IsDefinedOperator();
+ const Symbol &ultimate{symbol.GetUltimate()};
+ if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
+ return generic->kind().IsDefinedOperator();
+ } else if (const auto *misc{ultimate.detailsIf<MiscDetails>()}) {
+ return misc->kind() == MiscDetails::Kind::TypeBoundDefinedOp;
+ } else {
+ return false;
+ }
}
bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) {
! real(4) :: a(1_8:y%p2(x))
! end
!end
+
+module m3
+ type :: t1
+ contains
+ procedure, pass(x) :: p1 => f1
+ procedure :: p3 => f3
+ generic :: operator(.binary.) => p1
+ generic :: operator(.unary.) => p3
+ end type
+ type, extends(t1) :: t2
+ contains
+ procedure, pass(y) :: p2 => f2
+ generic :: operator(.binary.) => p2
+ end type
+contains
+ integer(8) pure function f1(x, y)
+ class(t1), intent(in) :: x
+ integer, intent(in) :: y
+ end
+ integer(8) pure function f2(x, y)
+ class(t1), intent(in) :: x
+ class(t2), intent(in) :: y
+ end
+ integer(8) pure function f3(x)
+ class(t1), intent(in) :: x
+ end
+ subroutine test1(x, y, a)
+ class(t1) :: x
+ integer :: y
+ real :: a(x .binary. y)
+ end
+ ! Resolve to operator in parent class
+ subroutine test2(x, y, a)
+ class(t2) :: x
+ integer :: y
+ real :: a(x .binary. y)
+ end
+ ! 2nd arg is passed object
+ subroutine test3(x, y, a)
+ class(t1) :: x
+ class(t2) :: y
+ real :: a(x .binary. y)
+ end
+ subroutine test4(x, y, a)
+ class(t1) :: x
+ class(t2) :: y
+ real :: a(.unary. x + .unary. y)
+ end
+end
+!Expect: m3.mod
+!module m3
+! type::t1
+! contains
+! procedure,pass(x)::p1=>f1
+! procedure::p3=>f3
+! generic::.binary.=>p1
+! generic::.unary.=>p3
+! end type
+! type,extends(t1)::t2
+! contains
+! procedure,pass(y)::p2=>f2
+! generic::.binary.=>p2
+! end type
+!contains
+! pure function f1(x,y)
+! class(t1),intent(in)::x
+! integer(4),intent(in)::y
+! integer(8)::f1
+! end
+! pure function f2(x,y)
+! class(t1),intent(in)::x
+! class(t2),intent(in)::y
+! integer(8)::f2
+! end
+! pure function f3(x)
+! class(t1),intent(in)::x
+! integer(8)::f3
+! end
+! subroutine test1(x,y,a)
+! class(t1)::x
+! integer(4)::y
+! real(4)::a(1_8:x%p1(y))
+! end
+! subroutine test2(x,y,a)
+! class(t2)::x
+! integer(4)::y
+! real(4)::a(1_8:x%p1(y))
+! end
+! subroutine test3(x,y,a)
+! class(t1)::x
+! class(t2)::y
+! real(4)::a(1_8:y%p2(x))
+! end
+! subroutine test4(x,y,a)
+! class(t1)::x
+! class(t2)::y
+! real(4)::a(1_8:x%p3()+y%p3())
+! end
+!end
logical :: a, b, c
x = y .foo. z ! OK: f_real
i = j .foo. k ! OK: f_integer
- !ERROR: No specific procedure of generic operator '.foo.' matches the actual arguments
+ !ERROR: No intrinsic or user-defined .FOO. matches operand types LOGICAL(4) and LOGICAL(4)
a = b .foo. c
end
subroutine s1(x, y, z)
logical :: x
real :: y, z
- !ERROR: Defined operator '.a.' not found
+ !ERROR: No operator .A. defined for REAL(4) and REAL(4)
x = y .a. z
- !ERROR: Defined operator '.o.' not found
+ !ERROR: No operator .O. defined for REAL(4) and REAL(4)
x = y .o. z
- !ERROR: Defined operator '.n.' not found
+ !ERROR: No operator .N. defined for REAL(4)
x = .n. y
- !ERROR: Defined operator '.xor.' not found
+ !ERROR: No operator .XOR. defined for REAL(4) and REAL(4)
x = y .xor. z
- !ERROR: Defined operator '.x.' not found
+ !ERROR: No operator .X. defined for REAL(4)
x = .x. y
end
end
complex :: y, z
!ERROR: No intrinsic or user-defined OPERATOR(.AND.) matches operand types COMPLEX(4) and COMPLEX(4)
x = y .and. z
- !ERROR: No specific procedure of generic operator '.a.' matches the actual arguments
+ !ERROR: No intrinsic or user-defined .A. matches operand types COMPLEX(4) and COMPLEX(4)
x = y .a. z
end
end