maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Add support for logical abbreviations and .XOR. 

Update the grammar to handle logical abbreviations (e.g. `.A.` for `.AND.`)
when the feature is enabled. Only support `.X.` when both XOR and
logical abbreviations are enabled.

Fix the driver to enable logical abbreviations with the
`-flogical-abbreviations` option. This was already documented in
`documentation/Extensions.md`.

Remove `parser::Expr::XOR` from the parse tree and immediately map
`.XOR.` to `.NEQV.` if that feature is enabled. This was already being
done during expression analysis anyway.

Add `LanguageFeatureControl::GetNames` to return all of the names of
a logical or relational operator, depending on which features are
enabled. Use these in both name resolution and expression analysis.
Add `Not` to `LogicalOperator` to help in those cases.

Fix handling of BOZ literals: A numeric operation with one real or
integer operand and the other a BOZ literal is intrinsic.
Also, unary plus with a BOZ literal operand is also intrinsic.

Original-commit: flang-compiler/f18@956bd50bc7
Reviewed-on: https://github.com/flang-compiler/f18/pull/815
This commit is contained in:
Tim Keith 2019-11-06 15:54:26 -08:00
parent cae50f01ff
commit 9b31cbe7db
25 changed files with 371 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
flang/lib/common/CMakeLists.txt
View File

@ -15,6 +15,7 @@
add_library(FortranCommon
Fortran.cc
default-kinds.cc
features.cc
idioms.cc
)

17
flang/lib/common/Fortran.cc
View File

@ -34,22 +34,19 @@ const char *AsFortran(LogicalOperator opr) {
case LogicalOperator::Or: return ".or.";
case LogicalOperator::Eqv: return ".eqv.";
case LogicalOperator::Neqv: return ".neqv.";
case LogicalOperator::Not: return ".not.";
}
}
const char *AsFortran(RelationalOperator opr) {
return *AllFortranNames(opr).begin();
}
std::vector<const char *> AllFortranNames(RelationalOperator opr) {
switch (opr) {
SWITCH_COVERS_ALL_CASES
case RelationalOperator::LT: return {"<", ".lt."};
case RelationalOperator::LE: return {"<=", ".le."};
case RelationalOperator::EQ: return {"==", ".eq."};
case RelationalOperator::NE: return {"/=", ".ne.", "<>"};
case RelationalOperator::GE: return {">=", ".ge."};
case RelationalOperator::GT: return {">", ".gt."};
case RelationalOperator::LT: return "<";
case RelationalOperator::LE: return "<=";
case RelationalOperator::EQ: return "==";
case RelationalOperator::NE: return "/=";
case RelationalOperator::GE: return ">=";
case RelationalOperator::GT: return ">";
}
}

4
flang/lib/common/Fortran.h
View File

@ -41,13 +41,11 @@ ENUM_CLASS(TypeParamAttr, Kind, Len)
ENUM_CLASS(NumericOperator, Power, Multiply, Divide, Add, Subtract)
const char *AsFortran(NumericOperator);
ENUM_CLASS(LogicalOperator, And, Or, Eqv, Neqv)
ENUM_CLASS(LogicalOperator, And, Or, Eqv, Neqv, Not)
const char *AsFortran(LogicalOperator);
ENUM_CLASS(RelationalOperator, LT, LE, EQ, NE, GE, GT)
const char *AsFortran(RelationalOperator);
// Map EQ to {"==", ".eq."}, for example.
std::vector<const char *> AllFortranNames(RelationalOperator);
ENUM_CLASS(Intent, Default, In, Out, InOut)

63
flang/lib/common/features.cc Normal file
View File

@ -0,0 +1,63 @@
// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
#include "features.h"
#include "Fortran.h"
#include "idioms.h"
namespace Fortran::common {
std::vector<const char *> LanguageFeatureControl::GetNames(
LogicalOperator opr) const {
std::vector<const char *> result;
result.push_back(AsFortran(opr));
if (opr == LogicalOperator::Neqv && IsEnabled(LanguageFeature::XOROperator)) {
result.push_back(".xor.");
}
if (IsEnabled(LanguageFeature::LogicalAbbreviations)) {
switch (opr) {
SWITCH_COVERS_ALL_CASES
case LogicalOperator::And: result.push_back(".a."); break;
case LogicalOperator::Or: result.push_back(".o."); break;
case LogicalOperator::Not: result.push_back(".n."); break;
case LogicalOperator::Neqv:
if (IsEnabled(LanguageFeature::XOROperator)) {
result.push_back(".x.");
}
break;
case LogicalOperator::Eqv: break;
}
}
return result;
}
std::vector<const char *> LanguageFeatureControl::GetNames(
RelationalOperator opr) const {
switch (opr) {
SWITCH_COVERS_ALL_CASES
case RelationalOperator::LT: return {".lt.", "<"};
case RelationalOperator::LE: return {".le.", "<="};
case RelationalOperator::EQ: return {".eq.", "=="};
case RelationalOperator::GE: return {".ge.", ">="};
case RelationalOperator::GT: return {".gt.", ">"};
case RelationalOperator::NE:
if (IsEnabled(LanguageFeature::AlternativeNE)) {
return {".ne.", "/=", "<>"};
} else {
return {".ne.", "/="};
}
}
}
}

