[flang-commits] [flang] 191d487 - [flang] Finer control over warnings
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue May 16 13:56:35 PDT 2023
Author: Peter Klausler
Date: 2023-05-16T13:56:24-07:00
New Revision: 191d48723f8b853a6ad65532c173c67155cbe606
URL: https://github.com/llvm/llvm-project/commit/191d48723f8b853a6ad65532c173c67155cbe606
DIFF: https://github.com/llvm/llvm-project/commit/191d48723f8b853a6ad65532c173c67155cbe606.diff
LOG: [flang] Finer control over warnings
Establish a set of optional usage warnings, and enable some
only in "-pedantic" mode that, in our subjective experience
with application codes, seem to issue frequently without
indicating usage that really needs to be corrected. By default,
with this patch the compiler should appear to be somewhat less
persnickety but not less informative.
Differential Revision: https://reviews.llvm.org/D150710
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Frontend/CompilerInvocation.h
flang/include/flang/Semantics/semantics.h
flang/lib/Frontend/CompilerInvocation.cpp
flang/lib/Semantics/assignment.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-call.h
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/lib/Semantics/pointer-assignment.h
flang/lib/Semantics/resolve-labels.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/assign09.f90
flang/test/Semantics/associate01.f90
flang/test/Semantics/bindings03.f90
flang/test/Semantics/call03.f90
flang/test/Semantics/call07.f90
flang/test/Semantics/call21.f90
flang/test/Semantics/call30.f90
flang/test/Semantics/call33.f90
flang/test/Semantics/call34.f90
flang/test/Semantics/resolve31.f90
flang/test/Semantics/resolve59.f90
flang/test/Semantics/structconst03.f90
flang/test/Semantics/structconst04.f90
flang/test/Semantics/transfer01.f90
flang/tools/f18-parse-demo/f18-parse-demo.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 390a971859233..987e56200ae62 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -16,6 +16,7 @@
namespace Fortran::common {
+// Non-conforming extensions & legacies
ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations,
XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions,
@@ -34,9 +35,17 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
- SaveMainProgram, SaveBigMainProgramVariables)
+ SaveMainProgram, SaveBigMainProgramVariables,
+ DistinctArrayConstructorLengths)
+
+// Portability and suspicious usage warnings for conforming code
+ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
+ NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
+ ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
+ PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
+using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
class LanguageFeatureControl {
public:
@@ -58,13 +67,22 @@ class LanguageFeatureControl {
}
LanguageFeatureControl(const LanguageFeatureControl &) = default;
void Enable(LanguageFeature f, bool yes = true) { disable_.set(f, !yes); }
- void EnableWarning(LanguageFeature f, bool yes = true) { warn_.set(f, yes); }
- void WarnOnAllNonstandard(bool yes = true) { warnAll_ = yes; }
+ void EnableWarning(LanguageFeature f, bool yes = true) {
+ warnLanguage_.set(f, yes);
+ }
+ void EnableWarning(UsageWarning w, bool yes = true) {
+ warnUsage_.set(w, yes);
+ }
+ void WarnOnAllNonstandard(bool yes = true) { warnAllLanguage_ = yes; }
+ void WarnOnAllUsage(bool yes = true) { warnAllUsage_ = yes; }
bool IsEnabled(LanguageFeature f) const { return !disable_.test(f); }
bool ShouldWarn(LanguageFeature f) const {
- return (warnAll_ && f != LanguageFeature::OpenMP &&
+ return (warnAllLanguage_ && f != LanguageFeature::OpenMP &&
f != LanguageFeature::OpenACC) ||
- warn_.test(f);
+ warnLanguage_.test(f);
+ }
+ bool ShouldWarn(UsageWarning w) const {
+ return warnAllUsage_ || warnUsage_.test(w);
}
// Return all spellings of operators names, depending on features enabled
std::vector<const char *> GetNames(LogicalOperator) const;
@@ -72,8 +90,10 @@ class LanguageFeatureControl {
private:
LanguageFeatures disable_;
- LanguageFeatures warn_;
- bool warnAll_{false};
+ LanguageFeatures warnLanguage_;
+ bool warnAllLanguage_{false};
+ UsageWarnings warnUsage_;
+ bool warnAllUsage_{false};
};
} // namespace Fortran::common
#endif // FORTRAN_COMMON_FORTRAN_FEATURES_H_
diff --git a/flang/include/flang/Frontend/CompilerInvocation.h b/flang/include/flang/Frontend/CompilerInvocation.h
index 58479c8418515..b3ea098ede57b 100644
--- a/flang/include/flang/Frontend/CompilerInvocation.h
+++ b/flang/include/flang/Frontend/CompilerInvocation.h
@@ -106,6 +106,7 @@ class CompilerInvocation : public CompilerInvocationBase {
Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
bool enableConformanceChecks = false;
+ bool enableUsageChecks = false;
/// Used in e.g. unparsing to dump the analyzed rather than the original
/// parse-tree objects.
@@ -184,6 +185,9 @@ class CompilerInvocation : public CompilerInvocationBase {
return enableConformanceChecks;
}
+ bool &getEnableUsageChecks() { return enableUsageChecks; }
+ const bool &getEnableUsageChecks() const { return enableUsageChecks; }
+
Fortran::parser::AnalyzedObjectsAsFortran &getAsFortran() {
return asFortran;
}
@@ -209,6 +213,9 @@ class CompilerInvocation : public CompilerInvocationBase {
// Enables the std=f2018 conformance check
void setEnableConformanceChecks() { enableConformanceChecks = true; }
+ // Enables the usage checks
+ void setEnableUsageChecks() { enableUsageChecks = true; }
+
/// Useful setters
void setModuleDir(std::string &dir) { moduleDir = dir; }
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 1c4654f6438b6..569147cfa7536 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -81,8 +81,8 @@ class SemanticsContext {
bool IsEnabled(common::LanguageFeature feature) const {
return languageFeatures_.IsEnabled(feature);
}
- bool ShouldWarn(common::LanguageFeature feature) const {
- return languageFeatures_.ShouldWarn(feature);
+ template <typename A> bool ShouldWarn(A x) const {
+ return languageFeatures_.ShouldWarn(x);
}
const std::optional<parser::CharBlock> &location() const { return location_; }
const std::vector<std::string> &searchDirectories() const {
@@ -93,7 +93,6 @@ class SemanticsContext {
}
const std::string &moduleDirectory() const { return moduleDirectory_; }
const std::string &moduleFileSuffix() const { return moduleFileSuffix_; }
- bool warnOnNonstandardUsage() const { return warnOnNonstandardUsage_; }
bool warningsAreErrors() const { return warningsAreErrors_; }
bool debugModuleWriter() const { return debugModuleWriter_; }
const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 6672777f34377..84478f26b4b86 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -774,8 +774,9 @@ static bool parseDialectArgs(CompilerInvocation &res, llvm::opt::ArgList &args,
// -pedantic
if (args.hasArg(clang::driver::options::OPT_pedantic)) {
res.setEnableConformanceChecks();
+ res.setEnableUsageChecks();
}
- // -std=f2018 (currently this implies -pedantic)
+ // -std=f2018
// TODO: Set proper options when more fortran standards
// are supported.
if (args.hasArg(clang::driver::options::OPT_std_EQ)) {
@@ -1045,9 +1046,11 @@ void CompilerInvocation::setFortranOpts() {
if (frontendOptions.needProvenanceRangeToCharBlockMappings)
fortranOptions.needProvenanceRangeToCharBlockMappings = true;
- if (getEnableConformanceChecks()) {
+ if (getEnableConformanceChecks())
fortranOptions.features.WarnOnAllNonstandard();
- }
+
+ if (getEnableUsageChecks())
+ fortranOptions.features.WarnOnAllUsage();
}
void CompilerInvocation::setSemanticsOpts(
@@ -1060,7 +1063,6 @@ void CompilerInvocation::setSemanticsOpts(
semanticsContext->set_moduleDirectory(getModuleDir())
.set_searchDirectories(fortranOptions.searchDirectories)
.set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
- .set_warnOnNonstandardUsage(getEnableConformanceChecks())
.set_warningsAreErrors(getWarnAsErr())
.set_moduleFileSuffix(getModuleFileSuffix());
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 26d539ace479f..ef53e25bd1c52 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -90,8 +90,7 @@ void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
parser::CharBlock at{context_.location().value()};
auto restorer{foldingContext().messages().SetLocation(at)};
- CheckPointerAssignment(
- foldingContext(), *assignment, context_.FindScope(at));
+ CheckPointerAssignment(context_, *assignment, context_.FindScope(at));
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 2d1c167249061..4d6eb30b3e114 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -104,16 +104,17 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
// the usage conforms to the standard and no warning is needed.
static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
const characteristics::DummyDataObject &dummy,
- characteristics::TypeAndShape &actualType,
- evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
+ characteristics::TypeAndShape &actualType, SemanticsContext &context,
+ parser::ContextualMessages &messages) {
if (dummy.type.type().category() == TypeCategory::Character &&
actualType.type().category() == TypeCategory::Character &&
dummy.type.type().kind() == actualType.type().kind()) {
if (dummy.type.LEN() && actualType.LEN()) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
auto dummyLength{
- ToInt64(Fold(context, common::Clone(*dummy.type.LEN())))};
+ ToInt64(Fold(foldingContext, common::Clone(*dummy.type.LEN())))};
auto actualLength{
- ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
+ ToInt64(Fold(foldingContext, common::Clone(*actualType.LEN())))};
if (dummyLength && actualLength && *actualLength != *dummyLength) {
if (dummy.attrs.test(
characteristics::DummyDataObject::Attr::Allocatable) ||
@@ -126,7 +127,8 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
messages.Say(
"Actual argument variable length '%jd' does not match the expected length '%jd'"_err_en_US,
*actualLength, *dummyLength);
- } else if (*actualLength < *dummyLength) {
+ } else if (*actualLength < *dummyLength &&
+ context.ShouldWarn(common::UsageWarning::ShortCharacterActual)) {
if (evaluate::IsVariable(actual)) {
messages.Say(
"Actual argument variable length '%jd' is less than expected length '%jd'"_warn_en_US,
@@ -188,12 +190,12 @@ static bool DefersSameTypeParameters(
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
characteristics::TypeAndShape &actualType, bool isElemental,
- evaluate::FoldingContext &context, const Scope *scope,
- const evaluate::SpecificIntrinsic *intrinsic,
+ SemanticsContext &context, evaluate::FoldingContext &foldingContext,
+ const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
bool allowActualArgumentConversions) {
// Basic type & rank checking
- parser::ContextualMessages &messages{context.messages()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
CheckCharacterActual(actual, dummy, actualType, context, messages);
bool dummyIsAllocatable{
dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
@@ -215,8 +217,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (!typesCompatible && dummy.type.Rank() == 0 &&
allowActualArgumentConversions) {
// Extension: pass Hollerith literal to scalar as if it had been BOZ
- if (auto converted{
- evaluate::HollerithToBOZ(context, actual, dummy.type.type())}) {
+ if (auto converted{evaluate::HollerithToBOZ(
+ foldingContext, actual, dummy.type.type())}) {
messages.Say(
"passing Hollerith or character literal as if it were BOZ"_port_en_US);
actual = *converted;
@@ -355,7 +357,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
: nullptr};
int actualRank{evaluate::GetRank(actualType.shape())};
- bool actualIsPointer{evaluate::IsObjectPointer(actual, context)};
+ bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
bool dummyIsAssumedRank{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedRank)};
if (dummy.type.attrs().test(
@@ -449,14 +451,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// llvm-project issue #58973: constant actual argument passed in where dummy
// argument is marked volatile
bool actualIsVariable{evaluate::IsVariable(actual)};
- if (dummyIsVolatile && !actualIsVariable) {
+ if (dummyIsVolatile && !actualIsVariable &&
+ context.ShouldWarn(common::UsageWarning::ExprPassedToVolatile)) {
messages.Say(
"actual argument associated with VOLATILE %s is not a variable"_warn_en_US,
dummyName);
}
// Cases when temporaries might be needed but must not be permitted.
- bool actualIsContiguous{IsSimplyContiguous(actual, context)};
+ bool actualIsContiguous{IsSimplyContiguous(actual, foldingContext)};
bool dummyIsAssumedShape{dummy.type.attrs().test(
characteristics::TypeAndShape::Attr::AssumedShape)};
bool dummyIsContiguous{
@@ -602,7 +605,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
// Warn about dubious actual argument association with a TARGET dummy argument
- if (dummy.attrs.test(characteristics::DummyDataObject::Attr::Target)) {
+ if (dummy.attrs.test(characteristics::DummyDataObject::Attr::Target) &&
+ context.ShouldWarn(common::UsageWarning::NonTargetPassedToTarget)) {
bool actualIsTemp{!actualIsVariable || HasVectorSubscript(actual) ||
evaluate::ExtractCoarrayRef(actual)};
if (actualIsTemp) {
@@ -623,8 +627,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
static void CheckProcedureArg(evaluate::ActualArgument &arg,
const characteristics::Procedure &proc,
const characteristics::DummyProcedure &dummy, const std::string &dummyName,
- evaluate::FoldingContext &context) {
- parser::ContextualMessages &messages{context.messages()};
+ SemanticsContext &context) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
auto restorer{
messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
const characteristics::Procedure &interface { dummy.procedure.value() };
@@ -651,7 +656,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
}
if (auto argChars{characteristics::DummyArgument::FromActual(
- "actual argument", *expr, context)}) {
+ "actual argument", *expr, foldingContext)}) {
if (!argChars->IsTypelessIntrinsicDummy()) {
if (auto *argProc{
std::get_if<characteristics::DummyProcedure>(&argChars->u)}) {
@@ -687,11 +692,10 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
messages.Say(
"Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
dummyName);
- } else {
+ } else if (context.ShouldWarn(
+ common::UsageWarning::ImplicitInterfaceActual)) {
messages.Say(
- "Actual procedure argument has an implicit interface "
- "which is not known to be compatible with %s which has an "
- "explicit interface"_warn_en_US,
+ "Actual procedure argument has an implicit interface which is not known to be compatible with %s which has an explicit interface"_warn_en_US,
dummyName);
}
}
@@ -775,10 +779,11 @@ static void ConvertBOZLiteralArg(
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
const characteristics::DummyArgument &dummy,
- const characteristics::Procedure &proc, evaluate::FoldingContext &context,
+ const characteristics::Procedure &proc, SemanticsContext &context,
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
bool allowActualArgumentConversions) {
- auto &messages{context.messages()};
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ auto &messages{foldingContext.messages()};
std::string dummyName{"dummy argument"};
if (!dummy.name.empty()) {
dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
@@ -802,12 +807,12 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
ConvertBOZLiteralArg(arg, object.type.type());
if (auto *expr{arg.UnwrapExpr()}) {
if (auto type{characteristics::TypeAndShape::Characterize(
- *expr, context)}) {
+ *expr, foldingContext)}) {
arg.set_dummyIntent(object.intent);
bool isElemental{
object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
- isElemental, context, scope, intrinsic,
+ isElemental, context, foldingContext, scope, intrinsic,
allowActualArgumentConversions);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
IsBOZLiteral(*expr)) {
@@ -1118,16 +1123,19 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
}
// TRANSFER (16.9.193)
-static void CheckTransferOperandType(parser::ContextualMessages &messages,
+static void CheckTransferOperandType(SemanticsContext &context,
const evaluate::DynamicType &type, const char *which) {
- if (type.IsPolymorphic()) {
- messages.Say("%s of TRANSFER is polymorphic"_warn_en_US, which);
+ if (type.IsPolymorphic() &&
+ context.ShouldWarn(common::UsageWarning::PolymorphicTransferArg)) {
+ context.foldingContext().messages().Say(
+ "%s of TRANSFER is polymorphic"_warn_en_US, which);
} else if (!type.IsUnlimitedPolymorphic() &&
- type.category() == TypeCategory::Derived) {
+ type.category() == TypeCategory::Derived &&
+ context.ShouldWarn(common::UsageWarning::PointerComponentTransferArg)) {
DirectComponentIterator directs{type.GetDerivedTypeSpec()};
if (auto bad{std::find_if(directs.begin(), directs.end(), IsDescriptor)};
bad != directs.end()) {
- evaluate::SayWithDeclaration(messages, *bad,
+ evaluate::SayWithDeclaration(context.foldingContext().messages(), *bad,
"%s of TRANSFER contains allocatable or pointer component %s"_warn_en_US,
which, bad.BuildResultDesignatorName());
}
@@ -1135,27 +1143,29 @@ static void CheckTransferOperandType(parser::ContextualMessages &messages,
}
static void CheckTransfer(evaluate::ActualArguments &arguments,
- evaluate::FoldingContext &context, const Scope *scope) {
+ SemanticsContext &context, const Scope *scope) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
if (arguments.size() >= 2) {
if (auto source{characteristics::TypeAndShape::Characterize(
- arguments[0], context)}) {
- CheckTransferOperandType(context.messages(), source->type(), "Source");
+ arguments[0], foldingContext)}) {
+ CheckTransferOperandType(context, source->type(), "Source");
if (auto mold{characteristics::TypeAndShape::Characterize(
- arguments[1], context)}) {
- CheckTransferOperandType(context.messages(), mold->type(), "Mold");
+ arguments[1], foldingContext)}) {
+ CheckTransferOperandType(context, mold->type(), "Mold");
if (mold->Rank() > 0 &&
evaluate::ToInt64(
- evaluate::Fold(
- context, mold->MeasureElementSizeInBytes(context, false)))
+ evaluate::Fold(foldingContext,
+ mold->MeasureElementSizeInBytes(foldingContext, false)))
.value_or(1) == 0) {
- if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(
- context, source->MeasureSizeInBytes(context)))}) {
+ if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ source->MeasureSizeInBytes(foldingContext)))}) {
if (*sourceSize > 0) {
- context.messages().Say(
+ messages.Say(
"Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
}
} else {
- context.messages().Say(
+ messages.Say(
"Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
}
}
@@ -1165,11 +1175,13 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
if (const Symbol *
whole{UnwrapWholeSymbolOrComponentDataRef(arguments[2])}) {
if (IsOptional(*whole)) {
- context.messages().Say(
+ messages.Say(
"SIZE= argument may not be the optional dummy argument '%s'"_err_en_US,
whole->name());
- } else if (IsAllocatableOrPointer(*whole)) {
- context.messages().Say(
+ } else if (context.ShouldWarn(
+ common::UsageWarning::TransferSizePresence) &&
+ IsAllocatableOrPointer(*whole)) {
+ messages.Say(
"SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
}
}
@@ -1178,10 +1190,10 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
}
static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
- evaluate::FoldingContext &context, const Scope *scope,
+ SemanticsContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic &intrinsic) {
if (intrinsic.name == "associated") {
- CheckAssociated(arguments, context, scope);
+ CheckAssociated(arguments, context.foldingContext(), scope);
} else if (intrinsic.name == "transfer") {
CheckTransfer(arguments, context, scope);
}
@@ -1189,13 +1201,14 @@ static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
static parser::Messages CheckExplicitInterface(
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
- const evaluate::FoldingContext &context, const Scope *scope,
+ SemanticsContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic *intrinsic,
bool allowActualArgumentConversions) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
parser::Messages buffer;
- parser::ContextualMessages messages{context.messages().at(), &buffer};
+ auto restorer{messages.SetMessages(buffer)};
RearrangeArguments(proc, actuals, messages);
- evaluate::FoldingContext localContext{context, messages};
if (!buffer.empty()) {
return buffer;
}
@@ -1203,8 +1216,8 @@ static parser::Messages CheckExplicitInterface(
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments.at(index++)};
if (actual) {
- CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
- intrinsic, allowActualArgumentConversions);
+ CheckExplicitInterfaceArg(*actual, dummy, proc, context, scope, intrinsic,
+ allowActualArgumentConversions);
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
@@ -1220,16 +1233,16 @@ static parser::Messages CheckExplicitInterface(
}
}
if (proc.IsElemental() && !buffer.AnyFatalError()) {
- CheckElementalConformance(messages, proc, actuals, localContext);
+ CheckElementalConformance(messages, proc, actuals, foldingContext);
}
if (intrinsic) {
- CheckSpecificIntrinsic(actuals, localContext, scope, *intrinsic);
+ CheckSpecificIntrinsic(actuals, context, scope, *intrinsic);
}
return buffer;
}
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
- evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
+ evaluate::ActualArguments &actuals, SemanticsContext &context,
bool allowActualArgumentConversions) {
return proc.HasExplicitInterface() &&
!CheckExplicitInterface(proc, actuals, context, nullptr, nullptr,
@@ -1289,18 +1302,19 @@ bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
}
bool CheckArguments(const characteristics::Procedure &proc,
- evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
+ evaluate::ActualArguments &actuals, SemanticsContext &context,
const Scope &scope, bool treatingExternalAsImplicit,
const evaluate::SpecificIntrinsic *intrinsic) {
bool explicitInterface{proc.HasExplicitInterface()};
- parser::ContextualMessages &messages{context.messages()};
+ evaluate::FoldingContext foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
if (!explicitInterface || treatingExternalAsImplicit) {
parser::Messages buffer;
{
auto restorer{messages.SetMessages(buffer)};
for (auto &actual : actuals) {
if (actual) {
- CheckImplicitInterfaceArg(*actual, messages, context);
+ CheckImplicitInterfaceArg(*actual, messages, foldingContext);
}
}
}
diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h
index 1d03f81a989fa..4275606225eb8 100644
--- a/flang/lib/Semantics/check-call.h
+++ b/flang/lib/Semantics/check-call.h
@@ -26,6 +26,7 @@ class FoldingContext;
namespace Fortran::semantics {
class Scope;
+class SemanticsContext;
// Argument treatingExternalAsImplicit should be true when the called procedure
// does not actually have an explicit interface at the call site, but
@@ -33,7 +34,7 @@ class Scope;
// defined at the top level in the same source file. Returns false if
// messages were created, true if all is well.
bool CheckArguments(const evaluate::characteristics::Procedure &,
- evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
+ evaluate::ActualArguments &, SemanticsContext &, const Scope &,
bool treatingExternalAsImplicit,
const evaluate::SpecificIntrinsic *intrinsic);
@@ -46,7 +47,7 @@ bool CheckArgumentIsConstantExprInRange(
// Checks actual arguments for the purpose of resolving a generic interface.
bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
- evaluate::ActualArguments &, const evaluate::FoldingContext &,
+ evaluate::ActualArguments &, SemanticsContext &,
bool allowActualArgumentConversions = false);
} // namespace Fortran::semantics
#endif
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index be9f498519551..3162af396efcc 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -859,7 +859,7 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
auto restorer{messages_.SetLocation(symbol.name())};
context_.set_location(symbol.name());
CheckInitialTarget(
- foldingContext_, *designator, *object->init(), DEREF(scope_));
+ context_, *designator, *object->init(), DEREF(scope_));
}
}
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index b90bfd3ff5c6c..7f61d2fc148ed 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -467,12 +467,11 @@ class DoContext {
}
void CheckDoControl(const parser::CharBlock &sourceLocation, bool isReal) {
- const bool warn{context_.warnOnNonstandardUsage() ||
- context_.ShouldWarn(common::LanguageFeature::RealDoControls)};
- if (isReal && !warn) {
- // No messages for the default case
- } else if (isReal && warn) {
- context_.Say(sourceLocation, "DO controls should be INTEGER"_port_en_US);
+ if (isReal) {
+ if (context_.ShouldWarn(common::LanguageFeature::RealDoControls)) {
+ context_.Say(
+ sourceLocation, "DO controls should be INTEGER"_port_en_US);
+ }
} else {
SayBadDoControl(sourceLocation);
}
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 1c1b07c422bac..ba3b41a75cad5 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -35,7 +35,8 @@ class FormatErrorReporter {
};
bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
- if (!msg.isError && !context_.warnOnNonstandardUsage()) {
+ if (!msg.isError &&
+ !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) {
return false;
}
parser::MessageFormattedText text{
@@ -904,8 +905,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
auto upper{Normalize(value)};
if (specValues.at(specKind).count(upper) == 0) {
if (specKind == IoSpecKind::Access && upper == "APPEND") {
- if (context_.languageFeatures().ShouldWarn(
- common::LanguageFeature::OpenAccessAppend)) {
+ if (context_.ShouldWarn(common::LanguageFeature::OpenAccessAppend)) {
context_.Say(source,
"ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value,
upper);
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 959c74b62d7cb..4fa8adbbc9a22 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -384,7 +384,8 @@ bool DataInitializationCompiler<DSV>::InitElement(
return true;
} else if (isProcPointer) {
if (evaluate::IsProcedure(*expr)) {
- if (CheckPointerAssignment(context, designator, *expr, DEREF(scope_))) {
+ if (CheckPointerAssignment(
+ exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
if (lastSymbol->has<ProcEntityDetails>()) {
GetImage().AddPointer(offsetSymbol.offset(), *expr);
return true;
@@ -405,7 +406,8 @@ bool DataInitializationCompiler<DSV>::InitElement(
exprAnalyzer_.Say(
"Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
expr->AsFortran(), DescribeElement());
- } else if (CheckInitialTarget(context, designator, *expr, DEREF(scope_))) {
+ } else if (CheckInitialTarget(
+ exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
GetImage().AddPointer(offsetSymbol.offset(), *expr);
return true;
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index d30465eef86e3..b946409d47837 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1613,7 +1613,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
values_.Push(std::move(*x));
if (auto thisLen{ToInt64(xType.LEN())}) {
if (constantLength_) {
- if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
+ if (exprAnalyzer_.context().ShouldWarn(
+ common::LanguageFeature::DistinctArrayConstructorLengths) &&
*thisLen != *constantLength_) {
if (!(messageDisplayedSet_ & 1)) {
exprAnalyzer_.Say(
@@ -1965,7 +1966,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
semantics::CheckStructConstructorPointerComponent(
- GetFoldingContext(), *symbol, *value, innermost);
+ context_, *symbol, *value, innermost);
result.Add(*symbol, Fold(std::move(*value)));
continue;
}
@@ -2395,7 +2396,7 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
}
}
if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
- GetFoldingContext(), false /* no integer conversions */) &&
+ context_, false /* no integer conversions */) &&
CheckCompatibleArguments(*procedure, localActuals)) {
if ((procedure->IsElemental() && elemental) ||
(!procedure->IsElemental() && nonElemental)) {
@@ -2933,7 +2934,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
Say(callSite,
"Assumed-length character function must be defined with a length to be called"_err_en_US);
}
- ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
+ ok &= semantics::CheckArguments(*chars, arguments, context_,
context_.FindScope(callSite), treatExternalAsImplicit,
specificIntrinsic);
if (procSymbol && !IsPureProcedure(*procSymbol)) {
@@ -2953,7 +2954,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
// Check a known global definition behind a local interface
if (auto globalChars{characteristics::Procedure::Characterize(
*global, context_.foldingContext())}) {
- semantics::CheckArguments(*globalChars, arguments, GetFoldingContext(),
+ semantics::CheckArguments(*globalChars, arguments, context_,
context_.FindScope(callSite), true,
nullptr /*not specific intrinsic*/);
}
@@ -4058,7 +4059,7 @@ bool ArgumentAnalyzer::OkLogicalIntegerAssignment(
} else {
return false;
}
- if (context_.context().languageFeatures().ShouldWarn(
+ if (context_.context().ShouldWarn(
common::LanguageFeature::LogicalIntegerAssignment)) {
context_.Say(std::move(*msg));
}
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index de6e78387b276..ba63159cee97c 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -40,16 +40,15 @@ using parser::MessageFormattedText;
class PointerAssignmentChecker {
public:
- PointerAssignmentChecker(evaluate::FoldingContext &context,
- const Scope &scope, parser::CharBlock source,
- const std::string &description)
+ PointerAssignmentChecker(SemanticsContext &context, const Scope &scope,
+ parser::CharBlock source, const std::string &description)
: context_{context}, scope_{scope}, source_{source}, description_{
description} {}
PointerAssignmentChecker(
- evaluate::FoldingContext &context, const Scope &scope, const Symbol &lhs)
+ SemanticsContext &context, const Scope &scope, const Symbol &lhs)
: context_{context}, scope_{scope}, source_{lhs.name()},
description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
- set_lhsType(TypeAndShape::Characterize(lhs, context));
+ set_lhsType(TypeAndShape::Characterize(lhs, foldingContext_));
set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
set_isVolatile(lhs.attrs().test(Attr::VOLATILE));
}
@@ -77,7 +76,8 @@ class PointerAssignmentChecker {
bool LhsOkForUnlimitedPoly() const;
template <typename... A> parser::Message *Say(A &&...);
- evaluate::FoldingContext &context_;
+ SemanticsContext &context_;
+ evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
const Scope &scope_;
const parser::CharBlock source_;
const std::string description_;
@@ -125,14 +125,14 @@ bool PointerAssignmentChecker::CharacterizeProcedure() {
if (!characterizedProcedure_) {
characterizedProcedure_ = true;
if (lhs_ && IsProcedure(*lhs_)) {
- procedure_ = Procedure::Characterize(*lhs_, context_);
+ procedure_ = Procedure::Characterize(*lhs_, foldingContext_);
}
}
return procedure_.has_value();
}
bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
- if (auto whyNot{WhyNotDefinable(context_.messages().at(), scope_,
+ if (auto whyNot{WhyNotDefinable(foldingContext_.messages().at(), scope_,
DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
if (auto *msg{Say(
"The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
@@ -190,7 +190,7 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
} else if (const Symbol * base{GetFirstSymbol(rhs)}) {
if (const char *why{WhyBaseObjectIsSuspicious(
base->GetUltimate(), scope_)}) { // C1594(3)
- evaluate::SayWithDeclaration(context_.messages(), *base,
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *base,
"A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
base->name(), why);
return false;
@@ -198,23 +198,26 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
}
}
if (isContiguous_) {
- if (auto contiguous{evaluate::IsContiguous(rhs, context_)}) {
+ if (auto contiguous{evaluate::IsContiguous(rhs, foldingContext_)}) {
if (!*contiguous) {
Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
return false;
}
- } else {
+ } else if (context_.ShouldWarn(
+ common::UsageWarning::PointerToPossibleNoncontiguous)) {
Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
}
}
// Warn about undefinable data targets
- if (auto because{
- WhyNotDefinable(context_.messages().at(), scope_, {}, rhs)}) {
- if (auto *msg{
- Say("Pointer target is not a definable variable"_warn_en_US)}) {
- msg->Attach(std::move(*because));
+ if (context_.ShouldWarn(common::UsageWarning::PointerToUndefinable)) {
+ if (auto because{WhyNotDefinable(
+ foldingContext_.messages().at(), scope_, {}, rhs)}) {
+ if (auto *msg{
+ Say("Pointer target is not a definable variable"_warn_en_US)}) {
+ msg->Attach(std::move(*because));
+ }
+ return false;
}
- return false;
}
return true;
}
@@ -232,7 +235,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
} else if (const auto *intrinsic{f.proc().GetSpecificIntrinsic()}) {
funcName = intrinsic->name;
}
- auto proc{Procedure::Characterize(f.proc(), context_)};
+ auto proc{Procedure::Characterize(f.proc(), foldingContext_)};
if (!proc) {
return false;
}
@@ -258,7 +261,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
} else if (lhsType_) {
const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
CHECK(frTypeAndShape);
- if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape,
+ if (!lhsType_->IsCompatibleWith(foldingContext_.messages(), *frTypeAndShape,
"pointer", "function result",
isBoundsRemapping_ /*omit shape check*/,
evaluate::CheckConformanceFlags::BothDeferredShape)) {
@@ -290,7 +293,7 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
} else if (!evaluate::GetLastTarget(GetSymbolVector(d))) { // C1025
msg = "In assignment to object %s, the target '%s' is not an object with"
" POINTER or TARGET attributes"_err_en_US;
- } else if (auto rhsType{TypeAndShape::Characterize(d, context_)}) {
+ } else if (auto rhsType{TypeAndShape::Characterize(d, foldingContext_)}) {
if (!lhsType_) {
msg = "%s associated with object '%s' with incompatible type or"
" shape"_err_en_US;
@@ -361,18 +364,19 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
if (const auto *subp{
symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
if (subp->stmtFunction()) {
- evaluate::SayWithDeclaration(context_.messages(), *symbol,
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
"Statement function '%s' may not be the target of a pointer assignment"_err_en_US,
symbol->name());
return false;
}
- } else if (symbol->has<ProcBindingDetails>()) {
- evaluate::SayWithDeclaration(context_.messages(), *symbol,
+ } else if (symbol->has<ProcBindingDetails>() &&
+ context_.ShouldWarn(common::UsageWarning::Portability)) {
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
"Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
symbol->name());
}
}
- if (auto chars{Procedure::Characterize(d, context_)}) {
+ if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
} else {
return Check(d.GetName(), false);
@@ -380,7 +384,7 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
}
bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
- if (auto chars{Procedure::Characterize(ref, context_)}) {
+ if (auto chars{Procedure::Characterize(ref, foldingContext_)}) {
if (chars->functionResult) {
if (const auto *proc{chars->functionResult->IsProcedurePointer()}) {
return Check(ref.proc().GetName(), true, proc);
@@ -407,7 +411,7 @@ bool PointerAssignmentChecker::LhsOkForUnlimitedPoly() const {
template <typename... A>
parser::Message *PointerAssignmentChecker::Say(A &&...x) {
- auto *msg{context_.messages().Say(std::forward<A>(x)...)};
+ auto *msg{foldingContext_.messages().Say(std::forward<A>(x)...)};
if (msg) {
if (lhs_) {
return evaluate::AttachDeclaration(msg, *lhs_);
@@ -477,15 +481,14 @@ static bool CheckPointerBounds(
return isBoundsRemapping;
}
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
+bool CheckPointerAssignment(SemanticsContext &context,
const evaluate::Assignment &assignment, const Scope &scope) {
return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
- CheckPointerBounds(context, assignment));
+ CheckPointerBounds(context.foldingContext(), assignment));
}
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
- const SomeExpr &lhs, const SomeExpr &rhs, const Scope &scope,
- bool isBoundsRemapping) {
+bool CheckPointerAssignment(SemanticsContext &context, const SomeExpr &lhs,
+ const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping) {
const Symbol *pointer{GetLastSymbol(lhs)};
if (!pointer) {
return false; // error was reported
@@ -497,16 +500,16 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
return lhsOk && rhsOk; // don't short-circuit
}
-bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &context,
+bool CheckStructConstructorPointerComponent(SemanticsContext &context,
const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
return PointerAssignmentChecker{context, scope, lhs}
.set_pointerComponentLHS(&lhs)
.Check(rhs);
}
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
- parser::CharBlock source, const std::string &description,
- const DummyDataObject &lhs, const SomeExpr &rhs, const Scope &scope) {
+bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
+ const std::string &description, const DummyDataObject &lhs,
+ const SomeExpr &rhs, const Scope &scope) {
return PointerAssignmentChecker{context, scope, source, description}
.set_lhsType(common::Clone(lhs.type))
.set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
@@ -514,9 +517,10 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
.Check(rhs);
}
-bool CheckInitialTarget(evaluate::FoldingContext &context,
- const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
- return evaluate::IsInitialDataTarget(init, &context.messages()) &&
+bool CheckInitialTarget(SemanticsContext &context, const SomeExpr &pointer,
+ const SomeExpr &init, const Scope &scope) {
+ return evaluate::IsInitialDataTarget(
+ init, &context.foldingContext().messages()) &&
CheckPointerAssignment(context, pointer, init, scope);
}
diff --git a/flang/lib/Semantics/pointer-assignment.h b/flang/lib/Semantics/pointer-assignment.h
index 95ed67d1de5ab..c6f89c4949146 100644
--- a/flang/lib/Semantics/pointer-assignment.h
+++ b/flang/lib/Semantics/pointer-assignment.h
@@ -18,28 +18,25 @@ namespace Fortran::evaluate::characteristics {
struct DummyDataObject;
}
-namespace Fortran::evaluate {
-class FoldingContext;
-}
-
namespace Fortran::semantics {
+class SemanticsContext;
class Symbol;
bool CheckPointerAssignment(
- evaluate::FoldingContext &, const evaluate::Assignment &, const Scope &);
-bool CheckPointerAssignment(evaluate::FoldingContext &, const SomeExpr &lhs,
+ SemanticsContext &, const evaluate::Assignment &, const Scope &);
+bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
-bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &,
- const Symbol &lhs, const SomeExpr &rhs, const Scope &);
-bool CheckPointerAssignment(evaluate::FoldingContext &,
- parser::CharBlock source, const std::string &description,
+bool CheckStructConstructorPointerComponent(
+ SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);
+bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
+ const std::string &description,
const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
const Scope &);
// Checks whether an expression is a valid static initializer for a
// particular pointer designator.
-bool CheckInitialTarget(evaluate::FoldingContext &, const SomeExpr &pointer,
+bool CheckInitialTarget(SemanticsContext &, const SomeExpr &pointer,
const SomeExpr &init, const Scope &);
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp
index 3a2dd61cab058..f849b2238b085 100644
--- a/flang/lib/Semantics/resolve-labels.cpp
+++ b/flang/lib/Semantics/resolve-labels.cpp
@@ -961,8 +961,7 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
TargetStatementEnum::CompatibleDo)) ||
(doTarget.isExecutableConstructEndStmt &&
ParentScope(scopes, doTarget.proxyForScope) == scope)) {
- if (context.warnOnNonstandardUsage() ||
- context.ShouldWarn(
+ if (context.ShouldWarn(
common::LanguageFeature::OldLabelDoEndStatements)) {
context
.Say(position,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 321f819e6b733..be9c130ca7e5d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2455,8 +2455,7 @@ bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
return false;
}
// TODO: check no INTENT(OUT) if dummy?
- if (context().languageFeatures().ShouldWarn(
- common::LanguageFeature::ForwardRefImplicitNone)) {
+ if (context().ShouldWarn(common::LanguageFeature::ForwardRefImplicitNone)) {
Say(symbol.name(),
"'%s' was used without (or before) being explicitly typed"_warn_en_US,
symbol.name());
@@ -3535,7 +3534,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
// C1560.
if (info.resultName && !distinctResultName) {
Say(info.resultName->source,
- "The function name should not appear in RESULT, references to '%s' "
+ "The function name should not appear in RESULT; references to '%s' "
"inside the function will be considered as references to the "
"result only"_warn_en_US,
name.source);
@@ -4915,16 +4914,14 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
derivedTypeInfo_.privateBindings = true;
} else if (!derivedTypeInfo_.privateComps) {
derivedTypeInfo_.privateComps = true;
- } else {
- Say("PRIVATE may not appear more than once in"
- " derived type components"_warn_en_US); // C738
+ } else { // C738
+ Say("PRIVATE should not appear more than once in derived type components"_warn_en_US);
}
return false;
}
bool DeclarationVisitor::Pre(const parser::SequenceStmt &) {
- if (derivedTypeInfo_.sequence) {
- Say("SEQUENCE may not appear more than once in"
- " derived type components"_warn_en_US); // C738
+ if (derivedTypeInfo_.sequence) { // C738
+ Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US);
}
derivedTypeInfo_.sequence = true;
return false;
diff --git a/flang/test/Semantics/assign09.f90 b/flang/test/Semantics/assign09.f90
index d8104b1dd60b1..d3c72f355dd8a 100644
--- a/flang/test/Semantics/assign09.f90
+++ b/flang/test/Semantics/assign09.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Procedure pointer assignments and argument association with intrinsic functions
program test
abstract interface
diff --git a/flang/test/Semantics/associate01.f90 b/flang/test/Semantics/associate01.f90
index 8916a3bab3228..6f8e52077990e 100644
--- a/flang/test/Semantics/associate01.f90
+++ b/flang/test/Semantics/associate01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Tests of selectors whose defining expressions are pointer-valued functions;
! they must be valid targets, but not pointers.
! (F'2018 11.1.3.3 p1) "The associating entity does not have the ALLOCATABLE or
diff --git a/flang/test/Semantics/bindings03.f90 b/flang/test/Semantics/bindings03.f90
index 84227348e2034..baa8432a2701e 100644
--- a/flang/test/Semantics/bindings03.f90
+++ b/flang/test/Semantics/bindings03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -pedantic
! Confirm a portability warning on use of a procedure binding apart from a call
module m
type t
diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90
index 7a860062262a9..c31f2cc3eb8db 100644
--- a/flang/test/Semantics/call03.f90
+++ b/flang/test/Semantics/call03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE
! dummy arguments.
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index 08465a965e6ac..71229875262b7 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Test 15.5.2.7 constraints and restrictions for POINTER dummy arguments.
module m
diff --git a/flang/test/Semantics/call21.f90 b/flang/test/Semantics/call21.f90
index 4877551b58f63..64b733288fdc0 100644
--- a/flang/test/Semantics/call21.f90
+++ b/flang/test/Semantics/call21.f90
@@ -1,4 +1,4 @@
-! RUN: %flang -fsyntax-only 2>&1 %s | FileCheck %s
+! RUN: %flang -fsyntax-only -pedantic 2>&1 %s | FileCheck %s
! Verifies that warnings issue when actual arguments with implicit
! interfaces are associated with dummy procedures and dummy procedure
! pointers whose interfaces are explicit.
diff --git a/flang/test/Semantics/call30.f90 b/flang/test/Semantics/call30.f90
index f6725cdafcd1a..3653c29faeeb4 100644
--- a/flang/test/Semantics/call30.f90
+++ b/flang/test/Semantics/call30.f90
@@ -1,5 +1,5 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
-! This test is responsible for checking the fix for passing non-variables as
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -pedantic
+! This test is responsible for checking the fix for passing non-variables as
! actual arguments to subroutines/functions whose corresponding dummy argument
! expects a VOLATILE variable
! c.f. llvm-project GitHub issue #58973
@@ -25,36 +25,33 @@ end subroutine vol_dum_int_arr
subroutine test_all_subprograms()
!WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
call vol_dum_int(6)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
call vol_dum_int(6+12)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
call vol_dum_int(6*12)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
call vol_dum_int(-6/2)
-
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
call vol_dum_real(3.141592653)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
- call vol_dum_real(3.141592653 + -10.6e-11)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+ call vol_dum_real(3.141592653 + (-10.6e-11))
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
call vol_dum_real(3.141592653 * 10.6e-11)
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
- call vol_dum_real(3.141592653 / -10.6e-11)
-
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+ call vol_dum_real(3.141592653 / (-10.6e-11))
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
call vol_dum_complex((1., 3.2))
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
call vol_dum_complex((1., 3.2) + (-2., 3.14))
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
call vol_dum_complex((1., 3.2) * (-2., 3.14))
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
call vol_dum_complex((1., 3.2) / (-2., 3.14))
-
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
call vol_dum_int_arr((/ 1, 2, 3, 4 /))
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
call vol_dum_int_arr(reshape((/ 1, 2, 3, 4 /), (/ 2, 2/)))
- !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
- call vol_dum_int_arr((/ 1, 2, 3, 4 /))
+ !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+ call vol_dum_int_arr((/ 1, 2, 3, 4 /))
end subroutine test_all_subprograms
end module m
diff --git a/flang/test/Semantics/call33.f90 b/flang/test/Semantics/call33.f90
index 92051afc216c1..2fc017f1e444f 100644
--- a/flang/test/Semantics/call33.f90
+++ b/flang/test/Semantics/call33.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
module m
contains
subroutine s1(x)
diff --git a/flang/test/Semantics/call34.f90 b/flang/test/Semantics/call34.f90
index 4f939f2425d1e..325a267309d46 100644
--- a/flang/test/Semantics/call34.f90
+++ b/flang/test/Semantics/call34.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
module m
contains
subroutine foo(a)
diff --git a/flang/test/Semantics/resolve31.f90 b/flang/test/Semantics/resolve31.f90
index 5f41cbfd5111e..0c604c0ee9734 100644
--- a/flang/test/Semantics/resolve31.f90
+++ b/flang/test/Semantics/resolve31.f90
@@ -49,9 +49,9 @@ module m4
type :: t1
private
sequence
- !WARNING: PRIVATE may not appear more than once in derived type components
+ !WARNING: PRIVATE should not appear more than once in derived type components
private
- !WARNING: SEQUENCE may not appear more than once in derived type components
+ !WARNING: SEQUENCE should not appear more than once in derived type components
sequence
real :: t1Field
end type
diff --git a/flang/test/Semantics/resolve59.f90 b/flang/test/Semantics/resolve59.f90
index a79c4a4620677..7458710c52d9c 100644
--- a/flang/test/Semantics/resolve59.f90
+++ b/flang/test/Semantics/resolve59.f90
@@ -59,10 +59,10 @@ real function rfunc(x)
x = acos(f5)
end function
! Sanity test: f18 handles C1560 violation by ignoring RESULT
- !WARNING: The function name should not appear in RESULT, references to 'f6' inside the function will be considered as references to the result only
+ !WARNING: The function name should not appear in RESULT; references to 'f6' inside the function will be considered as references to the result only
function f6() result(f6)
end function
- !WARNING: The function name should not appear in RESULT, references to 'f7' inside the function will be considered as references to the result only
+ !WARNING: The function name should not appear in RESULT; references to 'f7' inside the function will be considered as references to the result only
function f7() result(f7)
real :: x, f7
!ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
diff --git a/flang/test/Semantics/structconst03.f90 b/flang/test/Semantics/structconst03.f90
index f2e659fb8974d..7940ada944668 100644
--- a/flang/test/Semantics/structconst03.f90
+++ b/flang/test/Semantics/structconst03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Error tests for structure constructors: C1594 violations
! from assigning globally-visible data to POINTER components.
! test/Semantics/structconst04.f90 is this same test without type
diff --git a/flang/test/Semantics/structconst04.f90 b/flang/test/Semantics/structconst04.f90
index 728d2772039b7..f19852b95a607 100644
--- a/flang/test/Semantics/structconst04.f90
+++ b/flang/test/Semantics/structconst04.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Error tests for structure constructors: C1594 violations
! from assigning globally-visible data to POINTER components.
! This test is structconst03.f90 with the type parameters removed.
diff --git a/flang/test/Semantics/transfer01.f90 b/flang/test/Semantics/transfer01.f90
index 6cd8288e225cd..26f4f1b3eb62f 100644
--- a/flang/test/Semantics/transfer01.f90
+++ b/flang/test/Semantics/transfer01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Check errors in TRANSFER()
subroutine subr(o)
diff --git a/flang/tools/f18-parse-demo/f18-parse-demo.cpp b/flang/tools/f18-parse-demo/f18-parse-demo.cpp
index ae0a3c4fb9877..afaa18b018f1f 100644
--- a/flang/tools/f18-parse-demo/f18-parse-demo.cpp
+++ b/flang/tools/f18-parse-demo/f18-parse-demo.cpp
@@ -85,6 +85,7 @@ struct DriverOptions {
std::vector<std::string> searchDirectories{"."s}; // -I dir
bool forcedForm{false}; // -Mfixed or -Mfree appeared
bool warnOnNonstandardUsage{false}; // -Mstandard
+ bool warnOnSuspiciousUsage{false}; // -pedantic
bool warningsAreErrors{false}; // -Werror
Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1};
bool lineDirectives{true}; // -P disables
@@ -352,6 +353,9 @@ int main(int argc, char *const argv[]) {
Fortran::common::LanguageFeature::BackslashEscapes);
} else if (arg == "-Mstandard") {
driver.warnOnNonstandardUsage = true;
+ } else if (arg == "-pedantic") {
+ driver.warnOnNonstandardUsage = true;
+ driver.warnOnSuspiciousUsage = true;
} else if (arg == "-fopenmp") {
options.features.Enable(Fortran::common::LanguageFeature::OpenMP);
options.predefinitions.emplace_back("_OPENMP", "201511");
@@ -444,6 +448,9 @@ int main(int argc, char *const argv[]) {
if (driver.warnOnNonstandardUsage) {
options.features.WarnOnAllNonstandard();
}
+ if (driver.warnOnSuspiciousUsage) {
+ options.features.WarnOnAllUsage();
+ }
if (!options.features.IsEnabled(
Fortran::common::LanguageFeature::BackslashEscapes)) {
driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash"
More information about the flang-commits
mailing list