11
flang/lib/common/features.h
View File

@ -15,8 +15,9 @@
#ifndef FORTRAN_COMMON_FEATURES_H_
#define FORTRAN_COMMON_FEATURES_H_
#include "../common/enum-set.h"
#include "../common/idioms.h"
#include "Fortran.h"
#include "enum-set.h"
#include "idioms.h"
namespace Fortran::common {
@ -34,8 +35,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
RealDoControls, EquivalenceNumericWithCharacter, AdditionalIntrinsics,
AnonymousParents, OldLabelDoEndStatements)
using LanguageFeatures =
common::EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
class LanguageFeatureControl {
public:
@ -57,6 +57,9 @@ public:
bool ShouldWarn(LanguageFeature f) const {
return (warnAll_ && f != LanguageFeature::OpenMP) || warn_.test(f);
}
// Return all spellings of operators names, depending on features enabled
std::vector<const char *> GetNames(LogicalOperator) const;
std::vector<const char *> GetNames(RelationalOperator) const;
private:
LanguageFeatures disable_;

1
flang/lib/evaluate/fold.cc
View File

@ -2502,6 +2502,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldOperation(
case LogicalOperator::Or: result = xt || yt; break;
case LogicalOperator::Eqv: result = xt == yt; break;
case LogicalOperator::Neqv: result = xt != yt; break;
case LogicalOperator::Not: DIE("not a binary operator");
}
return Expr<LOGICAL>{Constant<LOGICAL>{result}};
}

1
flang/lib/evaluate/formatting.cc
View File

@ -207,6 +207,7 @@ static constexpr Precedence GetPrecedence(const Expr<T> &expr) {
SWITCH_COVERS_ALL_CASES
case LogicalOperator::And: return Precedence::And;
case LogicalOperator::Or: return Precedence::Or;
case LogicalOperator::Not: return Precedence::Not;
case LogicalOperator::Eqv:
case LogicalOperator::Neqv: return Precedence::Equivalence;
}

1
flang/lib/evaluate/tools.cc
View File

@ -504,6 +504,7 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
Expr<SomeLogical> BinaryLogicalOperation(
LogicalOperator opr, Expr<SomeLogical> &&x, Expr<SomeLogical> &&y) {
CHECK(opr != LogicalOperator::Not);
return std::visit(
[=](auto &&xy) {
using Ty = ResultType<decltype(xy[0])>;

1
flang/lib/parser/dump-parse-tree.h
View File

@ -269,7 +269,6 @@ public:
NODE(parser::Expr, OR)
NODE(parser::Expr, EQV)
NODE(parser::Expr, NEQV)
NODE(parser::Expr, XOR)
NODE(parser::Expr, DefinedBinary)
NODE(parser::Expr, ComplexConstructor)
NODE(parser, External)

31
flang/lib/parser/grammar.h
View File

@ -178,12 +178,13 @@ constexpr auto namedIntrinsicOperator{
".EQV." >> pure(DefinedOperator::IntrinsicOperator::EQV) ||
".NEQV." >> pure(DefinedOperator::IntrinsicOperator::NEQV) ||
extension<LanguageFeature::XOROperator>(
".XOR." >> pure(DefinedOperator::IntrinsicOperator::XOR)) ||
".XOR." >> pure(DefinedOperator::IntrinsicOperator::NEQV)) ||
extension<LanguageFeature::LogicalAbbreviations>(
".N." >> pure(DefinedOperator::IntrinsicOperator::NOT) ||
".A." >> pure(DefinedOperator::IntrinsicOperator::AND) ||
".O." >> pure(DefinedOperator::IntrinsicOperator::OR) ||
".X." >> pure(DefinedOperator::IntrinsicOperator::XOR))};
extension<LanguageFeature::XOROperator>(
".X." >> pure(DefinedOperator::IntrinsicOperator::NEQV)))};
constexpr auto intrinsicOperator{
"**" >> pure(DefinedOperator::IntrinsicOperator::Power) ||
@ -1796,8 +1797,15 @@ constexpr struct AndOperand {
static inline std::optional<Expr> Parse(ParseState &);
} andOperand;
// Match a logical operator or, optionally, its abbreviation.
inline constexpr auto logicalOp(const char *op, const char *abbrev) {
return TokenStringMatch{op} ||
extension<LanguageFeature::LogicalAbbreviations>(
TokenStringMatch{abbrev});
}
inline std::optional<Expr> AndOperand::Parse(ParseState &state) {
static constexpr auto notOp{attempt(".NOT."_tok >> andOperand)};
static constexpr auto notOp{attempt(logicalOp(".NOT.", ".N.") >> andOperand)};
if (std::optional<Expr> negation{notOp.Parse(state)}) {
return Expr{Expr::NOT{std::move(*negation)}};
} else {
@ -1819,8 +1827,8 @@ constexpr struct OrOperand {
std::function<Expr(Expr &&)> logicalAnd{[&result](Expr &&right) {
return Expr{Expr::AND(std::move(result).value(), std::move(right))};
}};
auto more{
attempt(sourced(".AND." >> applyLambda(logicalAnd, andOperand)))};
auto more{attempt(sourced(
logicalOp(".AND.", ".A.") >> applyLambda(logicalAnd, andOperand)))};
while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
result->source.ExtendToCover(source);
@ -1843,7 +1851,8 @@ constexpr struct EquivOperand {
std::function<Expr(Expr &&)> logicalOr{[&result](Expr &&right) {
return Expr{Expr::OR(std::move(result).value(), std::move(right))};
}};
auto more{attempt(sourced(".OR." >> applyLambda(logicalOr, orOperand)))};
auto more{attempt(sourced(
logicalOp(".OR.", ".O.") >> applyLambda(logicalOr, orOperand)))};
while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
result->source.ExtendToCover(source);
@ -1870,13 +1879,11 @@ constexpr struct Level5Expr {
std::function<Expr(Expr &&)> neqv{[&result](Expr &&right) {
return Expr{Expr::NEQV(std::move(result).value(), std::move(right))};
}};
std::function<Expr(Expr &&)> logicalXor{[&result](Expr &&right) {
return Expr{Expr::XOR(std::move(result).value(), std::move(right))};
}};
auto more{attempt(sourced(".EQV." >> applyLambda(eqv, equivOperand) ||
".NEQV." >> applyLambda(neqv, equivOperand) ||
extension<LanguageFeature::XOROperator>(
".XOR." >> applyLambda(logicalXor, equivOperand))))};
(".NEQV."_tok ||
extension<LanguageFeature::XOROperator>(
logicalOp(".XOR.", ".X."))) >>
applyLambda(neqv, equivOperand)))};
while (std::optional<Expr> next{more.Parse(state)}) {
result = std::move(next);
result->source.ExtendToCover(source);

7
flang/lib/parser/parse-tree.h
View File

@ -577,7 +577,7 @@ WRAPPER_CLASS(DefinedOpName, Name);
struct DefinedOperator {
UNION_CLASS_BOILERPLATE(DefinedOperator);
ENUM_CLASS(IntrinsicOperator, Power, Multiply, Divide, Add, Subtract, Concat,
LT, LE, EQ, NE, GE, GT, NOT, AND, OR, XOR, EQV, NEQV)
LT, LE, EQ, NE, GE, GT, NOT, AND, OR, EQV, NEQV)
std::variant<DefinedOpName, IntrinsicOperator> u;
};
@ -1690,9 +1690,6 @@ struct Expr {
struct NEQV : public IntrinsicBinary {
using IntrinsicBinary::IntrinsicBinary;
};
struct XOR : public IntrinsicBinary {
using IntrinsicBinary::IntrinsicBinary;
};
// PGI/XLF extension: (x,y), not both constant
struct ComplexConstructor : public IntrinsicBinary {
@ -1720,7 +1717,7 @@ struct Expr {
LiteralConstant, common::Indirection<Designator>, ArrayConstructor,
StructureConstructor, common::Indirection<FunctionReference>, Parentheses,
UnaryPlus, Negate, NOT, PercentLoc, DefinedUnary, Power, Multiply, Divide,
Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV, XOR,
Add, Subtract, Concat, LT, LE, EQ, NE, GE, GT, AND, OR, EQV, NEQV,
DefinedBinary, ComplexConstructor>
u;
};

1
flang/lib/parser/unparse.cc
View File

@ -834,7 +834,6 @@ public:
void Unparse(const Expr::OR &x) { Walk(x.t, ".OR."); }
void Unparse(const Expr::EQV &x) { Walk(x.t, ".EQV."); }
void Unparse(const Expr::NEQV &x) { Walk(x.t, ".NEQV."); }
void Unparse(const Expr::XOR &x) { Walk(x.t, ".XOR."); }
void Unparse(const Expr::ComplexConstructor &x) {
Put('('), Walk(x.t, ","), Put(')');
}

77
flang/lib/semantics/expression.cc
View File

@ -47,6 +47,7 @@ using MaybeExpr =
// and appears here in namespace Fortran::evaluate for convenience.
namespace Fortran::evaluate {
using common::LanguageFeature;
using common::NumericOperator;
using common::TypeCategory;
@ -160,19 +161,28 @@ public:
bool IsIntrinsicRelational(RelationalOperator) const;
bool IsIntrinsicLogical() const;
bool IsIntrinsicNumeric() const;
bool IsIntrinsicNumeric(NumericOperator) const;
bool IsIntrinsicConcat() const;
// Find and return a user-defined operator for opr or report an error.
// 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(RelationalOperator, parser::MessageFixedText &&);
template<typename E>
MaybeExpr TryDefinedOp(E opr, parser::MessageFixedText &&msg) {
return TryDefinedOp(
context_.context().languageFeatures().GetNames(opr), std::move(msg));
}
private:
MaybeExpr TryDefinedOp(
std::vector<const char *>, parser::MessageFixedText &&);
std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
bool AreConformable() const;
const Symbol *FindDefinedOp(const char *) const;
std::optional<DynamicType> GetType(std::size_t) const;
bool IsBOZLiteral(std::size_t i) const {
return std::holds_alternative<BOZLiteralConstant>(GetAsExpr(i).u);
}
void SayNoMatch(const char *);
std::string TypeAsFortran(std::size_t);
bool AnyUntypedOperand();
@ -382,11 +392,10 @@ struct IntTypeVisitor {
if (!value.overflow) {
if (T::kind > kind) {
if (!isDefaultKind ||
!analyzer.context().IsEnabled(
common::LanguageFeature::BigIntLiterals)) {
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
return std::nullopt;
} else if (analyzer.context().ShouldWarn(
common::LanguageFeature::BigIntLiterals)) {
LanguageFeature::BigIntLiterals)) {
analyzer.Say(digits,
"Integer literal is too large for default INTEGER(KIND=%d); "
"assuming INTEGER(KIND=%d)"_en_US,
@ -1345,13 +1354,13 @@ MaybeExpr ExpressionAnalyzer::Analyze(
// T(1) or T(PT=PT(1)).
if (nextAnonymous == components.begin() && parentComponent != nullptr &&
valueType == DynamicType::From(*parentComponent) &&
context().IsEnabled(common::LanguageFeature::AnonymousParents)) {
context().IsEnabled(LanguageFeature::AnonymousParents)) {
auto iter{
std::find(components.begin(), components.end(), *parentComponent)};
if (iter != components.end()) {
symbol = parentComponent;
nextAnonymous = ++iter;
if (context().ShouldWarn(common::LanguageFeature::AnonymousParents)) {
if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
Say(source,
"Whole parent component '%s' in structure "
"constructor should not be anonymous"_en_US,
@ -1827,7 +1836,7 @@ static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
analyzer.Analyze(x.v);
if (analyzer.fatalErrors()) {
return std::nullopt;
} else if (analyzer.IsIntrinsicNumeric()) {
} else if (analyzer.IsIntrinsicNumeric(opr)) {
if (opr == NumericOperator::Add) {
return analyzer.GetAsExpr(0);
} else {
@ -1856,8 +1865,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
return AsGenericExpr(
LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.GetAsExpr(0).u)));
} else {
return analyzer.TryDefinedOp(
".not.", "Operand of %s must be LOGICAL; have %s"_err_en_US);
return analyzer.TryDefinedOp(LogicalOperator::Not,
"Operand of %s must be LOGICAL; have %s"_err_en_US);
}
}
@ -1902,7 +1911,7 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
analyzer.Analyze(std::get<1>(x.t));
if (analyzer.fatalErrors()) {
return std::nullopt;
} else if (analyzer.IsIntrinsicNumeric()) {
} else if (analyzer.IsIntrinsicNumeric(opr)) {
return NumericOperation<OPR>(context.GetContextualMessages(),
analyzer.GetAsExpr(0), analyzer.GetAsExpr(1),
context.GetDefaultKind(TypeCategory::Real));
@ -2033,8 +2042,8 @@ MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
std::get<Expr<SomeLogical>>(analyzer.GetAsExpr(0).u),
std::get<Expr<SomeLogical>>(analyzer.GetAsExpr(1).u)));
} else {
return analyzer.TryDefinedOp(AsFortran(opr),
"Operands of %s must be LOGICAL; have %s and %s"_err_en_US);
return analyzer.TryDefinedOp(
opr, "Operands of %s must be LOGICAL; have %s and %s"_err_en_US);
}
}
@ -2054,10 +2063,6 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NEQV &x) {
return LogicalBinaryHelper(*this, LogicalOperator::Neqv, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::XOR &x) {
return LogicalBinaryHelper(*this, LogicalOperator::Neqv, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
const auto &name{std::get<parser::DefinedOpName>(x.t).v};
ArgumentAnalyzer analyzer{*this};
@ -2436,10 +2441,28 @@ bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
}
}
bool ArgumentAnalyzer::IsIntrinsicNumeric() const {
return IsNumericTypeCategory(GetType(0)->category()) &&
(actuals_.size() == 1 ||
(AreConformable() && IsNumericTypeCategory(GetType(1)->category())));
bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
std::optional<DynamicType> type0{GetType(0)};
if (actuals_.size() == 1) {
if (IsBOZLiteral(0)) {
return opr == NumericOperator::Add;
} else {
return type0 && IsNumericTypeCategory(type0->category());
}
} else {
std::optional<DynamicType> type1{GetType(1)};
if (IsBOZLiteral(0) && type1) {
auto cat1{type1->category()};
return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
} else if (IsBOZLiteral(1) && type0) { // Integer/Real opr BOZ
auto cat0{type0->category()};
return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
} else {
return AreConformable() && type0 && type1 &&
IsNumericTypeCategory(type0->category()) &&
IsNumericTypeCategory(type1->category());
}
}
}
bool ArgumentAnalyzer::IsIntrinsicLogical() const {
@ -2481,13 +2504,13 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp(
}
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
RelationalOperator opr, parser::MessageFixedText &&error) {
for (const char *name : AllFortranNames(opr)) {
if (FindDefinedOp(name)) {
return TryDefinedOp(name, std::move(error));
std::vector<const char *> oprs, parser::MessageFixedText &&error) {
for (std::size_t i{1}; i < oprs.size(); ++i) {
if (FindDefinedOp(oprs[i])) {
return TryDefinedOp(oprs[i], std::move(error));
}
}
return TryDefinedOp(AsFortran(opr), std::move(error));
return TryDefinedOp(oprs[0], std::move(error));
}
std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(

1
flang/lib/semantics/expression.h
View File

@ -283,7 +283,6 @@ private:
MaybeExpr Analyze(const parser::Expr::OR &);
MaybeExpr Analyze(const parser::Expr::EQV &);
MaybeExpr Analyze(const parser::Expr::NEQV &);
MaybeExpr Analyze(const parser::Expr::XOR &);
MaybeExpr Analyze(const parser::Expr::DefinedBinary &);
template<typename A> MaybeExpr Analyze(const A &x) {
return Analyze(x.u); // default case

52
flang/lib/semantics/resolve-names-utils.cc
View File

@ -31,6 +31,8 @@
namespace Fortran::semantics {
using common::LanguageFeature;
using common::LogicalOperator;
using common::RelationalOperator;
using IntrinsicOperator = parser::DefinedOperator::IntrinsicOperator;
static GenericKind MapIntrinsicOperator(IntrinsicOperator);
@ -60,17 +62,17 @@ bool IsDefinedOperator(const SourceName &name) {
bool IsIntrinsicOperator(
const SemanticsContext &context, const SourceName &name) {
std::string str{name.ToString()};
std::set<std::string> intrinsics{".and.", ".eq.", ".eqv.", ".ge.", ".gt.",
".le.", ".lt.", ".ne.", ".neqv.", ".not.", ".or."};
if (intrinsics.count(str) > 0) {
return true;
for (int i{0}; i != common::LogicalOperator_enumSize; ++i) {
auto names{context.languageFeatures().GetNames(LogicalOperator{i})};
if (std::find(names.begin(), names.end(), str) != names.end()) {
return true;
}
}
if (context.IsEnabled(LanguageFeature::XOROperator) && str == ".xor.") {
return true;
}
if (context.IsEnabled(LanguageFeature::LogicalAbbreviations) &&
(str == ".n." || str == ".a" || str == ".o." || str == ".x.")) {
return true;
for (int i{0}; i != common::RelationalOperator_enumSize; ++i) {
auto names{context.languageFeatures().GetNames(RelationalOperator{i})};
if (std::find(names.begin(), names.end(), str) != names.end()) {
return true;
}
}
return false;
}
@ -85,27 +87,34 @@ bool IsLogicalConstant(
// The operators <, <=, >, >=, ==, and /= always have the same interpretations
// as the operators .LT., .LE., .GT., .GE., .EQ., and .NE., respectively.
std::forward_list<std::string> GenericSpecInfo::GetAllNames() const {
auto getNames{[&](const std::initializer_list<const char *> &names) {
std::forward_list<std::string> GenericSpecInfo::GetAllNames(
SemanticsContext &context) const {
auto getNames{[&](auto opr) {
std::forward_list<std::string> result;
for (const char *name : names) {
for (const char *name : context.languageFeatures().GetNames(opr)) {
result.emplace_front("operator("s + name + ')');
}
return result;
}};
switch (kind_) {
case GenericKind::OpGE: return getNames({".ge.", ">="});
case GenericKind::OpGT: return getNames({".gt.", ">"});
case GenericKind::OpLE: return getNames({".le.", "<="});
case GenericKind::OpLT: return getNames({".lt.", "<"});
case GenericKind::OpEQ: return getNames({".eq.", "=="});
case GenericKind::OpNE: return getNames({"<>", ".ne.", "/="});
case GenericKind::OpGE: return getNames(RelationalOperator::GE);
case GenericKind::OpGT: return getNames(RelationalOperator::GT);
case GenericKind::OpLE: return getNames(RelationalOperator::LE);
case GenericKind::OpLT: return getNames(RelationalOperator::LT);
case GenericKind::OpEQ: return getNames(RelationalOperator::EQ);
case GenericKind::OpNE: return getNames(RelationalOperator::NE);
case GenericKind::OpAND: return getNames(LogicalOperator::And);
case GenericKind::OpOR: return getNames(LogicalOperator::Or);
case GenericKind::OpEQV: return getNames(LogicalOperator::Eqv);
case GenericKind::OpNEQV: return getNames(LogicalOperator::Neqv);
case GenericKind::OpNOT: return getNames(LogicalOperator::Not);
default: return {symbolName_.value().ToString()};
}
}
Symbol *GenericSpecInfo::FindInScope(const Scope &scope) const {
for (const auto &name : GetAllNames()) {
Symbol *GenericSpecInfo::FindInScope(
SemanticsContext &context, const Scope &scope) const {
for (const auto &name : GetAllNames(context)) {
if (auto *symbol{scope.FindSymbol(SourceName{name})}) {
return symbol;
}
@ -192,7 +201,6 @@ static GenericKind MapIntrinsicOperator(IntrinsicOperator op) {
case IntrinsicOperator::NOT: return GenericKind::OpNOT;
case IntrinsicOperator::AND: return GenericKind::OpAND;
case IntrinsicOperator::OR: return GenericKind::OpOR;
case IntrinsicOperator::XOR: return GenericKind::OpXOR;
case IntrinsicOperator::EQV: return GenericKind::OpEQV;
case IntrinsicOperator::NEQV: return GenericKind::OpNEQV;
}

4
flang/lib/semantics/resolve-names-utils.h
View File

@ -64,11 +64,11 @@ public:
const SourceName &symbolName() const { return symbolName_.value(); }
// Some intrinsic operators have more than one name (e.g. `operator(.eq.)` and
// `operator(==)`). GetAllNames() returns them all, including symbolName.
std::forward_list<std::string> GetAllNames() const;
std::forward_list<std::string> GetAllNames(SemanticsContext &) const;
// Set the GenericKind in this symbol and resolve the corresponding
// name if there is one
void Resolve(Symbol *) const;
Symbol *FindInScope(const Scope &) const;
Symbol *FindInScope(SemanticsContext &, const Scope &) const;
private:
GenericKind kind_;

13
flang/lib/semantics/resolve-names.cc
View File

@ -2318,7 +2318,8 @@ void ModuleVisitor::AddUse(
void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
if (useModuleScope_) {
const auto &name{info.symbolName()};
auto rename{AddUse(name, name, info.FindInScope(*useModuleScope_))};
auto rename{
AddUse(name, name, info.FindInScope(context(), *useModuleScope_))};
info.Resolve(rename.use);
}
}
@ -2397,7 +2398,7 @@ void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
// Create a symbol in genericSymbol_ for this GenericSpec.
bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
if (auto *symbol{GenericSpecInfo{x}.FindInScope(currScope())}) {
if (auto *symbol{GenericSpecInfo{x}.FindInScope(context(), currScope())}) {
SetGenericSymbol(*symbol);
}
return false;
@ -3867,7 +3868,7 @@ bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
SourceName symbolName{info.symbolName()};
bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private
: derivedTypeInfo_.privateBindings};
auto *genericSymbol{info.FindInScope(currScope())};
auto *genericSymbol{info.FindInScope(context(), currScope())};
if (genericSymbol) {
if (!genericSymbol->has<GenericBindingDetails>()) {
genericSymbol = nullptr; // MakeTypeSymbol will report the error below
@ -3875,7 +3876,7 @@ bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) {
} else {
// look in parent types:
Symbol *inheritedSymbol{nullptr};
for (const auto &name : info.GetAllNames()) {
for (const auto &name : info.GetAllNames(context())) {
inheritedSymbol = FindInTypeOrParents(currScope(), SourceName{name});
if (inheritedSymbol) {
break;
@ -5611,7 +5612,7 @@ bool ModuleVisitor::Pre(const parser::AccessStmt &x) {
[=](const Indirection<parser::GenericSpec> &y) {
auto info{GenericSpecInfo{y.value()}};
const auto &symbolName{info.symbolName()};
if (auto *symbol{info.FindInScope(currScope())}) {
if (auto *symbol{info.FindInScope(context(), currScope())}) {
info.Resolve(&SetAccess(symbolName, accessAttr, symbol));
} else if (info.kind() == GenericKind::Name) {
info.Resolve(&SetAccess(symbolName, accessAttr));
@ -5710,7 +5711,7 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
return;
}
GenericDetails genericDetails;
if (Symbol * existing{info.FindInScope(currScope())}) {
if (Symbol * existing{info.FindInScope(context(), currScope())}) {
if (existing->has<GenericDetails>()) {
info.Resolve(existing);
return; // already have generic, add to it

3
flang/lib/semantics/semantics.h
View File

@ -66,6 +66,9 @@ public:
const common::IntrinsicTypeDefaultKinds &defaultKinds() const {
return defaultKinds_;
}
const common::LanguageFeatureControl &languageFeatures() const {
return languageFeatures_;
};
int GetDefaultKind(TypeCategory) const;
int doublePrecisionKind() const {
return defaultKinds_.doublePrecisionKind();

2
flang/lib/semantics/symbol.h
View File

@ -274,7 +274,7 @@ ENUM_CLASS(GenericKind, // Kinds of generic-spec
Name, DefinedOp, // these have a Name associated with them
Assignment, // user-defined assignment
OpPower, OpMultiply, OpDivide, OpAdd, OpSubtract, OpConcat, OpLT, OpLE,
OpEQ, OpNE, OpGE, OpGT, OpNOT, OpAND, OpOR, OpXOR, OpEQV, OpNEQV,
OpEQ, OpNE, OpGE, OpGT, OpNOT, OpAND, OpOR, OpEQV, OpNEQV, //
ReadFormatted, ReadUnformatted, WriteFormatted, WriteUnformatted)
class GenericBindingDetails {

1
flang/test/semantics/CMakeLists.txt
View File

@ -100,6 +100,7 @@ set(ERROR_TESTS
resolve61.f90
resolve62.f90
resolve63.f90
resolve64.f90
stop01.f90
structconst01.f90
structconst02.f90

55
flang/test/semantics/modfile33.f90
View File

@ -16,6 +16,8 @@
! Test by using generic function in a specification expression that needs
! to be written to a .mod file.
!OPTIONS: -flogical-abbreviations -fxor-operator
! Numeric operators
module m1
type :: t
@ -158,11 +160,25 @@ module m2
logical, intent(in) :: x
integer, intent(in) :: y
end
end interface
! Alternative spelling of .AND.
interface operator(.a.)
pure integer(8) function and_tt(x, y)
import :: t
type(t), intent(in) :: x, y
end
end interface
interface operator(.x.)
pure integer(8) function neqv_tt(x, y)
import :: t
type(t), intent(in) :: x, y
end
end interface
interface operator(.neqv.)
pure integer(8) function neqv_rr(x, y)
real, intent(in) :: x, y
end
end interface
contains
subroutine s1(x, y, z)
type(t) :: x
@ -172,12 +188,20 @@ contains
subroutine s2(x, y, z)
logical :: x
integer :: y
real :: z(x .and. y) ! resolves to and_li
real :: z(x .a. y) ! resolves to and_li
end
subroutine s3(x, y, z)
type(t) :: x, y
real :: z(x .and. y) ! resolves to and_tt
end
subroutine s4(x, y, z)
type(t) :: x, y
real :: z(x .neqv. y) ! resolves to neqv_tt
end
subroutine s5(x, y, z)
real :: x, y
real :: z(x .xor. y) ! resolves to neqv_rr
end
end
!Expect: m2.mod
@ -213,6 +237,25 @@ end
! integer(8) :: and_tt
! end
! end interface
! interface operator(.x.)
! procedure :: neqv_tt
! procedure :: neqv_rr
! end interface
! interface
! pure function neqv_tt(x, y)
! import :: t
! type(t), intent(in) :: x
! type(t), intent(in) :: y
! integer(8) :: neqv_tt
! end
! end interface
! interface
! pure function neqv_rr(x, y)
! real(4), intent(in) :: x
! real(4), intent(in) :: y
! integer(8) :: neqv_rr
! end
! end interface
!contains
! subroutine s1(x, y, z)
! type(t) :: x
@ -229,6 +272,16 @@ end
! type(t) :: y
! real(4) :: z(1_8:and_tt(x, y))
! end
! subroutine s4(x, y, z)
! type(t) :: x
! type(t) :: y
! real(4) :: z(1_8:neqv_tt(x, y))
! end
! subroutine s5(x, y, z)
! real(4) :: x
! real(4) :: y
! real(4) :: z(1_8:neqv_rr(x, y))
! end
!end
! Relational operators

58
flang/test/semantics/resolve63.f90
View File

@ -104,7 +104,7 @@ module m2
logical :: l
contains
subroutine test_relational()
!ERROR: Operands of == must have comparable types; have TYPE(t) and REAL(4)
!ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4)
l = x == r
end
subroutine test_numeric()
@ -150,12 +150,60 @@ contains
logical :: x
integer :: y
logical :: l
!TODO: these should work
!y = y + z'1' !OK
!y = +z'1' !OK
complex :: z
y = y + z'1' !OK
!ERROR: Operands of + must be numeric; have untyped and COMPLEX(4)
z = z'1' + z
y = +z'1' !OK
!ERROR: Operand of unary - must be numeric; have untyped
y = -z'1'
!ERROR: Operands of + must be numeric; have LOGICAL(4) and untyped
y = x + z'1'
!ERROR: Operands of /= must have comparable types; have LOGICAL(4) and untyped
!ERROR: Operands of .NE. must have comparable types; have LOGICAL(4) and untyped
l = x /= null()
end
end
! Test alternate operators. They aren't enabled by default so should be
! treated as defined operators, not intrinsic ones.
module m4
contains
subroutine s1(x, y, z)
logical :: x
real :: y, z
!ERROR: Defined operator '.a.' not found
x = y .a. z
!ERROR: Defined operator '.o.' not found
x = y .o. z
!ERROR: Defined operator '.n.' not found
x = .n. y
!ERROR: Defined operator '.xor.' not found
x = y .xor. z
!ERROR: Defined operator '.x.' not found
x = .x. y
end
end
! Like m4 in resolve63 but compiled with different options.
! .A. is a defined operator.
module m5
interface operator(.A.)
logical function f1(x, y)
integer, intent(in) :: x, y
end
end interface
interface operator(.and.)
logical function f2(x, y)
real, intent(in) :: x, y
end
end interface
contains
subroutine s1(x, y, z)
logical :: x
complex :: y, z
!ERROR: No user-defined or intrinsic .AND. operator matches operand types COMPLEX(4) and COMPLEX(4)
x = y .and. z
!ERROR: No specific procedure of generic operator '.a.' matches the actual arguments
x = y .a. z
end
end

59
flang/test/semantics/resolve64.f90 Normal file
View File

@ -0,0 +1,59 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!OPTIONS: -flogical-abbreviations -fxor-operator
! Like m4 in resolve63 but compiled with different options.
! Alternate operators are enabled so treat these as intrinsic.
module m4
contains
subroutine s1(x, y, z)
logical :: x
real :: y, z
!ERROR: Operands of .AND. must be LOGICAL; have REAL(4) and REAL(4)
x = y .a. z
!ERROR: Operands of .OR. must be LOGICAL; have REAL(4) and REAL(4)
x = y .o. z
!ERROR: Operand of .NOT. must be LOGICAL; have REAL(4)
x = .n. y
!ERROR: Operands of .NEQV. must be LOGICAL; have REAL(4) and REAL(4)
x = y .xor. z
!ERROR: Operands of .NEQV. must be LOGICAL; have REAL(4) and REAL(4)
x = y .x. y
end
end
! Like m4 in resolve63 but compiled with different options.
! Alternate operators are enabled so treat .A. as .AND.
module m5
interface operator(.A.)
logical function f1(x, y)
integer, intent(in) :: x, y
end
end interface
interface operator(.and.)
logical function f2(x, y)
real, intent(in) :: x, y
end
end interface
contains
subroutine s1(x, y, z)
logical :: x
complex :: y, z
!ERROR: No user-defined or intrinsic .A. operator matches operand types COMPLEX(4) and COMPLEX(4)
x = y .and. z
!ERROR: No user-defined or intrinsic .A. operator matches operand types COMPLEX(4) and COMPLEX(4)
x = y .a. z
end
end

2
flang/test/semantics/test_modfile.sh
View File

@ -35,7 +35,7 @@ for src in "$@"; do
(
cd $temp
ls -1 *.mod > prev_files
$F18 $F18_OPTIONS $src
$F18 $F18_OPTIONS $USER_OPTIONS $src
ls -1 *.mod | comm -13 prev_files -
) > $actual_files
expected_files=$(sed -n 's/^!Expect: \(.*\)/\1/p' $src | sort)

7
flang/tools/f18/f18.cc
View File

@ -459,6 +459,11 @@ int main(int argc, char *const argv[]) {
} else if (arg == "-fxor-operator" || arg == "-fno-xor-operator") {
options.features.Enable(Fortran::common::LanguageFeature::XOROperator,
arg == "-fxor-operator");
} else if (arg == "-flogical-abbreviations" ||
arg == "-fno-logical-abbreviations") {
options.features.Enable(
Fortran::parser::LanguageFeature::LogicalAbbreviations,
arg == "-flogical-abbreviations");
} else if (arg == "-fdebug-dump-provenance") {
driver.dumpProvenance = true;
options.needProvenanceRangeToCharBlockMappings = true;
@ -546,6 +551,8 @@ int main(int argc, char *const argv[]) {
<< " -f[no-]backslash enable[disable] \\escapes in literals\n"
<< " -M[no]backslash disable[enable] \\escapes in literals\n"
<< " -Mstandard enable conformance warnings\n"
<< " -fenable=<feature> enable a language feature\n"
<< " -fdisable=<feature> disable a language feature\n"
<< " -r8 | -fdefault-real-8 | -i8 | -fdefault-integer-8 "
"change default kinds of intrinsic types\n"
<< " -Werror treat warnings as errors\n"