[flang-commits] [flang] 0f973ac - [flang] Tag warnings with LanguageFeature or UsageWarning (#110304)
via flang-commits
flang-commits at lists.llvm.org
Wed Oct 2 08:54:53 PDT 2024
Author: Peter Klausler
Date: 2024-10-02T08:54:49-07:00
New Revision: 0f973ac783aa100cfbce1cd2c6e8a3a8f648fae7
URL: https://github.com/llvm/llvm-project/commit/0f973ac783aa100cfbce1cd2c6e8a3a8f648fae7
DIFF: https://github.com/llvm/llvm-project/commit/0f973ac783aa100cfbce1cd2c6e8a3a8f648fae7.diff
LOG: [flang] Tag warnings with LanguageFeature or UsageWarning (#110304)
(This is a big patch, but it's nearly an NFC. No test results have
changed and all Fortran tests in the LLVM test suites work as expected.)
Allow a parser::Message for a warning to be marked with the
common::LanguageFeature or common::UsageWarning that controls it. This
will allow a later patch to add hooks whereby a driver will be able to
decorate warning messages with the names of its options that enable each
particular warning, and to add hooks whereby a driver can map those
enumerators by name to command-line options that enable/disable the
language feature and enable/disable the messages.
The default settings in the constructor for LanguageFeatureControl were
moved from its header file into its C++ source file.
Hooks for a driver to use to map the name of a feature or warning to its
enumerator were also added.
To simplify the tagging of warnings with their corresponding language
feature or usage warning, to ensure that they are properly controlled by
ShouldWarn(), and to ensure that warnings never issue at code sites in
module files, two new Warn() member function templates were added to
SemanticsContext and other contextual frameworks. Warn() can't be used
before source locations can be mapped to scopes, but the bulk of
existing code blocks testing ShouldWarn() and FindModuleFile() before
calling Say() were convertible into calls to Warn(). The ones that were
not convertible were extended with explicit calls to
Message::set_languageFeature() and set_usageWarning().
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Parser/message.h
flang/include/flang/Semantics/expression.h
flang/include/flang/Semantics/semantics.h
flang/lib/Common/Fortran-features.cpp
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/common.cpp
flang/lib/Evaluate/fold-character.cpp
flang/lib/Evaluate/fold-complex.cpp
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/fold-logical.cpp
flang/lib/Evaluate/fold-matmul.h
flang/lib/Evaluate/fold-real.cpp
flang/lib/Evaluate/fold-reduction.h
flang/lib/Evaluate/host.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Parser/message.cpp
flang/lib/Parser/preprocessor.cpp
flang/lib/Parser/prescan.cpp
flang/lib/Semantics/check-acc-structure.cpp
flang/lib/Semantics/check-allocate.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-case.cpp
flang/lib/Semantics/check-cuda.cpp
flang/lib/Semantics/check-data.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/check-directive-structure.h
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-return.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/definable.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/lib/Semantics/resolve-directives.cpp
flang/lib/Semantics/resolve-labels.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/semantics.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 86c6e02b0f2ffd..f813cbae40a57e 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -12,6 +12,7 @@
#include "flang/Common/Fortran.h"
#include "flang/Common/enum-set.h"
#include "flang/Common/idioms.h"
+#include <optional>
#include <vector>
namespace Fortran::common {
@@ -48,7 +49,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
ImpliedDoIndexScope, DistinctCommonSizes, OddIndexVariableRestrictions,
IndistinguishableSpecifics, SubroutineAndFunctionSpecifics,
EmptySequenceType, NonSequenceCrayPointee, BranchIntoConstruct,
- BadBranchTarget, ConvertedArgument, HollerithPolymorphic, ListDirectedSize,
+ BadBranchTarget, HollerithPolymorphic, ListDirectedSize,
NonBindCInteroperability, CudaManaged, CudaUnified,
PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
@@ -76,80 +77,12 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
+std::optional<LanguageFeature> FindLanguageFeature(const char *);
+std::optional<UsageWarning> FindUsageWarning(const char *);
+
class LanguageFeatureControl {
public:
- LanguageFeatureControl() {
- // These features must be explicitly enabled by command line options.
- disable_.set(LanguageFeature::OldDebugLines);
- disable_.set(LanguageFeature::OpenACC);
- disable_.set(LanguageFeature::OpenMP);
- disable_.set(LanguageFeature::CUDA); // !@cuf
- disable_.set(LanguageFeature::CudaManaged);
- disable_.set(LanguageFeature::CudaUnified);
- disable_.set(LanguageFeature::ImplicitNoneTypeNever);
- disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
- disable_.set(LanguageFeature::DefaultSave);
- disable_.set(LanguageFeature::SaveMainProgram);
- // These features, if enabled, conflict with valid standard usage,
- // so there are disabled here by default.
- disable_.set(LanguageFeature::BackslashEscapes);
- disable_.set(LanguageFeature::LogicalAbbreviations);
- disable_.set(LanguageFeature::XOROperator);
- disable_.set(LanguageFeature::OldStyleParameter);
- // These warnings are enabled by default, but only because they used
- // to be unconditional. TODO: prune this list
- warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);
- warnLanguage_.set(LanguageFeature::RedundantAttribute);
- warnLanguage_.set(LanguageFeature::SubroutineAndFunctionSpecifics);
- warnLanguage_.set(LanguageFeature::EmptySequenceType);
- warnLanguage_.set(LanguageFeature::NonSequenceCrayPointee);
- warnLanguage_.set(LanguageFeature::BranchIntoConstruct);
- warnLanguage_.set(LanguageFeature::BadBranchTarget);
- warnLanguage_.set(LanguageFeature::ConvertedArgument);
- warnLanguage_.set(LanguageFeature::HollerithPolymorphic);
- warnLanguage_.set(LanguageFeature::ListDirectedSize);
- warnUsage_.set(UsageWarning::ShortArrayActual);
- warnUsage_.set(UsageWarning::FoldingException);
- warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
- warnUsage_.set(UsageWarning::FoldingValueChecks);
- warnUsage_.set(UsageWarning::FoldingFailure);
- warnUsage_.set(UsageWarning::FoldingLimit);
- warnUsage_.set(UsageWarning::Interoperability);
- warnUsage_.set(UsageWarning::Bounds);
- warnUsage_.set(UsageWarning::Preprocessing);
- warnUsage_.set(UsageWarning::Scanning);
- warnUsage_.set(UsageWarning::OpenAccUsage);
- warnUsage_.set(UsageWarning::ProcPointerCompatibility);
- warnUsage_.set(UsageWarning::VoidMold);
- warnUsage_.set(UsageWarning::KnownBadImplicitInterface);
- warnUsage_.set(UsageWarning::EmptyCase);
- warnUsage_.set(UsageWarning::CaseOverflow);
- warnUsage_.set(UsageWarning::CUDAUsage);
- warnUsage_.set(UsageWarning::IgnoreTKRUsage);
- warnUsage_.set(UsageWarning::ExternalInterfaceMismatch);
- warnUsage_.set(UsageWarning::DefinedOperatorArgs);
- warnUsage_.set(UsageWarning::Final);
- warnUsage_.set(UsageWarning::ZeroDoStep);
- warnUsage_.set(UsageWarning::UnusedForallIndex);
- warnUsage_.set(UsageWarning::OpenMPUsage);
- warnUsage_.set(UsageWarning::ModuleFile);
- warnUsage_.set(UsageWarning::DataLength);
- warnUsage_.set(UsageWarning::IgnoredDirective);
- warnUsage_.set(UsageWarning::HomonymousSpecific);
- warnUsage_.set(UsageWarning::HomonymousResult);
- warnUsage_.set(UsageWarning::IgnoredIntrinsicFunctionType);
- warnUsage_.set(UsageWarning::PreviousScalarUse);
- warnUsage_.set(UsageWarning::RedeclaredInaccessibleComponent);
- warnUsage_.set(UsageWarning::ImplicitShared);
- warnUsage_.set(UsageWarning::IndexVarRedefinition);
- warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
- warnUsage_.set(UsageWarning::BadTypeForTarget);
- warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
- warnUsage_.set(UsageWarning::UndefinedFunctionResult);
- warnUsage_.set(UsageWarning::UselessIomsg);
- // New warnings, on by default
- warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
- }
+ LanguageFeatureControl();
LanguageFeatureControl(const LanguageFeatureControl &) = default;
void Enable(LanguageFeature f, bool yes = true) { disable_.set(f, !yes); }
diff --git a/flang/include/flang/Parser/message.h b/flang/include/flang/Parser/message.h
index 668559aeec9478..bc38f571ca3df4 100644
--- a/flang/include/flang/Parser/message.h
+++ b/flang/include/flang/Parser/message.h
@@ -15,6 +15,7 @@
#include "char-block.h"
#include "char-set.h"
#include "provenance.h"
+#include "flang/Common/Fortran-features.h"
#include "flang/Common/idioms.h"
#include "flang/Common/reference-counted.h"
#include "flang/Common/restorer.h"
@@ -202,6 +203,26 @@ class Message : public common::ReferenceCounted<Message> {
Message(ProvenanceRange pr, const MessageExpectedText &t)
: location_{pr}, text_{t} {}
+ Message(common::LanguageFeature feature, ProvenanceRange pr,
+ const MessageFixedText &t)
+ : location_{pr}, text_{t}, languageFeature_{feature} {}
+ Message(common::LanguageFeature feature, ProvenanceRange pr,
+ const MessageFormattedText &s)
+ : location_{pr}, text_{s}, languageFeature_{feature} {}
+ Message(common::LanguageFeature feature, ProvenanceRange pr,
+ MessageFormattedText &&s)
+ : location_{pr}, text_{std::move(s)}, languageFeature_{feature} {}
+
+ Message(common::UsageWarning warning, ProvenanceRange pr,
+ const MessageFixedText &t)
+ : location_{pr}, text_{t}, usageWarning_{warning} {}
+ Message(common::UsageWarning warning, ProvenanceRange pr,
+ const MessageFormattedText &s)
+ : location_{pr}, text_{s}, usageWarning_{warning} {}
+ Message(common::UsageWarning warning, ProvenanceRange pr,
+ MessageFormattedText &&s)
+ : location_{pr}, text_{std::move(s)}, usageWarning_{warning} {}
+
Message(CharBlock csr, const MessageFixedText &t)
: location_{csr}, text_{t} {}
Message(CharBlock csr, const MessageFormattedText &s)
@@ -211,10 +232,41 @@ class Message : public common::ReferenceCounted<Message> {
Message(CharBlock csr, const MessageExpectedText &t)
: location_{csr}, text_{t} {}
+ Message(
+ common::LanguageFeature feature, CharBlock csr, const MessageFixedText &t)
+ : location_{csr}, text_{t}, languageFeature_{feature} {}
+ Message(common::LanguageFeature feature, CharBlock csr,
+ const MessageFormattedText &s)
+ : location_{csr}, text_{s}, languageFeature_{feature} {}
+ Message(
+ common::LanguageFeature feature, CharBlock csr, MessageFormattedText &&s)
+ : location_{csr}, text_{std::move(s)}, languageFeature_{feature} {}
+
+ Message(
+ common::UsageWarning warning, CharBlock csr, const MessageFixedText &t)
+ : location_{csr}, text_{t}, usageWarning_{warning} {}
+ Message(common::UsageWarning warning, CharBlock csr,
+ const MessageFormattedText &s)
+ : location_{csr}, text_{s}, usageWarning_{warning} {}
+ Message(common::UsageWarning warning, CharBlock csr, MessageFormattedText &&s)
+ : location_{csr}, text_{std::move(s)}, usageWarning_{warning} {}
+
template <typename RANGE, typename A, typename... As>
Message(RANGE r, const MessageFixedText &t, A &&x, As &&...xs)
: location_{r}, text_{MessageFormattedText{
t, std::forward<A>(x), std::forward<As>(xs)...}} {}
+ template <typename RANGE, typename A, typename... As>
+ Message(common::LanguageFeature feature, RANGE r, const MessageFixedText &t,
+ A &&x, As &&...xs)
+ : location_{r}, text_{MessageFormattedText{
+ t, std::forward<A>(x), std::forward<As>(xs)...}},
+ languageFeature_{feature} {}
+ template <typename RANGE, typename A, typename... As>
+ Message(common::UsageWarning warning, RANGE r, const MessageFixedText &t,
+ A &&x, As &&...xs)
+ : location_{r}, text_{MessageFormattedText{
+ t, std::forward<A>(x), std::forward<As>(xs)...}},
+ usageWarning_{warning} {}
Reference attachment() const { return attachment_; }
@@ -232,6 +284,10 @@ class Message : public common::ReferenceCounted<Message> {
bool IsFatal() const;
Severity severity() const;
Message &set_severity(Severity);
+ std::optional<common::LanguageFeature> languageFeature() const;
+ Message &set_languageFeature(common::LanguageFeature);
+ std::optional<common::UsageWarning> usageWarning() const;
+ Message &set_usageWarning(common::UsageWarning);
std::string ToString() const;
std::optional<ProvenanceRange> GetProvenanceRange(
const AllCookedSources &) const;
@@ -256,6 +312,8 @@ class Message : public common::ReferenceCounted<Message> {
text_;
bool attachmentIsContext_{false};
Reference attachment_;
+ std::optional<common::LanguageFeature> languageFeature_;
+ std::optional<common::UsageWarning> usageWarning_;
};
class Messages {
@@ -275,6 +333,16 @@ class Messages {
return messages_.emplace_back(std::forward<A>(args)...);
}
+ template <typename... A>
+ Message &Say(common::LanguageFeature feature, A &&...args) {
+ return Say(std::forward<A>(args)...).set_languageFeature(feature);
+ }
+
+ template <typename... A>
+ Message &Say(common::UsageWarning warning, A &&...args) {
+ return Say(std::forward<A>(args)...).set_usageWarning(warning);
+ }
+
void Annex(Messages &&that) {
messages_.splice(messages_.end(), that.messages_);
}
@@ -330,6 +398,10 @@ class ContextualMessages {
return common::ScopedSet(messages_, nullptr);
}
+ template <typename... A> Message *Say(A &&...args) {
+ return Say(at_, std::forward<A>(args)...);
+ }
+
template <typename... A> Message *Say(CharBlock at, A &&...args) {
if (messages_ != nullptr) {
auto &msg{messages_->Say(at, std::forward<A>(args)...)};
@@ -347,8 +419,22 @@ class ContextualMessages {
return Say(at.value_or(at_), std::forward<A>(args)...);
}
- template <typename... A> Message *Say(A &&...args) {
- return Say(at_, std::forward<A>(args)...);
+ template <typename... A>
+ Message *Say(common::LanguageFeature feature, A &&...args) {
+ Message *msg{Say(std::forward<A>(args)...)};
+ if (msg) {
+ msg->set_languageFeature(feature);
+ }
+ return msg;
+ }
+
+ template <typename... A>
+ Message *Say(common::UsageWarning warning, A &&...args) {
+ Message *msg{Say(std::forward<A>(args)...)};
+ if (msg) {
+ msg->set_usageWarning(warning);
+ }
+ return msg;
}
Message *Say(Message &&msg) {
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index c90c8c4b3cc70f..a90801db7338cc 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -123,6 +123,16 @@ class ExpressionAnalyzer {
template <typename... A> parser::Message *Say(A &&...args) {
return GetContextualMessages().Say(std::forward<A>(args)...);
}
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(
+ FeatureOrUsageWarning warning, parser::CharBlock at, A &&...args) {
+ return context_.Warn(warning, at, std::forward<A>(args)...);
+ }
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(FeatureOrUsageWarning warning, A &&...args) {
+ return Warn(
+ warning, GetContextualMessages().at(), std::forward<A>(args)...);
+ }
template <typename T, typename... A>
parser::Message *SayAt(const T &parsed, A &&...args) {
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 2a326074b3dc64..606afbe288c38d 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -188,6 +188,24 @@ class SemanticsContext {
return message;
}
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(
+ FeatureOrUsageWarning warning, parser::CharBlock at, A &&...args) {
+ if (languageFeatures_.ShouldWarn(warning) && !IsInModuleFile(at)) {
+ parser::Message &msg{
+ messages_.Say(warning, at, std::forward<A>(args)...)};
+ return &msg;
+ } else {
+ return nullptr;
+ }
+ }
+
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(FeatureOrUsageWarning warning, A &&...args) {
+ CHECK(location_);
+ return Warn(warning, *location_, std::forward<A>(args)...);
+ }
+
const Scope &FindScope(parser::CharBlock) const;
Scope &FindScope(parser::CharBlock);
void UpdateScopeIndex(Scope &, parser::CharBlock);
@@ -270,7 +288,7 @@ class SemanticsContext {
std::multimap<parser::CharBlock, Scope &, ScopeIndexComparator>;
ScopeIndex::iterator SearchScopeIndex(parser::CharBlock);
- void CheckIndexVarRedefine(
+ parser::Message *CheckIndexVarRedefine(
const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
void CheckError(const Symbol &);
diff --git a/flang/lib/Common/Fortran-features.cpp b/flang/lib/Common/Fortran-features.cpp
index 25a948818e6560..59f570e6ab6e93 100644
--- a/flang/lib/Common/Fortran-features.cpp
+++ b/flang/lib/Common/Fortran-features.cpp
@@ -12,6 +12,131 @@
namespace Fortran::common {
+LanguageFeatureControl::LanguageFeatureControl() {
+ // These features must be explicitly enabled by command line options.
+ disable_.set(LanguageFeature::OldDebugLines);
+ disable_.set(LanguageFeature::OpenACC);
+ disable_.set(LanguageFeature::OpenMP);
+ disable_.set(LanguageFeature::CUDA); // !@cuf
+ disable_.set(LanguageFeature::CudaManaged);
+ disable_.set(LanguageFeature::CudaUnified);
+ disable_.set(LanguageFeature::ImplicitNoneTypeNever);
+ disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
+ disable_.set(LanguageFeature::DefaultSave);
+ disable_.set(LanguageFeature::SaveMainProgram);
+ // These features, if enabled, conflict with valid standard usage,
+ // so there are disabled here by default.
+ disable_.set(LanguageFeature::BackslashEscapes);
+ disable_.set(LanguageFeature::LogicalAbbreviations);
+ disable_.set(LanguageFeature::XOROperator);
+ disable_.set(LanguageFeature::OldStyleParameter);
+ // These warnings are enabled by default, but only because they used
+ // to be unconditional. TODO: prune this list
+ warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);
+ warnLanguage_.set(LanguageFeature::RedundantAttribute);
+ warnLanguage_.set(LanguageFeature::SubroutineAndFunctionSpecifics);
+ warnLanguage_.set(LanguageFeature::EmptySequenceType);
+ warnLanguage_.set(LanguageFeature::NonSequenceCrayPointee);
+ warnLanguage_.set(LanguageFeature::BranchIntoConstruct);
+ warnLanguage_.set(LanguageFeature::BadBranchTarget);
+ warnLanguage_.set(LanguageFeature::HollerithPolymorphic);
+ warnLanguage_.set(LanguageFeature::ListDirectedSize);
+ warnUsage_.set(UsageWarning::ShortArrayActual);
+ warnUsage_.set(UsageWarning::FoldingException);
+ warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
+ warnUsage_.set(UsageWarning::FoldingValueChecks);
+ warnUsage_.set(UsageWarning::FoldingFailure);
+ warnUsage_.set(UsageWarning::FoldingLimit);
+ warnUsage_.set(UsageWarning::Interoperability);
+ warnUsage_.set(UsageWarning::Bounds);
+ warnUsage_.set(UsageWarning::Preprocessing);
+ warnUsage_.set(UsageWarning::Scanning);
+ warnUsage_.set(UsageWarning::OpenAccUsage);
+ warnUsage_.set(UsageWarning::ProcPointerCompatibility);
+ warnUsage_.set(UsageWarning::VoidMold);
+ warnUsage_.set(UsageWarning::KnownBadImplicitInterface);
+ warnUsage_.set(UsageWarning::EmptyCase);
+ warnUsage_.set(UsageWarning::CaseOverflow);
+ warnUsage_.set(UsageWarning::CUDAUsage);
+ warnUsage_.set(UsageWarning::IgnoreTKRUsage);
+ warnUsage_.set(UsageWarning::ExternalInterfaceMismatch);
+ warnUsage_.set(UsageWarning::DefinedOperatorArgs);
+ warnUsage_.set(UsageWarning::Final);
+ warnUsage_.set(UsageWarning::ZeroDoStep);
+ warnUsage_.set(UsageWarning::UnusedForallIndex);
+ warnUsage_.set(UsageWarning::OpenMPUsage);
+ warnUsage_.set(UsageWarning::ModuleFile);
+ warnUsage_.set(UsageWarning::DataLength);
+ warnUsage_.set(UsageWarning::IgnoredDirective);
+ warnUsage_.set(UsageWarning::HomonymousSpecific);
+ warnUsage_.set(UsageWarning::HomonymousResult);
+ warnUsage_.set(UsageWarning::IgnoredIntrinsicFunctionType);
+ warnUsage_.set(UsageWarning::PreviousScalarUse);
+ warnUsage_.set(UsageWarning::RedeclaredInaccessibleComponent);
+ warnUsage_.set(UsageWarning::ImplicitShared);
+ warnUsage_.set(UsageWarning::IndexVarRedefinition);
+ warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
+ warnUsage_.set(UsageWarning::BadTypeForTarget);
+ warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
+ warnUsage_.set(UsageWarning::UndefinedFunctionResult);
+ warnUsage_.set(UsageWarning::UselessIomsg);
+ // New warnings, on by default
+ warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
+}
+
+// Ignore case and any inserted punctuation (like '-'/'_')
+static std::optional<char> GetWarningChar(char ch) {
+ if (ch >= 'a' && ch <= 'z') {
+ return ch;
+ } else if (ch >= 'A' && ch <= 'Z') {
+ return ch - 'A' + 'a';
+ } else if (ch >= '0' && ch <= '9') {
+ return ch;
+ } else {
+ return std::nullopt;
+ }
+}
+
+static bool WarningNameMatch(const char *a, const char *b) {
+ while (true) {
+ auto ach{GetWarningChar(*a)};
+ while (!ach && *a) {
+ ach = GetWarningChar(*++a);
+ }
+ auto bch{GetWarningChar(*b)};
+ while (!bch && *b) {
+ bch = GetWarningChar(*++b);
+ }
+ if (!ach && !bch) {
+ return true;
+ } else if (!ach || !bch || *ach != *bch) {
+ return false;
+ }
+ ++a, ++b;
+ }
+}
+
+template <typename ENUM, std::size_t N>
+std::optional<ENUM> ScanEnum(const char *name) {
+ if (name) {
+ for (std::size_t j{0}; j < N; ++j) {
+ auto feature{static_cast<ENUM>(j)};
+ if (WarningNameMatch(name, EnumToString(feature).data())) {
+ return feature;
+ }
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<LanguageFeature> FindLanguageFeature(const char *name) {
+ return ScanEnum<LanguageFeature, LanguageFeature_enumSize>(name);
+}
+
+std::optional<UsageWarning> FindUsageWarning(const char *name) {
+ return ScanEnum<UsageWarning, UsageWarning_enumSize>(name);
+}
+
std::vector<const char *> LanguageFeatureControl::GetNames(
LogicalOperator opr) const {
std::vector<const char *> result;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index a1ede7d7553bf6..38794a2d8aacc7 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -412,6 +412,7 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
symbol.owner().context().ShouldWarn(
common::LanguageFeature::LogicalIntegerAssignment)) {
context.messages().Say(
+ common::LanguageFeature::LogicalIntegerAssignment,
"nonstandard usage: initialization of %s with %s"_port_en_US,
symTS->type().AsFortran(), x.GetType().value().AsFortran());
}
@@ -565,7 +566,7 @@ class CheckSpecificationExprHelper
if (!scope_.IsModuleFile() &&
context_.languageFeatures().ShouldWarn(
common::LanguageFeature::SavedLocalInSpecExpr)) {
- context_.messages().Say(
+ context_.messages().Say(common::LanguageFeature::SavedLocalInSpecExpr,
"specification expression refers to local object '%s' (initialized and saved)"_port_en_US,
ultimate.name().ToString());
}
@@ -1102,44 +1103,53 @@ class StmtFunctionChecker
public:
using Result = std::optional<parser::Message>;
using Base = AnyTraverse<StmtFunctionChecker, Result>;
+
+ static constexpr auto feature{
+ common::LanguageFeature::StatementFunctionExtensions};
+
StmtFunctionChecker(const Symbol &sf, FoldingContext &context)
: Base{*this}, sf_{sf}, context_{context} {
- if (!context_.languageFeatures().IsEnabled(
- common::LanguageFeature::StatementFunctionExtensions)) {
+ if (!context_.languageFeatures().IsEnabled(feature)) {
severity_ = parser::Severity::Error;
- } else if (context_.languageFeatures().ShouldWarn(
- common::LanguageFeature::StatementFunctionExtensions)) {
+ } else if (context_.languageFeatures().ShouldWarn(feature)) {
severity_ = parser::Severity::Portability;
}
}
using Base::operator();
- template <typename T> Result operator()(const ArrayConstructor<T> &) const {
+ Result Return(parser::Message &&msg) const {
if (severity_) {
- auto msg{
- "Statement function '%s' should not contain an array constructor"_port_en_US};
msg.set_severity(*severity_);
- return parser::Message{sf_.name(), std::move(msg), sf_.name()};
+ if (*severity_ != parser::Severity::Error) {
+ msg.set_languageFeature(feature);
+ }
+ }
+ return std::move(msg);
+ }
+
+ template <typename T> Result operator()(const ArrayConstructor<T> &) const {
+ if (severity_) {
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not contain an array constructor"_port_en_US,
+ sf_.name()});
} else {
return std::nullopt;
}
}
Result operator()(const StructureConstructor &) const {
if (severity_) {
- auto msg{
- "Statement function '%s' should not contain a structure constructor"_port_en_US};
- msg.set_severity(*severity_);
- return parser::Message{sf_.name(), std::move(msg), sf_.name()};
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not contain a structure constructor"_port_en_US,
+ sf_.name()});
} else {
return std::nullopt;
}
}
Result operator()(const TypeParamInquiry &) const {
if (severity_) {
- auto msg{
- "Statement function '%s' should not contain a type parameter inquiry"_port_en_US};
- msg.set_severity(*severity_);
- return parser::Message{sf_.name(), std::move(msg), sf_.name()};
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not contain a type parameter inquiry"_port_en_US,
+ sf_.name()});
} else {
return std::nullopt;
}
@@ -1161,21 +1171,18 @@ class StmtFunctionChecker
proc, context_, /*emitError=*/true)}) {
if (!chars->CanBeCalledViaImplicitInterface()) {
if (severity_) {
- auto msg{
- "Statement function '%s' should not reference function '%s' that requires an explicit interface"_port_en_US};
- msg.set_severity(*severity_);
- return parser::Message{
- sf_.name(), std::move(msg), sf_.name(), symbol->name()};
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not reference function '%s' that requires an explicit interface"_port_en_US,
+ sf_.name(), symbol->name()});
}
}
}
}
if (proc.Rank() > 0) {
if (severity_) {
- auto msg{
- "Statement function '%s' should not reference a function that returns an array"_port_en_US};
- msg.set_severity(*severity_);
- return parser::Message{sf_.name(), std::move(msg), sf_.name()};
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not reference a function that returns an array"_port_en_US,
+ sf_.name()});
}
}
return std::nullopt;
@@ -1187,10 +1194,9 @@ class StmtFunctionChecker
}
if (expr->Rank() > 0 && !UnwrapWholeSymbolOrComponentDataRef(*expr)) {
if (severity_) {
- auto msg{
- "Statement function '%s' should not pass an array argument that is not a whole array"_port_en_US};
- msg.set_severity(*severity_);
- return parser::Message{sf_.name(), std::move(msg), sf_.name()};
+ return Return(parser::Message{sf_.name(),
+ "Statement function '%s' should not pass an array argument that is not a whole array"_port_en_US,
+ sf_.name()});
}
}
}
diff --git a/flang/lib/Evaluate/common.cpp b/flang/lib/Evaluate/common.cpp
index c633bff57b1ecd..6a960d46166e9d 100644
--- a/flang/lib/Evaluate/common.cpp
+++ b/flang/lib/Evaluate/common.cpp
@@ -15,23 +15,25 @@ namespace Fortran::evaluate {
void RealFlagWarnings(
FoldingContext &context, const RealFlags &flags, const char *operation) {
- if (context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
+ static constexpr auto warning{common::UsageWarning::FoldingException};
+ if (context.languageFeatures().ShouldWarn(warning)) {
if (flags.test(RealFlag::Overflow)) {
- context.messages().Say("overflow on %s"_warn_en_US, operation);
+ context.messages().Say(warning, "overflow on %s"_warn_en_US, operation);
}
if (flags.test(RealFlag::DivideByZero)) {
if (std::strcmp(operation, "division") == 0) {
- context.messages().Say("division by zero"_warn_en_US);
+ context.messages().Say(warning, "division by zero"_warn_en_US);
} else {
- context.messages().Say("division by zero on %s"_warn_en_US, operation);
+ context.messages().Say(
+ warning, "division by zero on %s"_warn_en_US, operation);
}
}
if (flags.test(RealFlag::InvalidArgument)) {
- context.messages().Say("invalid argument on %s"_warn_en_US, operation);
+ context.messages().Say(
+ warning, "invalid argument on %s"_warn_en_US, operation);
}
if (flags.test(RealFlag::Underflow)) {
- context.messages().Say("underflow on %s"_warn_en_US, operation);
+ context.messages().Say(warning, "underflow on %s"_warn_en_US, operation);
}
}
}
diff --git a/flang/lib/Evaluate/fold-character.cpp b/flang/lib/Evaluate/fold-character.cpp
index 5bdfa539eb0e02..76ac497e166468 100644
--- a/flang/lib/Evaluate/fold-character.cpp
+++ b/flang/lib/Evaluate/fold-character.cpp
@@ -60,7 +60,7 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
if (i.IsNegative() || i.BGE(Scalar<IntT>{0}.IBSET(8 * KIND))) {
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingValueChecks,
"%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US,
parser::ToUpperCaseLetters(name),
static_cast<std::intmax_t>(i.ToInt64()), KIND);
@@ -108,7 +108,7 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
(1 << 20)) { // sanity limit of 1MiB
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingLimit)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingLimit,
"Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US,
static_cast<double>(n) * str.size());
}
diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp
index d44cc9c69dd68d..3eb8e1f3f1fc22 100644
--- a/flang/lib/Evaluate/fold-complex.cpp
+++ b/flang/lib/Evaluate/fold-complex.cpp
@@ -31,7 +31,7 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
context, std::move(funcRef), *callable);
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"%s(complex(kind=%d)) cannot be folded on host"_warn_en_US, name,
KIND);
}
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 89477dfb364351..b9c75448b75422 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1735,7 +1735,7 @@ Expr<TO> FoldOperation(
if (converted.overflow &&
msvcWorkaround.context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- ctx.messages().Say(
+ ctx.messages().Say(common::UsageWarning::FoldingException,
"conversion of %s_%d to INTEGER(%d) overflowed; result is %s"_warn_en_US,
value->SignedDecimal(), Operand::kind, TO::kind,
converted.value.SignedDecimal());
@@ -1746,7 +1746,7 @@ Expr<TO> FoldOperation(
if (msvcWorkaround.context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
if (converted.flags.test(RealFlag::InvalidArgument)) {
- ctx.messages().Say(
+ ctx.messages().Say(common::UsageWarning::FoldingException,
"REAL(%d) to INTEGER(%d) conversion: invalid argument"_warn_en_US,
Operand::kind, TO::kind);
} else if (converted.flags.test(RealFlag::Overflow)) {
@@ -1865,7 +1865,7 @@ Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
if (negated.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) negation overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{std::move(negated.value)}};
@@ -1907,7 +1907,7 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
if (sum.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) addition overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{sum.value}};
@@ -1935,7 +1935,7 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
if (
diff erence.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{
diff erence.value}};
@@ -1963,7 +1963,7 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
if (product.SignedMultiplicationOverflowed() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{product.lower}};
@@ -2009,7 +2009,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
if (quotAndRem.divisionByZero) {
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) division by zero"_warn_en_US, T::kind);
}
return Expr<T>{std::move(x)};
@@ -2017,7 +2017,7 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
if (quotAndRem.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) division overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{quotAndRem.quotient}};
@@ -2060,13 +2060,13 @@ Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) {
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
if (power.divisionByZero) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) zero to negative power"_warn_en_US, T::kind);
} else if (power.overflow) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) power overflowed"_warn_en_US, T::kind);
} else if (power.zeroToZero) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"INTEGER(%d) 0**0 is not defined"_warn_en_US, T::kind);
}
}
@@ -2077,7 +2077,7 @@ Expr<T> FoldOperation(FoldingContext &context, Power<T> &&x) {
Constant<T>{(*callable)(context, folded->first, folded->second)}};
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"Power for %s cannot be folded on host"_warn_en_US,
T{}.AsFortran());
}
@@ -2163,7 +2163,7 @@ Expr<Type<TypeCategory::Real, KIND>> ToReal(
if (original != converted &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) { // C1601
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingValueChecks,
"Nonzero bits truncated from BOZ literal constant in REAL intrinsic"_warn_en_US);
}
} else if constexpr (IsNumericCategoryExpr<From>()) {
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 821fa4e5dadfd5..594a614a5f2e76 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -300,7 +300,7 @@ static Expr<T> FoldCount(FoldingContext &context, FunctionRef<T> &&ref) {
if (accumulator.overflow() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"Result of intrinsic function COUNT overflows its result type"_warn_en_US);
}
return Expr<T>{std::move(result)};
@@ -562,7 +562,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (result.ToInt64() != n &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
name, std::intmax_t{n});
}
@@ -575,7 +575,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (j.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
}
return j.value;
@@ -598,6 +598,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
context.messages().Say(
+ common::UsageWarning::FoldingException,
"%s intrinsic folding overflow"_warn_en_US, name);
}
return y.value;
@@ -646,7 +647,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (result.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say("DIM intrinsic folding overflow"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "DIM intrinsic folding overflow"_warn_en_US);
}
return result.value;
}));
@@ -708,7 +710,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::Portability)) {
// Do not die, this was not checked before
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::Portability,
"Character in intrinsic function %s should have length one"_port_en_US,
name);
} else {
@@ -1127,7 +1129,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
pConst->IsZero() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say("MOD: P argument is zero"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "MOD: P argument is zero"_warn_en_US);
badPConst = true;
}
}
@@ -1139,9 +1142,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
if (!badPConst && quotRem.divisionByZero) {
- context.messages().Say("mod() by zero"_warn_en_US);
+ context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "mod() by zero"_warn_en_US);
} else if (quotRem.overflow) {
- context.messages().Say("mod() folding overflowed"_warn_en_US);
+ context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "mod() folding overflowed"_warn_en_US);
}
}
return quotRem.remainder;
@@ -1154,7 +1161,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
pConst->IsZero() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say("MODULO: P argument is zero"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "MODULO: P argument is zero"_warn_en_US);
badPConst = true;
}
}
@@ -1166,7 +1174,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (!badPConst && result.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say("modulo() folding overflowed"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "modulo() folding overflowed"_warn_en_US);
}
return result.value;
}));
@@ -1303,7 +1312,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (result.overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"sign(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
}
return result.value;
@@ -1363,7 +1372,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
if (intBytes != realBytes &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
- context.messages().Say(*context.moduleFileName(),
+ context.messages().Say(common::UsageWarning::FoldingValueChecks,
+ *context.moduleFileName(),
"NUMERIC_STORAGE_SIZE from ISO_FORTRAN_ENV is not well-defined when default INTEGER and REAL are not consistent due to compiler options"_warn_en_US);
}
return Expr<T>{8 * std::min(intBytes, realBytes)};
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index ee6655f8387177..f5bbe7e4293359 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -534,7 +534,8 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
context.languageFeatures().ShouldWarn(
common::UsageWarning::OptionalMustBePresent)) {
if (auto source{args[2]->sourceLocation()}) {
- context.messages().Say(*source,
+ context.messages().Say(
+ common::UsageWarning::OptionalMustBePresent, *source,
"ROUND= argument to OUT_OF_RANGE() is an optional dummy argument that must be present at execution"_warn_en_US);
}
}
diff --git a/flang/lib/Evaluate/fold-matmul.h b/flang/lib/Evaluate/fold-matmul.h
index a799cfb80a59de..be9c547d45286c 100644
--- a/flang/lib/Evaluate/fold-matmul.h
+++ b/flang/lib/Evaluate/fold-matmul.h
@@ -95,7 +95,7 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
if (overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"MATMUL of %s data overflowed during computation"_warn_en_US,
T::AsFortran());
}
diff --git a/flang/lib/Evaluate/fold-real.cpp b/flang/lib/Evaluate/fold-real.cpp
index fd8eca28a679c1..ed7749e8803011 100644
--- a/flang/lib/Evaluate/fold-real.cpp
+++ b/flang/lib/Evaluate/fold-real.cpp
@@ -37,7 +37,7 @@ static Expr<T> FoldTransformationalBessel(
std::move(results), ConstantSubscripts{std::max(n2 - n1 + 1, 0)}}};
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
name, T::kind);
}
@@ -134,7 +134,7 @@ static Expr<Type<TypeCategory::Real, KIND>> FoldNorm2(FoldingContext &context,
if (norm2Accumulator.overflow() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"NORM2() of REAL(%d) data overflowed"_warn_en_US, KIND);
}
return Expr<T>{std::move(result)};
@@ -167,7 +167,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context, std::move(funcRef), *callable);
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"%s(real(kind=%d)) cannot be folded on host"_warn_en_US, name, KIND);
}
} else if (name == "amax0" || name == "amin0" || name == "amin1" ||
@@ -181,7 +181,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context, std::move(funcRef), *callable);
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"%s(real(kind=%d), real(kind%d)) cannot be folded on host"_warn_en_US,
name, KIND, KIND);
}
@@ -193,7 +193,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context, std::move(funcRef), *callable);
} else if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US,
name, KIND);
}
@@ -213,7 +213,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (y.flags.test(RealFlag::Overflow) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"complex ABS intrinsic folding overflow"_warn_en_US, name);
}
return y.value;
@@ -237,7 +237,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (y.flags.test(RealFlag::Overflow) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"%s intrinsic folding overflow"_warn_en_US, name);
}
return y.value;
@@ -250,7 +250,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (result.flags.test(RealFlag::Overflow) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say("DIM intrinsic folding overflow"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "DIM intrinsic folding overflow"_warn_en_US);
}
return result.value;
}));
@@ -284,7 +285,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (result.flags.test(RealFlag::Overflow) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"HYPOT intrinsic folding overflow"_warn_en_US);
}
return result.value;
@@ -310,7 +311,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
pConst->IsZero() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say("MOD: P argument is zero"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "MOD: P argument is zero"_warn_en_US);
badPConst = true;
}
}
@@ -322,6 +324,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
"second argument to MOD must not be zero"_warn_en_US);
}
return result.value;
@@ -335,7 +338,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
pConst->IsZero() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
- context.messages().Say("MODULO: P argument is zero"_warn_en_US);
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "MODULO: P argument is zero"_warn_en_US);
badPConst = true;
}
}
@@ -347,6 +351,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
"second argument to MODULO must not be zero"_warn_en_US);
}
return result.value;
@@ -362,7 +367,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
(sConst->IsZero() || sConst->IsNotANumber()) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
- context.messages().Say("NEAREST: S argument is %s"_warn_en_US,
+ context.messages().Say(common::UsageWarning::FoldingValueChecks,
+ "NEAREST: S argument is %s"_warn_en_US,
sConst->IsZero() ? "zero" : "NaN");
badSConst = true;
}
@@ -373,6 +379,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
context.messages().Say(
+ common::UsageWarning::FoldingValueChecks,
"NEAREST: S argument is %s"_warn_en_US,
s.IsZero() ? "zero" : "NaN");
}
@@ -381,6 +388,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
common::UsageWarning::FoldingException)) {
if (result.flags.test(RealFlag::InvalidArgument)) {
context.messages().Say(
+ common::UsageWarning::FoldingException,
"NEAREST intrinsic folding: bad argument"_warn_en_US);
}
}
@@ -423,6 +431,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
context.messages().Say(
+ common::UsageWarning::FoldingException,
"SCALE intrinsic folding overflow"_warn_en_US);
}
return result.value;
@@ -475,6 +484,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingValueChecks)) {
context.messages().Say(
+ common::UsageWarning::FoldingValueChecks,
"IEEE_NEXT_AFTER intrinsic folding: arguments are unordered"_warn_en_US);
}
return x.NotANumber();
@@ -500,7 +510,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
if (result.flags.test(RealFlag::InvalidArgument)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"%s intrinsic folding: argument is NaN"_warn_en_US, iName);
}
}
diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h
index fbdae8f4eee01b..8ca0794ab0fc7c 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -108,7 +108,7 @@ static Expr<T> FoldDotProduct(
if (overflow &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"DOT_PRODUCT of %s data overflowed during computation"_warn_en_US,
T::AsFortran());
}
@@ -326,7 +326,7 @@ static Expr<T> FoldProduct(
if (accumulator.overflow() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"PRODUCT() of %s data overflowed"_warn_en_US, T::AsFortran());
}
return result;
@@ -394,7 +394,7 @@ static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
if (accumulator.overflow() &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingException)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingException,
"SUM() of %s data overflowed"_warn_en_US, T::AsFortran());
}
return result;
diff --git a/flang/lib/Evaluate/host.cpp b/flang/lib/Evaluate/host.cpp
index 31bc4383858033..187bb2f09806b5 100644
--- a/flang/lib/Evaluate/host.cpp
+++ b/flang/lib/Evaluate/host.cpp
@@ -102,7 +102,7 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment(
fesetround(FE_TONEAREST);
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::FoldingFailure)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::FoldingFailure,
"TiesAwayFromZero rounding mode is not available when folding "
"constants"
" with host runtime; using TiesToEven instead"_warn_en_US);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 3734cc6814f97f..1f48fc21662ebb 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2375,10 +2375,10 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::OptionalMustBePresent)) {
if (rank == Rank::scalarIfDim || arrayRank.value_or(-1) == 1) {
- messages.Say(
+ messages.Say(common::UsageWarning::OptionalMustBePresent,
"The actual argument for DIM= is optional, pointer, or allocatable, and it is assumed to be present and equal to 1 at execution time"_warn_en_US);
} else {
- messages.Say(
+ messages.Say(common::UsageWarning::OptionalMustBePresent,
"The actual argument for DIM= is optional, pointer, or allocatable, and may not be absent during execution; parenthesize to silence this warning"_warn_en_US);
}
}
@@ -2851,11 +2851,11 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
if (context.languageFeatures().ShouldWarn(
common::UsageWarning::Interoperability)) {
if (type->IsUnlimitedPolymorphic()) {
- context.messages().Say(at,
+ context.messages().Say(common::UsageWarning::Interoperability, at,
"FPTR= argument to C_F_POINTER() should not be unlimited polymorphic"_warn_en_US);
} else if (!type->GetDerivedTypeSpec().typeSymbol().attrs().test(
semantics::Attr::BIND_C)) {
- context.messages().Say(at,
+ context.messages().Say(common::UsageWarning::Interoperability, at,
"FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US);
}
}
@@ -2864,7 +2864,7 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
.value_or(true) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::Interoperability)) {
- context.messages().Say(at,
+ context.messages().Say(common::UsageWarning::Interoperability, at,
"FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type %s"_warn_en_US,
type->AsFortran());
}
@@ -2966,7 +2966,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
!IsInteroperableIntrinsicType(typeAndShape->type()).value_or(true) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::Interoperability)) {
- context.messages().Say(arguments[0]->sourceLocation(),
+ context.messages().Say(common::UsageWarning::Interoperability,
+ arguments[0]->sourceLocation(),
"C_LOC() argument has non-interoperable intrinsic type, kind, or length"_warn_en_US);
}
@@ -3311,6 +3312,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
common::LanguageFeature::
UseGenericIntrinsicWhenSpecificDoesntMatch)) {
context.messages().Say(
+ common::LanguageFeature::
+ UseGenericIntrinsicWhenSpecificDoesntMatch,
"Argument types do not match specific intrinsic '%s' requirements; using '%s' generic instead and converting the result to %s if needed"_port_en_US,
call.name, genericName, newType.AsFortran());
}
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index b074ae6d811acf..707a2065ca30a7 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -215,7 +215,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
if (!result) { // error cases
if (*lbi < 1) {
if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::Bounds,
"Lower bound (%jd) on substring is less than one"_warn_en_US,
static_cast<std::intmax_t>(*lbi));
}
@@ -224,7 +224,7 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
}
if (length && *ubi > *length) {
if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) {
- context.messages().Say(
+ context.messages().Say(common::UsageWarning::Bounds,
"Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US,
static_cast<std::intmax_t>(*ubi),
static_cast<std::intmax_t>(*length));
diff --git a/flang/lib/Parser/message.cpp b/flang/lib/Parser/message.cpp
index a56337d65e5f31..69e4814bf246cc 100644
--- a/flang/lib/Parser/message.cpp
+++ b/flang/lib/Parser/message.cpp
@@ -185,6 +185,24 @@ Message &Message::set_severity(Severity severity) {
return *this;
}
+std::optional<common::LanguageFeature> Message::languageFeature() const {
+ return languageFeature_;
+}
+
+Message &Message::set_languageFeature(common::LanguageFeature feature) {
+ languageFeature_ = feature;
+ return *this;
+}
+
+std::optional<common::UsageWarning> Message::usageWarning() const {
+ return usageWarning_;
+}
+
+Message &Message::set_usageWarning(common::UsageWarning warning) {
+ usageWarning_ = warning;
+ return *this;
+}
+
std::string Message::ToString() const {
return common::visit(
common::visitors{
diff --git a/flang/lib/Parser/preprocessor.cpp b/flang/lib/Parser/preprocessor.cpp
index cb3725bc4ea67e..f9b8716941b3bc 100644
--- a/flang/lib/Parser/preprocessor.cpp
+++ b/flang/lib/Parser/preprocessor.cpp
@@ -610,7 +610,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
if (dir.IsAnythingLeft(++j)) {
if (prescanner.features().ShouldWarn(
common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#undef: excess tokens at end of directive"_port_en_US);
}
} else {
@@ -627,7 +628,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
if (dir.IsAnythingLeft(++j)) {
if (prescanner.features().ShouldWarn(
common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#%s: excess tokens at end of directive"_port_en_US, dirName);
}
}
@@ -649,7 +651,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
} else if (dirName == "else") {
if (dir.IsAnythingLeft(j)) {
if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#else: excess tokens at end of directive"_port_en_US);
}
} else if (ifStack_.empty()) {
@@ -678,7 +681,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
} else if (dirName == "endif") {
if (dir.IsAnythingLeft(j)) {
if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#endif: excess tokens at end of directive"_port_en_US);
}
} else if (ifStack_.empty()) {
@@ -729,7 +733,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
if (k >= pathTokens) {
if (prescanner.features().ShouldWarn(
common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#include: expected '>' at end of included file"_port_en_US);
}
}
@@ -758,7 +763,8 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) {
k = path.SkipBlanks(k + 1);
if (k < pathTokens && path.TokenAt(k).ToString() != "!") {
if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) {
- prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j),
+ prescanner.Say(common::UsageWarning::Portability,
+ dir.GetIntervalProvenanceRange(j, tokens - j),
"#include: extra stuff ignored after file name"_port_en_US);
}
}
diff --git a/flang/lib/Parser/prescan.cpp b/flang/lib/Parser/prescan.cpp
index eabfcc244001ad..47260c0680463d 100644
--- a/flang/lib/Parser/prescan.cpp
+++ b/flang/lib/Parser/prescan.cpp
@@ -243,7 +243,8 @@ void Prescanner::Statement() {
}
if (continuationLines_ > 255) {
if (features_.ShouldWarn(common::LanguageFeature::MiscSourceExtensions)) {
- Say(GetProvenance(statementStart),
+ Say(common::LanguageFeature::MiscSourceExtensions,
+ GetProvenance(statementStart),
"%d continuation lines is more than the Fortran standard allows"_port_en_US,
continuationLines_);
}
@@ -265,7 +266,8 @@ void Prescanner::Statement() {
case LineClassification::Kind::DefinitionDirective:
case LineClassification::Kind::PreprocessorDirective:
if (features_.ShouldWarn(common::UsageWarning::Preprocessing)) {
- Say(preprocessed->GetProvenanceRange(),
+ Say(common::UsageWarning::Preprocessing,
+ preprocessed->GetProvenanceRange(),
"Preprocessed line resembles a preprocessor directive"_warn_en_US);
}
CheckAndEmitLine(preprocessed->ToLowerCase(), newlineProvenance);
@@ -400,7 +402,7 @@ void Prescanner::LabelField(TokenSequence &token) {
// CookedSource::Marshal().
cooked_.MarkPossibleFixedFormContinuation();
} else if (features_.ShouldWarn(common::UsageWarning::Scanning)) {
- Say(GetProvenance(start + *badColumn - 1),
+ Say(common::UsageWarning::Scanning, GetProvenance(start + *badColumn - 1),
*badColumn == 6
? "Statement should not begin with a continuation line"_warn_en_US
: "Character in fixed-form label field must be a digit"_warn_en_US);
@@ -424,7 +426,7 @@ void Prescanner::LabelField(TokenSequence &token) {
SkipToNextSignificantCharacter();
if (IsDecimalDigit(*at_)) {
if (features_.ShouldWarn(common::LanguageFeature::MiscSourceExtensions)) {
- Say(GetCurrentProvenance(),
+ Say(common::LanguageFeature::MiscSourceExtensions, GetCurrentProvenance(),
"Label digit is not in fixed-form label field"_port_en_US);
}
}
@@ -627,7 +629,7 @@ bool Prescanner::NextToken(TokenSequence &tokens) {
// Recognize and skip over classic C style /*comments*/ when
// outside a character literal.
if (features_.ShouldWarn(LanguageFeature::ClassicCComments)) {
- Say(GetCurrentProvenance(),
+ Say(LanguageFeature::ClassicCComments, GetCurrentProvenance(),
"nonstandard usage: C-style comment"_port_en_US);
}
SkipCComments();
@@ -795,7 +797,8 @@ bool Prescanner::NextToken(TokenSequence &tokens) {
if (IsDecimalDigit(*at_)) {
if (features_.ShouldWarn(
common::LanguageFeature::MiscSourceExtensions)) {
- Say(GetProvenanceRange(at_, at_ + 1),
+ Say(common::LanguageFeature::MiscSourceExtensions,
+ GetProvenanceRange(at_, at_ + 1),
"Label should be in the label field"_port_en_US);
}
}
@@ -923,7 +926,7 @@ void Prescanner::Hollerith(
if (PadOutCharacterLiteral(tokens)) {
} else if (*at_ == '\n') {
if (features_.ShouldWarn(common::UsageWarning::Scanning)) {
- Say(GetProvenanceRange(start, at_),
+ Say(common::UsageWarning::Scanning, GetProvenanceRange(start, at_),
"Possible truncated Hollerith literal"_warn_en_US);
}
break;
@@ -1087,7 +1090,7 @@ void Prescanner::FortranInclude(const char *firstQuote) {
for (; *p != '\n' && *p != '!'; ++p) {
}
if (features_.ShouldWarn(common::UsageWarning::Scanning)) {
- Say(GetProvenanceRange(garbage, p),
+ Say(common::UsageWarning::Scanning, GetProvenanceRange(garbage, p),
"excess characters after path name"_warn_en_US);
}
}
@@ -1228,7 +1231,8 @@ const char *Prescanner::FixedFormContinuationLine(bool mightNeedSpace) {
// Extension: '&' as continuation marker
if (features_.ShouldWarn(
LanguageFeature::FixedFormContinuationWithColumn1Ampersand)) {
- Say(GetProvenance(nextLine_), "nonstandard usage"_port_en_US);
+ Say(LanguageFeature::FixedFormContinuationWithColumn1Ampersand,
+ GetProvenance(nextLine_), "nonstandard usage"_port_en_US);
}
return nextLine_ + 1;
}
@@ -1294,7 +1298,8 @@ const char *Prescanner::FreeFormContinuationLine(bool ampersand) {
// 'b'
if (features_.ShouldWarn(
common::LanguageFeature::MiscSourceExtensions)) {
- Say(GetProvenanceRange(p, p + 1),
+ Say(common::LanguageFeature::MiscSourceExtensions,
+ GetProvenanceRange(p, p + 1),
"Character literal continuation line should have been preceded by '&'"_port_en_US);
}
} else if (p > nextLine_) {
@@ -1339,7 +1344,8 @@ bool Prescanner::FreeFormContinuation() {
} else if (ampersand && isPossibleMacroCall_ && (*p == ',' || *p == ')')) {
return false; // allow & at end of a macro argument
} else if (features_.ShouldWarn(LanguageFeature::CruftAfterAmpersand)) {
- Say(GetProvenance(p), "missing ! before comment after &"_warn_en_US);
+ Say(LanguageFeature::CruftAfterAmpersand, GetProvenance(p),
+ "missing ! before comment after &"_warn_en_US);
}
}
do {
diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp
index c0f834c845a820..623e31341a7c20 100644
--- a/flang/lib/Semantics/check-acc-structure.cpp
+++ b/flang/lib/Semantics/check-acc-structure.cpp
@@ -409,16 +409,12 @@ void AccStructureChecker::CheckMultipleOccurrenceInDeclare(
if (const auto *name = getDesignatorNameIfDataRef(designator)) {
if (declareSymbols.contains(&name->symbol->GetUltimate())) {
if (declareSymbols[&name->symbol->GetUltimate()] == clause) {
- if (context_.languageFeatures().ShouldWarn(
- common::UsageWarning::OpenAccUsage)) {
- context_.Say(GetContext().clauseSource,
- "'%s' in the %s clause is already present in the "
- "same "
- "clause in this module"_warn_en_US,
- name->symbol->name(),
- parser::ToUpperCaseLetters(
- llvm::acc::getOpenACCClauseName(clause).str()));
- }
+ context_.Warn(common::UsageWarning::OpenAccUsage,
+ GetContext().clauseSource,
+ "'%s' in the %s clause is already present in the same clause in this module"_warn_en_US,
+ name->symbol->name(),
+ parser::ToUpperCaseLetters(
+ llvm::acc::getOpenACCClauseName(clause).str()));
} else {
context_.Say(GetContext().clauseSource,
"'%s' in the %s clause is already present in another "
@@ -770,10 +766,8 @@ void AccStructureChecker::Enter(const parser::AccClause::Link &x) {
}
void AccStructureChecker::Enter(const parser::AccClause::Shortloop &x) {
- if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop) &&
- context_.languageFeatures().ShouldWarn(
- common::UsageWarning::OpenAccUsage)) {
- context_.Say(GetContext().clauseSource,
+ if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop)) {
+ context_.Warn(common::UsageWarning::OpenAccUsage, GetContext().clauseSource,
"Non-standard shortloop clause ignored"_warn_en_US);
}
}
@@ -793,10 +787,8 @@ void AccStructureChecker::Enter(const parser::AccClause::If &x) {
}
void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) {
- if (context_.languageFeatures().ShouldWarn(
- common::UsageWarning::OpenAccUsage)) {
- context_.Say(x.source, "Misplaced OpenACC end directive"_warn_en_US);
- }
+ context_.Warn(common::UsageWarning::OpenAccUsage, x.source,
+ "Misplaced OpenACC end directive"_warn_en_US);
}
void AccStructureChecker::Enter(const parser::Module &) {
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index a5363a6710d319..1e5412324916d6 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -531,10 +531,8 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
// Character length distinction is allowed, with a warning
if (!HaveCompatibleLengths(
*type_, allocateInfo_.sourceExprType.value())) { // F'2023 C950
- if (context.ShouldWarn(common::LanguageFeature::AllocateToOtherLength)) {
- context.Say(name_.source,
- "Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD"_port_en_US);
- }
+ context.Warn(common::LanguageFeature::AllocateToOtherLength, name_.source,
+ "Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD"_port_en_US);
return false;
}
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 28903304f622e6..28a12a5798cb05 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -169,37 +169,40 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
actualOffset->offset()) /
actualType.type().kind();
}
- if (actualChars < dummyChars &&
- (extentErrors ||
- context.ShouldWarn(
- common::UsageWarning::ShortCharacterActual))) {
- auto msg{
- "Actual argument has fewer characters remaining in storage sequence (%jd) than %s (%jd)"_warn_en_US};
+ if (actualChars < dummyChars) {
if (extentErrors) {
- msg.set_severity(parser::Severity::Error);
+ messages.Say(
+ "Actual argument has fewer characters remaining in storage sequence (%jd) than %s (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(actualChars), dummyName,
+ static_cast<std::intmax_t>(dummyChars));
+ } else if (context.ShouldWarn(
+ common::UsageWarning::ShortCharacterActual)) {
+ messages.Say(common::UsageWarning::ShortCharacterActual,
+ "Actual argument has fewer characters remaining in storage sequence (%jd) than %s (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(actualChars), dummyName,
+ static_cast<std::intmax_t>(dummyChars));
}
- messages.Say(std::move(msg),
- static_cast<std::intmax_t>(actualChars), dummyName,
- static_cast<std::intmax_t>(dummyChars));
}
}
} else { // actual.type.Rank() > 0
if (auto actualSize{evaluate::ToInt64(evaluate::Fold(
foldingContext, evaluate::GetSize(actualType.shape())))};
actualSize &&
- *actualSize * *actualLength < *dummySize * *dummyLength &&
- (extentErrors ||
- context.ShouldWarn(
- common::UsageWarning::ShortCharacterActual))) {
- auto msg{
- "Actual argument array has fewer characters (%jd) than %s array (%jd)"_warn_en_US};
+ *actualSize * *actualLength < *dummySize * *dummyLength) {
if (extentErrors) {
- msg.set_severity(parser::Severity::Error);
+ messages.Say(
+ "Actual argument array has fewer characters (%jd) than %s array (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(*actualSize * *actualLength),
+ dummyName,
+ static_cast<std::intmax_t>(*dummySize * *dummyLength));
+ } else if (context.ShouldWarn(
+ common::UsageWarning::ShortCharacterActual)) {
+ messages.Say(common::UsageWarning::ShortCharacterActual,
+ "Actual argument array has fewer characters (%jd) than %s array (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(*actualSize * *actualLength),
+ dummyName,
+ static_cast<std::intmax_t>(*dummySize * *dummyLength));
}
- messages.Say(std::move(msg),
- static_cast<std::intmax_t>(*actualSize * *actualLength),
- dummyName,
- static_cast<std::intmax_t>(*dummySize * *dummyLength));
}
}
}
@@ -217,11 +220,11 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
if (context.ShouldWarn(
common::UsageWarning::ShortCharacterActual)) {
if (isVariable) {
- messages.Say(
+ messages.Say(common::UsageWarning::ShortCharacterActual,
"Actual argument variable length '%jd' is less than expected length '%jd'"_warn_en_US,
*actualLength, *dummyLength);
} else {
- messages.Say(
+ messages.Say(common::UsageWarning::ShortCharacterActual,
"Actual argument expression length '%jd' is less than expected length '%jd'"_warn_en_US,
*actualLength, *dummyLength);
}
@@ -260,23 +263,16 @@ static void ConvertIntegerActual(evaluate::Expr<evaluate::SomeType> &actual,
actual = std::move(*converted);
if (dummyType.type().kind() < actualType.type().kind()) {
if (!semanticsContext.IsEnabled(
- common::LanguageFeature::ActualIntegerConvertedToSmallerKind) ||
- semanticsContext.ShouldWarn(
common::LanguageFeature::ActualIntegerConvertedToSmallerKind)) {
- std::optional<parser::MessageFixedText> msg;
- if (!semanticsContext.IsEnabled(
- common::LanguageFeature::ActualIntegerConvertedToSmallerKind)) {
- msg =
- "Actual argument scalar expression of type INTEGER(%d) cannot beimplicitly converted to smaller dummy argument type INTEGER(%d)"_err_en_US;
- } else if (semanticsContext.ShouldWarn(
- common::LanguageFeature::ConvertedArgument)) {
- msg =
- "Actual argument scalar expression of type INTEGER(%d) was converted to smaller dummy argument type INTEGER(%d)"_port_en_US;
- }
- if (msg) {
- messages.Say(std::move(msg.value()), actualType.type().kind(),
- dummyType.type().kind());
- }
+ messages.Say(
+ "Actual argument scalar expression of type INTEGER(%d) cannot beimplicitly converted to smaller dummy argument type INTEGER(%d)"_err_en_US,
+ actualType.type().kind(), dummyType.type().kind());
+ } else if (semanticsContext.ShouldWarn(common::LanguageFeature::
+ ActualIntegerConvertedToSmallerKind)) {
+ messages.Say(
+ common::LanguageFeature::ActualIntegerConvertedToSmallerKind,
+ "Actual argument scalar expression of type INTEGER(%d) was converted to smaller dummy argument type INTEGER(%d)"_port_en_US,
+ actualType.type().kind(), dummyType.type().kind());
}
}
actualType = dummyType;
@@ -355,7 +351,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
constantChar && constantChar->wasHollerith() &&
dummy.type.type().IsUnlimitedPolymorphic() &&
context.ShouldWarn(common::LanguageFeature::HollerithPolymorphic)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::HollerithPolymorphic,
"passing Hollerith to unlimited polymorphic as if it were CHARACTER"_port_en_US);
}
} else if (dummyRank == 0 && allowActualArgumentConversions) {
@@ -364,7 +360,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
foldingContext, actual, dummy.type.type())}) {
if (context.ShouldWarn(
common::LanguageFeature::HollerithOrCharacterAsBOZ)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::HollerithOrCharacterAsBOZ,
"passing Hollerith or character literal as if it were BOZ"_port_en_US);
}
actual = *converted;
@@ -607,35 +603,38 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
*actualSymTypeBytes;
}
}
- if (actualElements && *actualElements < *dummySize &&
- (extentErrors ||
- context.ShouldWarn(
- common::UsageWarning::ShortArrayActual))) {
- auto msg{
- "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US};
+ if (actualElements && *actualElements < *dummySize) {
if (extentErrors) {
- msg.set_severity(parser::Severity::Error);
+ messages.Say(
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(*actualElements), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
+ } else if (context.ShouldWarn(
+ common::UsageWarning::ShortArrayActual)) {
+ messages.Say(common::UsageWarning::ShortArrayActual,
+ "Actual argument has fewer elements remaining in storage sequence (%jd) than %s array (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(*actualElements), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
}
- messages.Say(std::move(msg),
- static_cast<std::intmax_t>(*actualElements), dummyName,
- static_cast<std::intmax_t>(*dummySize));
}
}
}
} else { // actualRank > 0 || actualIsAssumedRank
if (auto actualSize{evaluate::ToInt64(evaluate::Fold(
foldingContext, evaluate::GetSize(actualType.shape())))};
- actualSize && *actualSize < *dummySize &&
- (extentErrors ||
- context.ShouldWarn(common::UsageWarning::ShortArrayActual))) {
- auto msg{
- "Actual argument array has fewer elements (%jd) than %s array (%jd)"_warn_en_US};
+ actualSize && *actualSize < *dummySize) {
if (extentErrors) {
- msg.set_severity(parser::Severity::Error);
+ messages.Say(
+ "Actual argument array has fewer elements (%jd) than %s array (%jd)"_err_en_US,
+ static_cast<std::intmax_t>(*actualSize), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
+ } else if (context.ShouldWarn(
+ common::UsageWarning::ShortArrayActual)) {
+ messages.Say(common::UsageWarning::ShortArrayActual,
+ "Actual argument array has fewer elements (%jd) than %s array (%jd)"_warn_en_US,
+ static_cast<std::intmax_t>(*actualSize), dummyName,
+ static_cast<std::intmax_t>(*dummySize));
}
- messages.Say(std::move(msg),
- static_cast<std::intmax_t>(*actualSize), dummyName,
- static_cast<std::intmax_t>(*dummySize));
}
}
}
@@ -683,8 +682,11 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
if (whyNot->IsFatal()) {
- if (auto *msg{
- messages.Say(std::move(*undefinableMessage), dummyName)}) {
+ if (auto *msg{messages.Say(*undefinableMessage, dummyName)}) {
+ if (!msg->IsFatal()) {
+ msg->set_languageFeature(common::LanguageFeature::
+ UndefinableAsynchronousOrVolatileActual);
+ }
msg->Attach(
std::move(whyNot->set_severity(parser::Severity::Because)));
}
@@ -747,7 +749,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
// is treated as an unassociated allocatable.
if (context.ShouldWarn(
common::LanguageFeature::NullActualForAllocatable)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::NullActualForAllocatable,
"Allocatable %s is associated with a null pointer"_port_en_US,
dummyName);
}
@@ -802,7 +804,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
if (context.ShouldWarn(
common::LanguageFeature::RelaxedIntentInChecking)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::RelaxedIntentInChecking,
"If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both should be so"_port_en_US);
}
} else {
@@ -814,7 +816,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
if (context.ShouldWarn(
common::LanguageFeature::RelaxedIntentInChecking)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::RelaxedIntentInChecking,
"If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_port_en_US);
}
} else if (actualIsPolymorphic &&
@@ -823,6 +825,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
if (context.ShouldWarn(common::LanguageFeature::
PolymorphicActualAllocatableOrPointerToMonomorphicDummy)) {
messages.Say(
+ common::LanguageFeature::
+ PolymorphicActualAllocatableOrPointerToMonomorphicDummy,
"If a POINTER or ALLOCATABLE actual argument is polymorphic, the corresponding dummy argument should also be so"_port_en_US);
}
} else {
@@ -838,7 +842,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
common::LanguageFeature::RelaxedIntentInChecking)) {
if (context.ShouldWarn(
common::LanguageFeature::RelaxedIntentInChecking)) {
- messages.Say(
+ messages.Say(common::LanguageFeature::RelaxedIntentInChecking,
"POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_port_en_US);
}
} else {
@@ -908,13 +912,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
bool actualIsTemp{!actualIsVariable || HasVectorSubscript(actual) ||
evaluate::ExtractCoarrayRef(actual)};
if (actualIsTemp) {
- messages.Say(
+ messages.Say(common::UsageWarning::NonTargetPassedToTarget,
"Any pointer associated with TARGET %s during this call will not be associated with the value of '%s' afterwards"_warn_en_US,
dummyName, actual.AsFortran());
} else {
auto actualSymbolVector{GetSymbolVector(actual)};
if (!evaluate::GetLastTarget(actualSymbolVector)) {
- messages.Say(
+ messages.Say(common::UsageWarning::NonTargetPassedToTarget,
"Any pointer associated with TARGET %s during this call must not be used afterwards, as '%s' is not a target"_warn_en_US,
dummyName, actual.AsFortran());
}
@@ -1012,15 +1016,16 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
return;
}
} else if (argProcSymbol->has<ProcBindingDetails>()) {
- if (!context.IsEnabled(common::LanguageFeature::BindingAsProcedure) ||
- context.ShouldWarn(common::LanguageFeature::BindingAsProcedure)) {
- parser::MessageFixedText msg{
- "Procedure binding '%s' passed as an actual argument"_port_en_US};
- if (!context.IsEnabled(common::LanguageFeature::BindingAsProcedure)) {
- msg.set_severity(parser::Severity::Error);
- }
- evaluate::SayWithDeclaration(
- messages, *argProcSymbol, std::move(msg), argProcSymbol->name());
+ if (!context.IsEnabled(common::LanguageFeature::BindingAsProcedure)) {
+ evaluate::SayWithDeclaration(messages, *argProcSymbol,
+ "Procedure binding '%s' passed as an actual argument"_err_en_US,
+ argProcSymbol->name());
+ } else if (context.ShouldWarn(
+ common::LanguageFeature::BindingAsProcedure)) {
+ evaluate::SayWithDeclaration(messages, *argProcSymbol,
+ common::LanguageFeature::BindingAsProcedure,
+ "Procedure binding '%s' passed as an actual argument"_port_en_US,
+ argProcSymbol->name());
}
}
}
@@ -1067,13 +1072,13 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
dummyName);
} else if (context.ShouldWarn(
common::UsageWarning::ImplicitInterfaceActual)) {
- messages.Say(
+ messages.Say(common::UsageWarning::ImplicitInterfaceActual,
"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);
}
} else if (warning &&
context.ShouldWarn(common::UsageWarning::ProcDummyArgShapes)) {
- messages.Say(
+ messages.Say(common::UsageWarning::ProcDummyArgShapes,
"Actual procedure argument has possible interface incompatibility with %s: %s"_warn_en_US,
dummyName, std::move(*warning));
}
@@ -1239,6 +1244,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
if (context.ShouldWarn(common::LanguageFeature::
NullActualForAllocatable)) {
messages.Say(
+ common::LanguageFeature::NullActualForAllocatable,
"Allocatable %s is associated with NULL()"_port_en_US,
dummyName);
}
@@ -1430,7 +1436,8 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
if (semanticsContext.ShouldWarn(common::UsageWarning::Portability)) {
if (!evaluate::ExtractDataRef(*pointerExpr) &&
!evaluate::IsProcedurePointer(*pointerExpr)) {
- messages.Say(pointerArg->sourceLocation(),
+ messages.Say(common::UsageWarning::Portability,
+ pointerArg->sourceLocation(),
"POINTER= argument of ASSOCIATED() is required by some other compilers to be a pointer"_port_en_US);
} else if (scope && !evaluate::UnwrapProcedureRef(*pointerExpr)) {
if (auto whyNot{WhyNotDefinable(
@@ -1440,7 +1447,8 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
DefinabilityFlag::DoNotNoteDefinition},
*pointerExpr)}) {
if (whyNot->IsFatal()) {
- if (auto *msg{messages.Say(pointerArg->sourceLocation(),
+ if (auto *msg{messages.Say(common::UsageWarning::Portability,
+ pointerArg->sourceLocation(),
"POINTER= argument of ASSOCIATED() is required by some other compilers to be a valid left-hand side of a pointer assignment statement"_port_en_US)}) {
msg->Attach(std::move(
whyNot->set_severity(parser::Severity::Because)));
@@ -1474,23 +1482,27 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
CheckProcCompatibility(isCall, pointerProc, &*targetProc,
specificIntrinsic, whyNot, warning,
/*ignoreImplicitVsExplicit=*/false)};
+ std::optional<common::UsageWarning> whichWarning;
if (!msg && warning &&
semanticsContext.ShouldWarn(
common::UsageWarning::ProcDummyArgShapes)) {
+ whichWarning = common::UsageWarning::ProcDummyArgShapes;
msg =
"Procedures '%s' and '%s' may not be completely compatible: %s"_warn_en_US;
whyNot = std::move(*warning);
- } else if (msg &&
- msg->severity() != parser::Severity::Error &&
- !semanticsContext.ShouldWarn(
+ } else if (msg && !msg->IsFatal() &&
+ semanticsContext.ShouldWarn(
common::UsageWarning::ProcPointerCompatibility)) {
- msg.reset();
+ whichWarning =
+ common::UsageWarning::ProcPointerCompatibility;
}
- if (msg) {
- msg->set_severity(parser::Severity::Warning);
- messages.Say(std::move(*msg),
- "pointer '" + pointerExpr->AsFortran() + "'",
- targetExpr->AsFortran(), whyNot);
+ if (msg && (msg->IsFatal() || whichWarning)) {
+ if (auto *said{messages.Say(std::move(*msg),
+ "pointer '" + pointerExpr->AsFortran() + "'",
+ targetExpr->AsFortran(), whyNot)};
+ said && whichWarning) {
+ said->set_usageWarning(*whichWarning);
+ }
}
}
} else if (!IsNullProcedurePointer(*targetExpr)) {
@@ -1819,6 +1831,7 @@ static void CheckTransferOperandType(SemanticsContext &context,
if (type.IsPolymorphic() &&
context.ShouldWarn(common::UsageWarning::PolymorphicTransferArg)) {
context.foldingContext().messages().Say(
+ common::UsageWarning::PolymorphicTransferArg,
"%s of TRANSFER is polymorphic"_warn_en_US, which);
} else if (!type.IsUnlimitedPolymorphic() &&
type.category() == TypeCategory::Derived &&
@@ -1827,6 +1840,7 @@ static void CheckTransferOperandType(SemanticsContext &context,
if (auto bad{std::find_if(directs.begin(), directs.end(), IsDescriptor)};
bad != directs.end()) {
evaluate::SayWithDeclaration(context.foldingContext().messages(), *bad,
+ common::UsageWarning::PointerComponentTransferArg,
"%s of TRANSFER contains allocatable or pointer component %s"_warn_en_US,
which, bad.BuildResultDesignatorName());
}
@@ -1856,7 +1870,7 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
"Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
}
} else if (context.ShouldWarn(common::UsageWarning::VoidMold)) {
- messages.Say(
+ messages.Say(common::UsageWarning::VoidMold,
"Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
}
}
@@ -1872,7 +1886,7 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
} else if (context.ShouldWarn(
common::UsageWarning::TransferSizePresence) &&
IsAllocatableOrObjectPointer(whole)) {
- messages.Say(
+ messages.Say(common::UsageWarning::TransferSizePresence,
"SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
}
}
@@ -2094,6 +2108,7 @@ bool CheckArguments(const characteristics::Procedure &proc,
if (context.ShouldWarn(
common::UsageWarning::KnownBadImplicitInterface)) {
if (auto *msg{messages.Say(
+ common::UsageWarning::KnownBadImplicitInterface,
"If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
buffer.AttachTo(*msg, parser::Severity::Because);
}
diff --git a/flang/lib/Semantics/check-case.cpp b/flang/lib/Semantics/check-case.cpp
index d296460127e12c..caa8f8b6e70be8 100644
--- a/flang/lib/Semantics/check-case.cpp
+++ b/flang/lib/Semantics/check-case.cpp
@@ -49,10 +49,8 @@ template <typename T> class CaseValues {
for (const auto &range : ranges) {
auto pair{ComputeBounds(range)};
if (pair.first && pair.second && *pair.first > *pair.second) {
- if (context_.ShouldWarn(common::UsageWarning::EmptyCase)) {
- context_.Say(stmt.source,
- "CASE has lower bound greater than upper bound"_warn_en_US);
- }
+ context_.Warn(common::UsageWarning::EmptyCase, stmt.source,
+ "CASE has lower bound greater than upper bound"_warn_en_US);
} else {
if constexpr (T::category == TypeCategory::Logical) { // C1148
if ((pair.first || pair.second) &&
@@ -95,11 +93,9 @@ template <typename T> class CaseValues {
x->v = converted;
return value;
} else {
- if (context_.ShouldWarn(common::UsageWarning::CaseOverflow)) {
- context_.Say(expr.source,
- "CASE value (%s) overflows type (%s) of SELECT CASE expression"_warn_en_US,
- folded.AsFortran(), caseExprType_.AsFortran());
- }
+ context_.Warn(common::UsageWarning::CaseOverflow, expr.source,
+ "CASE value (%s) overflows type (%s) of SELECT CASE expression"_warn_en_US,
+ folded.AsFortran(), caseExprType_.AsFortran());
hasErrors_ = true;
return std::nullopt;
}
diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp
index d8bd435bf09f38..eaf1d52a9fc1a8 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/flang/lib/Semantics/check-cuda.cpp
@@ -296,10 +296,8 @@ template <bool IsCUFKernelDo> class DeviceContextChecker {
return false;
}
void WarnOnIoStmt(const parser::CharBlock &source) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- context_.Say(
- source, "I/O statement might not be supported on device"_warn_en_US);
- }
+ context_.Warn(common::UsageWarning::CUDAUsage, source,
+ "I/O statement might not be supported on device"_warn_en_US);
}
template <typename A>
void WarnIfNotInternal(const A &stmt, const parser::CharBlock &source) {
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 9d3e8c5a4ea8f7..d6f1351c12d3cb 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -89,9 +89,8 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
"Procedure pointer '%s' may not appear in a DATA statement"_err_en_US,
symbol.name());
return false;
- } else if (context_.ShouldWarn(
- common::LanguageFeature::DataStmtExtensions)) {
- context_.Say(source_,
+ } else {
+ context_.Warn(common::LanguageFeature::DataStmtExtensions, source_,
"Procedure pointer '%s' in a DATA statement is not standard"_port_en_US,
symbol.name());
}
@@ -102,9 +101,8 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
"Blank COMMON object '%s' may not appear in a DATA statement"_err_en_US,
symbol.name());
return false;
- } else if (context_.ShouldWarn(
- common::LanguageFeature::DataStmtExtensions)) {
- context_.Say(source_,
+ } else {
+ context_.Warn(common::LanguageFeature::DataStmtExtensions, source_,
"Blank COMMON object '%s' in a DATA statement is not standard"_port_en_US,
symbol.name());
}
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index dfd49db74eea73..7778561fb5bd33 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -124,19 +124,23 @@ class CheckHelper {
return FindModuleFileContaining(context_.FindScope(messages_.at())) !=
nullptr;
}
- template <typename... A> parser::Message *WarnIfNotInModuleFile(A &&...x) {
- if (InModuleFile()) {
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(FeatureOrUsageWarning warning, A &&...x) {
+ if (!context_.ShouldWarn(warning) || InModuleFile()) {
return nullptr;
} else {
- return messages_.Say(std::forward<A>(x)...);
+ return messages_.Say(warning, std::forward<A>(x)...);
}
}
- template <typename... A>
- parser::Message *WarnIfNotInModuleFile(parser::CharBlock source, A &&...x) {
- if (FindModuleFileContaining(context_.FindScope(source))) {
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(
+ FeatureOrUsageWarning warning, parser::CharBlock source, A &&...x) {
+ if (!context_.ShouldWarn(warning) ||
+ FindModuleFileContaining(context_.FindScope(source))) {
return nullptr;
+ } else {
+ return messages_.Say(warning, source, std::forward<A>(x)...);
}
- return messages_.Say(source, std::forward<A>(x)...);
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckGlobalName(const Symbol &);
@@ -261,11 +265,9 @@ void CheckHelper::Check(const Symbol &symbol) {
}
if (symbol.name().size() > common::maxNameLen &&
&symbol == &symbol.GetUltimate()) {
- if (context_.ShouldWarn(common::LanguageFeature::LongNames)) {
- WarnIfNotInModuleFile(symbol.name(),
- "%s has length %d, which is greater than the maximum name length %d"_port_en_US,
- symbol.name(), symbol.name().size(), common::maxNameLen);
- }
+ Warn(common::LanguageFeature::LongNames, symbol.name(),
+ "%s has length %d, which is greater than the maximum name length %d"_port_en_US,
+ symbol.name(), symbol.name().size(), common::maxNameLen);
}
if (context_.HasError(symbol)) {
return;
@@ -448,10 +450,8 @@ void CheckHelper::Check(const Symbol &symbol) {
}
}
if (IsProcedurePointer(symbol) && IsDummy(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::Portability)) {
- messages_.Say(
- "A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
- }
+ Warn(common::UsageWarning::Portability,
+ "A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
// The non-dummy case is a hard error that's caught elsewhere.
}
}
@@ -481,12 +481,9 @@ void CheckHelper::Check(const Symbol &symbol) {
symbol.name());
} else if (symbol.owner().kind() == Scope::Kind::MainProgram) {
if (context_.IsEnabled(common::LanguageFeature::AutomaticInMainProgram)) {
- if (context_.ShouldWarn(
- common::LanguageFeature::AutomaticInMainProgram)) {
- messages_.Say(
- "Automatic data object '%s' should not appear in the specification part of a main program"_port_en_US,
- symbol.name());
- }
+ Warn(common::LanguageFeature::AutomaticInMainProgram,
+ "Automatic data object '%s' should not appear in the specification part of a main program"_port_en_US,
+ symbol.name());
} else {
messages_.Say(
"Automatic data object '%s' may not appear in the specification part of a main program"_err_en_US,
@@ -602,10 +599,9 @@ void CheckHelper::CheckValue(
messages_.Say(
"VALUE attribute may not apply to an assumed-rank array"_err_en_US);
}
- if (context_.ShouldWarn(common::UsageWarning::Portability) &&
- IsAssumedLengthCharacter(symbol)) {
+ if (IsAssumedLengthCharacter(symbol)) {
// F'2008 feature not widely implemented
- messages_.Say(
+ Warn(common::UsageWarning::Portability,
"VALUE attribute on assumed-length CHARACTER may not be portable"_port_en_US);
}
}
@@ -779,10 +775,8 @@ void CheckHelper::CheckObjectEntity(
}
if (ok && InFunction() && !InModuleFile() && !InElemental()) {
if (context_.IsEnabled(common::LanguageFeature::RelaxedPureDummy)) {
- if (context_.ShouldWarn(common::LanguageFeature::RelaxedPureDummy)) {
- messages_.Say(
- "non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE"_warn_en_US);
- }
+ Warn(common::LanguageFeature::RelaxedPureDummy,
+ "non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE"_warn_en_US);
} else {
messages_.Say(
"non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE"_err_en_US);
@@ -806,25 +800,19 @@ void CheckHelper::CheckObjectEntity(
if (IsPassedViaDescriptor(symbol)) {
if (IsAllocatableOrObjectPointer(&symbol)) {
if (inExplicitExternalInterface) {
- if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) {
- WarnIfNotInModuleFile(
- "!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);
- }
+ Warn(common::UsageWarning::IgnoreTKRUsage,
+ "!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);
} else {
messages_.Say(
"!DIR$ IGNORE_TKR may not apply to an allocatable or pointer"_err_en_US);
}
} else if (ignoreTKR.test(common::IgnoreTKR::Rank)) {
if (ignoreTKR.count() == 1 && evaluate::IsAssumedRank(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) {
- WarnIfNotInModuleFile(
- "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US);
- }
+ Warn(common::UsageWarning::IgnoreTKRUsage,
+ "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US);
} else if (inExplicitExternalInterface) {
- if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) {
- WarnIfNotInModuleFile(
- "!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US);
- }
+ Warn(common::UsageWarning::IgnoreTKRUsage,
+ "!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US);
} else {
messages_.Say(
"!DIR$ IGNORE_TKR(R) may not apply to a dummy argument passed via descriptor"_err_en_US);
@@ -884,10 +872,8 @@ void CheckHelper::CheckObjectEntity(
} else if (IsFunctionResult(symbol)) {
messages_.Say("A function result must not be initialized"_err_en_US);
} else if (IsInBlankCommon(symbol)) {
- if (context_.ShouldWarn(common::LanguageFeature::InitBlankCommon)) {
- WarnIfNotInModuleFile(
- "A variable in blank COMMON should not be initialized"_port_en_US);
- }
+ Warn(common::LanguageFeature::InitBlankCommon,
+ "A variable in blank COMMON should not be initialized"_port_en_US);
}
}
if (symbol.owner().kind() == Scope::Kind::BlockData) {
@@ -929,31 +915,25 @@ void CheckHelper::CheckObjectEntity(
bool inDeviceSubprogram{IsCUDADeviceContext(&symbol.owner())};
if (inDeviceSubprogram) {
if (IsSaved(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "'%s' should not have the SAVE attribute or initialization in a device subprogram"_warn_en_US,
- symbol.name());
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "'%s' should not have the SAVE attribute or initialization in a device subprogram"_warn_en_US,
+ symbol.name());
}
if (IsPointer(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "Pointer '%s' may not be associated in a device subprogram"_warn_en_US,
- symbol.name());
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "Pointer '%s' may not be associated in a device subprogram"_warn_en_US,
+ symbol.name());
}
if (details.isDummy() &&
details.cudaDataAttr().value_or(common::CUDADataAttr::Device) !=
common::CUDADataAttr::Device &&
details.cudaDataAttr().value_or(common::CUDADataAttr::Device) !=
common::CUDADataAttr::Managed) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "Dummy argument '%s' may not have ATTRIBUTES(%s) in a device subprogram"_warn_en_US,
- symbol.name(),
- parser::ToUpperCaseLetters(
- common::EnumToString(*details.cudaDataAttr())));
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "Dummy argument '%s' may not have ATTRIBUTES(%s) in a device subprogram"_warn_en_US,
+ symbol.name(),
+ parser::ToUpperCaseLetters(
+ common::EnumToString(*details.cudaDataAttr())));
}
}
if (details.cudaDataAttr()) {
@@ -1003,23 +983,17 @@ void CheckHelper::CheckObjectEntity(
break;
case common::CUDADataAttr::Pinned:
if (inDeviceSubprogram) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "Object '%s' with ATTRIBUTES(PINNED) may not be declared in a device subprogram"_warn_en_US,
- symbol.name());
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "Object '%s' with ATTRIBUTES(PINNED) may not be declared in a device subprogram"_warn_en_US,
+ symbol.name());
} else if (IsPointer(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "Object '%s' with ATTRIBUTES(PINNED) may not be a pointer"_warn_en_US,
- symbol.name());
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "Object '%s' with ATTRIBUTES(PINNED) may not be a pointer"_warn_en_US,
+ symbol.name());
} else if (!IsAllocatable(symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) {
- WarnIfNotInModuleFile(
- "Object '%s' with ATTRIBUTES(PINNED) should also be allocatable"_warn_en_US,
- symbol.name());
- }
+ Warn(common::UsageWarning::CUDAUsage,
+ "Object '%s' with ATTRIBUTES(PINNED) should also be allocatable"_warn_en_US,
+ symbol.name());
}
break;
case common::CUDADataAttr::Shared:
@@ -1281,10 +1255,8 @@ void CheckHelper::CheckProcEntity(
// because it is explicitly legal to *pass* the specific intrinsic
// function SIN as an actual argument.
if (interface->attrs().test(Attr::INTRINSIC)) {
- if (context_.ShouldWarn(common::UsageWarning::Portability)) {
- messages_.Say(
- "A dummy procedure should not have an ELEMENTAL intrinsic as its interface"_port_en_US);
- }
+ Warn(common::UsageWarning::Portability,
+ "A dummy procedure should not have an ELEMENTAL intrinsic as its interface"_port_en_US);
} else {
messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
}
@@ -1302,11 +1274,9 @@ void CheckHelper::CheckProcEntity(
"to procedure pointer '%s'"_err_en_US,
interface->name(), symbol.name());
} else if (IsElementalProcedure(*interface)) {
- if (context_.ShouldWarn(common::UsageWarning::Portability)) {
- messages_.Say(
- "Procedure pointer '%s' should not have an ELEMENTAL intrinsic as its interface"_port_en_US,
- symbol.name()); // C1517
- }
+ Warn(common::UsageWarning::Portability,
+ "Procedure pointer '%s' should not have an ELEMENTAL intrinsic as its interface"_port_en_US,
+ symbol.name()); // C1517
}
} else if (IsElementalProcedure(*interface)) {
messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
@@ -1470,13 +1440,11 @@ void CheckHelper::CheckSubprogram(
// 15.6.4 p2 weird requirement
if (const Symbol *
host{symbol.owner().parent().FindSymbol(symbol.name())}) {
- if (context_.ShouldWarn(
- common::LanguageFeature::StatementFunctionExtensions)) {
- evaluate::AttachDeclaration(
- messages_.Say(symbol.name(),
- "An implicitly typed statement function should not appear when the same symbol is available in its host scope"_port_en_US),
- *host);
- }
+ evaluate::AttachDeclaration(
+ Warn(common::LanguageFeature::StatementFunctionExtensions,
+ symbol.name(),
+ "An implicitly typed statement function should not appear when the same symbol is available in its host scope"_port_en_US),
+ *host);
}
}
if (GetProgramUnitOrBlockConstructContaining(symbol).kind() ==
@@ -1566,9 +1534,8 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
parser::Message *msg{nullptr};
if (!IsProcedure(*global)) {
if ((symbol.flags().test(Symbol::Flag::Function) ||
- symbol.flags().test(Symbol::Flag::Subroutine)) &&
- context_.ShouldWarn(common::UsageWarning::ExternalNameConflict)) {
- msg = WarnIfNotInModuleFile(
+ symbol.flags().test(Symbol::Flag::Subroutine))) {
+ msg = Warn(common::UsageWarning::ExternalNameConflict,
"The global entity '%s' corresponding to the local procedure '%s' is not a callable subprogram"_warn_en_US,
global->name(), symbol.name());
}
@@ -1577,20 +1544,16 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
if (chars->HasExplicitInterface()) {
std::string whyNot;
if (!chars->IsCompatibleWith(*globalChars,
- /*ignoreImplicitVsExplicit=*/false, &whyNot) &&
- context_.ShouldWarn(
- common::UsageWarning::ExternalInterfaceMismatch)) {
- msg = WarnIfNotInModuleFile(
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
+ msg = Warn(common::UsageWarning::ExternalInterfaceMismatch,
"The global subprogram '%s' is not compatible with its local procedure declaration (%s)"_warn_en_US,
global->name(), whyNot);
}
- } else if (!globalChars->CanBeCalledViaImplicitInterface() &&
- context_.ShouldWarn(
- common::UsageWarning::ExternalInterfaceMismatch)) {
+ } else if (!globalChars->CanBeCalledViaImplicitInterface()) {
// TODO: This should be a hard error if the procedure has
// actually been called (as opposed to just being used as a
// procedure pointer target or passed as an actual argument).
- msg = WarnIfNotInModuleFile(
+ msg = Warn(common::UsageWarning::ExternalInterfaceMismatch,
"The global subprogram '%s' should not be referenced via the implicit interface '%s'"_warn_en_US,
global->name(), symbol.name());
}
@@ -1611,10 +1574,8 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
if (auto previousChars{Characterize(previous)}) {
std::string whyNot;
if (!chars->IsCompatibleWith(*previousChars,
- /*ignoreImplicitVsExplicit=*/false, &whyNot) &&
- context_.ShouldWarn(
- common::UsageWarning::ExternalInterfaceMismatch)) {
- if (auto *msg{WarnIfNotInModuleFile(
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
+ if (auto *msg{Warn(common::UsageWarning::ExternalInterfaceMismatch,
"The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US,
symbol.name(), whyNot)}) {
evaluate::AttachDeclaration(msg, previous);
@@ -1891,22 +1852,20 @@ void CheckHelper::CheckSpecifics(
auto intrinsic{context_.intrinsics().IsSpecificIntrinsicFunction(
specific.name().ToString())};
if (intrinsic && !intrinsic->isRestrictedSpecific) {
- if (context_.ShouldWarn(common::LanguageFeature::IntrinsicAsSpecific)) {
- if (auto *msg{messages_.Say(specific.name(),
- "Specific procedure '%s' of generic interface '%s' should not be INTRINSIC"_port_en_US,
- specific.name(), generic.name())}) {
- msg->Attach(
- generic.name(), "Definition of '%s'"_en_US, generic.name());
- }
+ if (auto *msg{Warn(common::LanguageFeature::IntrinsicAsSpecific,
+ specific.name(),
+ "Specific procedure '%s' of generic interface '%s' should not be INTRINSIC"_port_en_US,
+ specific.name(), generic.name())}) {
+ msg->Attach(
+ generic.name(), "Definition of '%s'"_en_US, generic.name());
}
} else {
- if (context_.ShouldWarn(common::LanguageFeature::IntrinsicAsSpecific)) {
- if (auto *msg{messages_.Say(specific.name(),
- "Procedure '%s' of generic interface '%s' is INTRINSIC but not an unrestricted specific intrinsic function"_port_en_US,
- specific.name(), generic.name())}) {
- msg->Attach(
- generic.name(), "Definition of '%s'"_en_US, generic.name());
- }
+ if (auto *msg{Warn(common::LanguageFeature::IntrinsicAsSpecific,
+ specific.name(),
+ "Procedure '%s' of generic interface '%s' is INTRINSIC but not an unrestricted specific intrinsic function"_port_en_US,
+ specific.name(), generic.name())}) {
+ msg->Attach(
+ generic.name(), "Definition of '%s'"_en_US, generic.name());
}
continue;
}
@@ -2041,23 +2000,27 @@ bool CheckHelper::CheckDefinedOperator(SourceName opName, GenericKind kind,
msg = "%s function '%s' may not have assumed-length CHARACTER(*)"
" result"_err_en_US;
} else if (auto m{CheckNumberOfArgs(kind, proc.dummyArguments.size())}) {
- msg = std::move(m);
+ if (m->IsFatal()) {
+ msg = *m;
+ } else {
+ evaluate::AttachDeclaration(
+ Warn(common::UsageWarning::DefinedOperatorArgs, specific.name(),
+ std::move(*m), MakeOpName(opName), specific.name()),
+ specific);
+ return true;
+ }
} else if (!checkDefinedOperatorArgs(opName, specific, proc)) {
return false; // error was reported
} else if (ConflictsWithIntrinsicOperator(kind, proc)) {
msg = "%s function '%s' conflicts with intrinsic operator"_err_en_US;
- } else {
- return true; // OK
}
- bool isFatal{msg->IsFatal()};
- if (isFatal || !FindModuleFileContaining(specific.owner())) {
+ if (msg) {
SayWithDeclaration(
specific, std::move(*msg), MakeOpName(opName), specific.name());
- }
- if (isFatal) {
context_.SetError(specific);
+ return false;
}
- return !isFatal;
+ return true;
}
// If the number of arguments is wrong for this intrinsic operator, return
@@ -2114,32 +2077,29 @@ bool CheckHelper::CheckDefinedOperatorArg(const SourceName &opName,
auto &arg{proc.dummyArguments.at(pos)};
std::optional<parser::MessageFixedText> msg;
if (arg.IsOptional()) {
- msg = "In %s function '%s', dummy argument '%s' may not be"
- " OPTIONAL"_err_en_US;
+ msg =
+ "In %s function '%s', dummy argument '%s' may not be OPTIONAL"_err_en_US;
} else if (const auto *dataObject{std::get_if<DummyDataObject>(&arg.u)};
dataObject == nullptr) {
- msg = "In %s function '%s', dummy argument '%s' must be a"
- " data object"_err_en_US;
+ msg =
+ "In %s function '%s', dummy argument '%s' must be a data object"_err_en_US;
} else if (dataObject->intent == common::Intent::Out) {
msg =
"In %s function '%s', dummy argument '%s' may not be INTENT(OUT)"_err_en_US;
} else if (dataObject->intent != common::Intent::In &&
!dataObject->attrs.test(DummyDataObject::Attr::Value)) {
- if (context_.ShouldWarn(common::UsageWarning::DefinedOperatorArgs)) {
- msg =
- "In %s function '%s', dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US;
- }
+ evaluate::AttachDeclaration(
+ Warn(common::UsageWarning::DefinedOperatorArgs,
+ "In %s function '%s', dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US,
+ parser::ToUpperCaseLetters(opName.ToString()), symbol.name(),
+ arg.name),
+ symbol);
+ return true;
}
if (msg) {
- bool isFatal{msg->IsFatal()};
- if (isFatal || !FindModuleFileContaining(symbol.owner())) {
- SayWithDeclaration(symbol, std::move(*msg),
- parser::ToUpperCaseLetters(opName.ToString()), symbol.name(),
- arg.name);
- }
- if (isFatal) {
- return false;
- }
+ SayWithDeclaration(symbol, std::move(*msg),
+ parser::ToUpperCaseLetters(opName.ToString()), symbol.name(), arg.name);
+ return false;
}
return true;
}
@@ -2190,10 +2150,8 @@ bool CheckHelper::CheckDefinedAssignmentArg(
" may not have INTENT(IN)"_err_en_US;
} else if (dataObject->intent != common::Intent::Out &&
dataObject->intent != common::Intent::InOut) {
- if (context_.ShouldWarn(common::UsageWarning::DefinedOperatorArgs)) {
- msg =
- "In defined assignment subroutine '%s', first dummy argument '%s' should have INTENT(OUT) or INTENT(INOUT)"_warn_en_US;
- }
+ msg =
+ "In defined assignment subroutine '%s', first dummy argument '%s' should have INTENT(OUT) or INTENT(INOUT)"_warn_en_US;
}
} else if (pos == 1) {
if (dataObject->intent == common::Intent::Out) {
@@ -2201,10 +2159,8 @@ bool CheckHelper::CheckDefinedAssignmentArg(
" argument '%s' may not have INTENT(OUT)"_err_en_US;
} else if (dataObject->intent != common::Intent::In &&
!dataObject->attrs.test(DummyDataObject::Attr::Value)) {
- if (context_.ShouldWarn(common::UsageWarning::DefinedOperatorArgs)) {
- msg =
- "In defined assignment subroutine '%s', second dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US;
- }
+ msg =
+ "In defined assignment subroutine '%s', second dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US;
} else if (dataObject->attrs.test(DummyDataObject::Attr::Pointer)) {
msg =
"In defined assignment subroutine '%s', second dummy argument '%s' must not be a pointer"_err_en_US;
@@ -2220,13 +2176,15 @@ bool CheckHelper::CheckDefinedAssignmentArg(
" must be a data object"_err_en_US;
}
if (msg) {
- bool isFatal{msg->IsFatal()};
- if (isFatal || !FindModuleFileContaining(symbol.owner())) {
+ if (msg->IsFatal()) {
SayWithDeclaration(symbol, std::move(*msg), symbol.name(), arg.name);
- }
- if (isFatal) {
context_.SetError(symbol);
return false;
+ } else {
+ evaluate::AttachDeclaration(
+ Warn(common::UsageWarning::DefinedOperatorArgs, std::move(*msg),
+ symbol.name(), arg.name),
+ symbol);
}
}
return true;
@@ -2258,13 +2216,12 @@ void CheckHelper::WarnMissingFinal(const Symbol &symbol) {
while (const auto *derivedDetails{
derivedSym ? derivedSym->detailsIf<DerivedTypeDetails>() : nullptr}) {
if (!derivedDetails->finals().empty() &&
- !derivedDetails->GetFinalForRank(rank) &&
- context_.ShouldWarn(common::UsageWarning::Final)) {
+ !derivedDetails->GetFinalForRank(rank)) {
if (auto *msg{derivedSym == initialDerivedSym
- ? WarnIfNotInModuleFile(symbol.name(),
+ ? Warn(common::UsageWarning::Final, symbol.name(),
"'%s' of derived type '%s' does not have a FINAL subroutine for its rank (%d)"_warn_en_US,
symbol.name(), derivedSym->name(), rank)
- : WarnIfNotInModuleFile(symbol.name(),
+ : Warn(common::UsageWarning::Final, symbol.name(),
"'%s' of derived type '%s' extended from '%s' does not have a FINAL subroutine for its rank (%d)"_warn_en_US,
symbol.name(), initialDerivedSym->name(),
derivedSym->name(), rank)}) {
@@ -2316,16 +2273,17 @@ void CheckHelper::CheckContiguous(const Symbol &symbol) {
if (evaluate::IsVariable(symbol) &&
((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
evaluate::IsAssumedRank(symbol))) {
- } else if (!context_.IsEnabled(
- common::LanguageFeature::RedundantContiguous) ||
- context_.ShouldWarn(common::LanguageFeature::RedundantContiguous)) {
+ } else {
parser::MessageFixedText msg{symbol.owner().IsDerivedType()
? "CONTIGUOUS component '%s' should be an array with the POINTER attribute"_port_en_US
: "CONTIGUOUS entity '%s' should be an array pointer, assumed-shape, or assumed-rank"_port_en_US};
if (!context_.IsEnabled(common::LanguageFeature::RedundantContiguous)) {
msg.set_severity(parser::Severity::Error);
+ messages_.Say(std::move(msg), symbol.name());
+ } else {
+ Warn(common::LanguageFeature::RedundantContiguous, std::move(msg),
+ symbol.name());
}
- messages_.Say(std::move(msg), symbol.name());
}
}
@@ -2615,26 +2573,24 @@ void CheckHelper::Check(const Scope &scope) {
auto iter{scope.find(*name)};
if (iter != scope.end()) {
const char *kind{nullptr};
- if (context_.ShouldWarn(common::LanguageFeature::BenignNameClash)) {
- switch (scope.kind()) {
- case Scope::Kind::Module:
- kind = scope.symbol()->get<ModuleDetails>().isSubmodule()
- ? "submodule"
- : "module";
- break;
- case Scope::Kind::MainProgram:
- kind = "main program";
- break;
- case Scope::Kind::BlockData:
- kind = "BLOCK DATA subprogram";
- break;
- default:;
- }
- if (kind) {
- messages_.Say(iter->second->name(),
- "Name '%s' declared in a %s should not have the same name as the %s"_port_en_US,
- *name, kind, kind);
- }
+ switch (scope.kind()) {
+ case Scope::Kind::Module:
+ kind = scope.symbol()->get<ModuleDetails>().isSubmodule()
+ ? "submodule"
+ : "module";
+ break;
+ case Scope::Kind::MainProgram:
+ kind = "main program";
+ break;
+ case Scope::Kind::BlockData:
+ kind = "BLOCK DATA subprogram";
+ break;
+ default:;
+ }
+ if (kind) {
+ Warn(common::LanguageFeature::BenignNameClash, iter->second->name(),
+ "Name '%s' declared in a %s should not have the same name as the %s"_port_en_US,
+ *name, kind, kind);
}
}
}
@@ -2876,17 +2832,13 @@ void CheckHelper::CheckGlobalName(const Symbol &symbol) {
!IsExternalProcedureDefinition(other))) {
// both are procedures/BLOCK DATA, not both definitions
} else if (symbol.has<ModuleDetails>()) {
- if (context_.ShouldWarn(common::LanguageFeature::BenignNameClash)) {
- messages_.Say(symbol.name(),
- "Module '%s' conflicts with a global name"_port_en_US,
- pair.first->first);
- }
+ Warn(common::LanguageFeature::BenignNameClash, symbol.name(),
+ "Module '%s' conflicts with a global name"_port_en_US,
+ pair.first->first);
} else if (other.has<ModuleDetails>()) {
- if (context_.ShouldWarn(common::LanguageFeature::BenignNameClash)) {
- messages_.Say(symbol.name(),
- "Global name '%s' conflicts with a module"_port_en_US,
- pair.first->first);
- }
+ Warn(common::LanguageFeature::BenignNameClash, symbol.name(),
+ "Global name '%s' conflicts with a module"_port_en_US,
+ pair.first->first);
} else if (auto *msg{messages_.Say(symbol.name(),
"Two entities have the same global name '%s'"_err_en_US,
pair.first->first)}) {
@@ -3012,13 +2964,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
.value_or(false)) {
if (type->category() == DeclTypeSpec::Logical) {
if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool)) {
- msgs.Say(component.name(),
+ msgs.Say(common::UsageWarning::LogicalVsCBool, component.name(),
"A LOGICAL component of an interoperable type should have the interoperable KIND=C_BOOL"_port_en_US);
}
} else if (type->category() == DeclTypeSpec::Character && dyType &&
dyType->kind() == 1) {
if (context_.ShouldWarn(common::UsageWarning::BindCCharLength)) {
- msgs.Say(component.name(),
+ msgs.Say(common::UsageWarning::BindCCharLength, component.name(),
"A CHARACTER component of an interoperable type should have length 1"_port_en_US);
}
} else {
@@ -3036,7 +2988,7 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
}
if (derived->componentNames().empty()) { // F'2023 C1805
if (context_.ShouldWarn(common::LanguageFeature::EmptyBindCDerivedType)) {
- msgs.Say(symbol.name(),
+ msgs.Say(common::LanguageFeature::EmptyBindCDerivedType, symbol.name(),
"A derived type with the BIND attribute should not be empty"_warn_en_US);
}
}
@@ -3119,13 +3071,12 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
// when processing a module file, since the module file might have been
// compiled with CUDA while the client is not.
} else if (type->category() == DeclTypeSpec::Logical) {
- if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool) &&
- !InModuleFile()) {
+ if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool)) {
if (IsDummy(symbol)) {
- msgs.Say(symbol.name(),
+ msgs.Say(common::UsageWarning::LogicalVsCBool, symbol.name(),
"A BIND(C) LOGICAL dummy argument should have the interoperable KIND=C_BOOL"_port_en_US);
} else {
- msgs.Say(symbol.name(),
+ msgs.Say(common::UsageWarning::LogicalVsCBool, symbol.name(),
"A BIND(C) LOGICAL object should have the interoperable KIND=C_BOOL"_port_en_US);
}
}
diff --git a/flang/lib/Semantics/check-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h
index b32c10b0f3330b..a1aff52f3a6843 100644
--- a/flang/lib/Semantics/check-directive-structure.h
+++ b/flang/lib/Semantics/check-directive-structure.h
@@ -463,12 +463,11 @@ void DirectiveStructureChecker<D, C, PC,
}
// No clause matched in the actual clauses list
if (warnInsteadOfError) {
- if (context_.ShouldWarn(common::UsageWarning::Portability)) {
- context_.Say(GetContext().directiveSource,
- "At least one of %s clause should appear on the %s directive"_port_en_US,
- ClauseSetToString(GetContext().requiredClauses),
- ContextDirectiveAsFortran());
- }
+ context_.Warn(common::UsageWarning::Portability,
+ GetContext().directiveSource,
+ "At least one of %s clause should appear on the %s directive"_port_en_US,
+ ClauseSetToString(GetContext().requiredClauses),
+ ContextDirectiveAsFortran());
} else {
context_.Say(GetContext().directiveSource,
"At least one of %s clause must appear on the %s directive"_err_en_US,
@@ -493,13 +492,11 @@ bool DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
!GetContext().allowedExclusiveClauses.test(clause) &&
!GetContext().requiredClauses.test(clause)) {
if (warnInsteadOfError) {
- if (context_.ShouldWarn(common::UsageWarning::Portability)) {
- context_.Say(GetContext().clauseSource,
- "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
- parser::ToUpperCaseLetters(getClauseName(clause).str()),
- parser::ToUpperCaseLetters(
- GetContext().directiveSource.ToString()));
- }
+ context_.Warn(common::UsageWarning::Portability,
+ GetContext().clauseSource,
+ "%s clause is not allowed on the %s directive and will be ignored"_port_en_US,
+ parser::ToUpperCaseLetters(getClauseName(clause).str()),
+ parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
} else {
context_.Say(GetContext().clauseSource,
"%s clause is not allowed on the %s directive"_err_en_US,
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index b9778e96080a62..84e6b6455cc612 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -495,10 +495,8 @@ class DoContext {
void CheckDoControl(const parser::CharBlock &sourceLocation, bool isReal) {
if (isReal) {
- if (context_.ShouldWarn(common::LanguageFeature::RealDoControls)) {
- context_.Say(
- sourceLocation, "DO controls should be INTEGER"_port_en_US);
- }
+ context_.Warn(common::LanguageFeature::RealDoControls, sourceLocation,
+ "DO controls should be INTEGER"_port_en_US);
} else {
SayBadDoControl(sourceLocation);
}
@@ -552,9 +550,9 @@ class DoContext {
CheckDoExpression(bounds.upper);
if (bounds.step) {
CheckDoExpression(*bounds.step);
- if (IsZero(*bounds.step) &&
- context_.ShouldWarn(common::UsageWarning::ZeroDoStep)) {
- context_.Say(bounds.step->thing.value().source,
+ if (IsZero(*bounds.step)) {
+ context_.Warn(common::UsageWarning::ZeroDoStep,
+ bounds.step->thing.value().source,
"DO step expression should not be zero"_warn_en_US);
}
}
@@ -679,10 +677,9 @@ class DoContext {
if (std::holds_alternative<parser::LocalitySpec::DefaultNone>(ls.u)) {
if (hasDefaultNone) {
// F'2023 C1129, you can only have one DEFAULT(NONE)
- if (context_.ShouldWarn(common::LanguageFeature::BenignRedundancy)) {
- context_.Say(currentStatementSourcePosition_,
- "Only one DEFAULT(NONE) may appear"_port_en_US);
- }
+ context_.Warn(common::LanguageFeature::BenignRedundancy,
+ currentStatementSourcePosition_,
+ "Only one DEFAULT(NONE) may appear"_port_en_US);
break;
}
hasDefaultNone = true;
@@ -890,10 +887,9 @@ class DoContext {
},
assignment.u);
for (const Symbol &index : indexVars) {
- if (symbols.count(index) == 0 &&
- context_.ShouldWarn(common::UsageWarning::UnusedForallIndex)) {
- context_.Say("FORALL index variable '%s' not used on left-hand side"
- " of assignment"_warn_en_US,
+ if (symbols.count(index) == 0) {
+ context_.Warn(common::UsageWarning::UnusedForallIndex,
+ "FORALL index variable '%s' not used on left-hand side of assignment"_warn_en_US,
index.name());
}
}
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 46f07842b92cbb..eeeda553d8a467 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -232,8 +232,8 @@ void IoChecker::Enter(const parser::Format &spec) {
if (!IsVariable(*expr)) {
context_.Say(format.source,
"Assigned format label must be a scalar variable"_err_en_US);
- } else if (context_.ShouldWarn(common::LanguageFeature::Assign)) {
- context_.Say(format.source,
+ } else {
+ context_.Warn(common::LanguageFeature::Assign, format.source,
"Assigned format labels are deprecated"_port_en_US);
}
return;
@@ -245,11 +245,9 @@ void IoChecker::Enter(const parser::Format &spec) {
common::LanguageFeature::NonCharacterFormat)) {
// Legacy extension: using non-character variables, typically
// DATA-initialized with Hollerith, as format expressions.
- if (context_.ShouldWarn(
- common::LanguageFeature::NonCharacterFormat)) {
- context_.Say(format.source,
- "Non-character format expression is not standard"_port_en_US);
- }
+ context_.Warn(common::LanguageFeature::NonCharacterFormat,
+ format.source,
+ "Non-character format expression is not standard"_port_en_US);
} else if (!type ||
type->kind() !=
context_.defaultKinds().GetDefaultKind(type->category())) {
@@ -936,11 +934,8 @@ 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_.ShouldWarn(common::LanguageFeature::OpenAccessAppend)) {
- context_.Say(source,
- "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value,
- upper);
- }
+ context_.Warn(common::LanguageFeature::OpenAccessAppend, source,
+ "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value, upper);
} else {
context_.Say(source, "Invalid %s value '%s'"_err_en_US,
parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 51341b3faf3a45..741227741f9412 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -666,11 +666,10 @@ void OmpStructureChecker::CheckTargetNest(const parser::OpenMPConstruct &c) {
[&](const auto &c) {},
},
c.u);
- if (!eligibleTarget &&
- context_.ShouldWarn(common::UsageWarning::Portability)) {
- context_.Say(parser::FindSourceLocation(c),
- "If %s directive is nested inside TARGET region, the behaviour "
- "is unspecified"_port_en_US,
+ if (!eligibleTarget) {
+ context_.Warn(common::UsageWarning::Portability,
+ parser::FindSourceLocation(c),
+ "If %s directive is nested inside TARGET region, the behaviour is unspecified"_port_en_US,
parser::ToUpperCaseLetters(
getDirectiveName(ineligibleTargetDir).str()));
}
@@ -1077,12 +1076,10 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
ContextDirectiveAsFortran());
else if (GetContext().directive ==
llvm::omp::Directive::OMPD_declare_target)
- if (context_.ShouldWarn(
- common::UsageWarning::OpenMPUsage)) {
- context_.Say(name->source,
- "The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
- ContextDirectiveAsFortran());
- }
+ context_.Warn(common::UsageWarning::OpenMPUsage,
+ name->source,
+ "The entity with PARAMETER attribute is used in a %s directive"_warn_en_US,
+ ContextDirectiveAsFortran());
} else if (FindCommonBlockContaining(*name->symbol)) {
context_.Say(name->source,
"A variable in a %s directive cannot be an element of a "
@@ -1249,8 +1246,8 @@ void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) {
context_.Say(x.source,
"If the DECLARE TARGET directive has a clause, it must contain at least one ENTER clause or LINK clause"_err_en_US);
}
- if (toClause && context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) {
- context_.Say(toClause->source,
+ if (toClause) {
+ context_.Warn(common::UsageWarning::OpenMPUsage, toClause->source,
"The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US);
}
}
@@ -3143,9 +3140,8 @@ void OmpStructureChecker::CheckCopyingPolymorphicAllocatable(
const auto *symbol{it->first};
const auto source{it->second};
if (IsPolymorphicAllocatable(*symbol)) {
- context_.Say(source,
- "If a polymorphic variable with allocatable attribute '%s' is in "
- "%s clause, the behavior is unspecified"_port_en_US,
+ context_.Warn(common::UsageWarning::Portability, source,
+ "If a polymorphic variable with allocatable attribute '%s' is in %s clause, the behavior is unspecified"_port_en_US,
symbol->name(),
parser::ToUpperCaseLetters(getClauseName(clause).str()));
}
@@ -3246,11 +3242,10 @@ void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) {
if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
if (name->symbol) {
if (!(IsBuiltinCPtr(*(name->symbol)))) {
- if (context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) {
- context_.Say(itr->second->source,
- "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
- name->ToString());
- }
+ context_.Warn(common::UsageWarning::OpenMPUsage,
+ itr->second->source,
+ "Use of non-C_PTR type '%s' in USE_DEVICE_PTR is deprecated, use USE_DEVICE_ADDR instead"_warn_en_US,
+ name->ToString());
} else {
useDevicePtrNameList.push_back(*name);
}
@@ -3307,20 +3302,16 @@ void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
"Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
source.ToString());
} else if (!(IsDummy(*symbol))) {
- if (context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) {
- context_.Say(itr->second->source,
- "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
- "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
- source.ToString());
- }
+ context_.Warn(common::UsageWarning::OpenMPUsage, itr->second->source,
+ "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument. "
+ "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
+ source.ToString());
} else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
- if (context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) {
- context_.Say(itr->second->source,
- "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
- "that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
- "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
- source.ToString());
- }
+ context_.Warn(common::UsageWarning::OpenMPUsage, itr->second->source,
+ "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument "
+ "that does not have the ALLOCATABLE, POINTER or VALUE attribute. "
+ "This semantic check is deprecated from OpenMP 5.2 and later."_warn_en_US,
+ source.ToString());
}
}
}
diff --git a/flang/lib/Semantics/check-return.cpp b/flang/lib/Semantics/check-return.cpp
index ec2600bac3c68e..22729f659ed5be 100644
--- a/flang/lib/Semantics/check-return.cpp
+++ b/flang/lib/Semantics/check-return.cpp
@@ -36,9 +36,9 @@ void ReturnStmtChecker::Leave(const parser::ReturnStmt &returnStmt) {
IsFunction(*subprogramScope->GetSymbol()))) {
context_.Say(
"RETURN with expression is only allowed in SUBROUTINE subprogram"_err_en_US);
- } else if (subprogramScope->kind() == Scope::Kind::MainProgram &&
- context_.ShouldWarn(common::LanguageFeature::ProgramReturn)) {
- context_.Say("RETURN should not appear in a main program"_port_en_US);
+ } else if (subprogramScope->kind() == Scope::Kind::MainProgram) {
+ context_.Warn(common::LanguageFeature::ProgramReturn,
+ "RETURN should not appear in a main program"_port_en_US);
}
}
}
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index b5a58ddca0ecdd..028633813a91b6 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -167,11 +167,9 @@ void ComputeOffsetsHelper::DoCommonBlock(Symbol &commonBlock) {
auto errorSite{
commonBlock.name().empty() ? symbol.name() : commonBlock.name()};
if (std::size_t padding{DoSymbol(symbol.GetUltimate())}) {
- if (context_.ShouldWarn(common::UsageWarning::CommonBlockPadding)) {
- context_.Say(errorSite,
- "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
- commonBlock.name(), padding, symbol.name());
- }
+ context_.Warn(common::UsageWarning::CommonBlockPadding, errorSite,
+ "COMMON block /%s/ requires %zd bytes of padding before '%s' for alignment"_port_en_US,
+ commonBlock.name(), padding, symbol.name());
}
previous.emplace(symbol);
auto eqIter{equivalenceBlock_.end()};
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 0f8b36de460865..c9b86a930437af 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -298,12 +298,10 @@ DataInitializationCompiler<DSV>::ConvertElement(
if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
if (MaybeExpr converted{evaluate::DataConstantConversionExtension(
exprAnalyzer_.GetFoldingContext(), type, expr)}) {
- if (context.ShouldWarn(
- common::LanguageFeature::LogicalIntegerAssignment)) {
- context.Say(
- "nonstandard usage: initialization of %s with %s"_port_en_US,
- type.AsFortran(), expr.GetType().value().AsFortran());
- }
+ context.Warn(common::LanguageFeature::LogicalIntegerAssignment,
+ exprAnalyzer_.GetFoldingContext().messages().at(),
+ "nonstandard usage: initialization of %s with %s"_port_en_US,
+ type.AsFortran(), expr.GetType().value().AsFortran());
return {std::make_pair(std::move(*converted), false)};
}
}
@@ -434,16 +432,11 @@ bool DataInitializationCompiler<DSV>::InitElement(
// value non-pointer initialization
if (IsBOZLiteral(*expr) &&
designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
- if (exprAnalyzer_.context().ShouldWarn(
- common::LanguageFeature::DataStmtExtensions)) {
- exprAnalyzer_.Say(
- "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_port_en_US,
- DescribeElement(), designatorType->AsFortran());
- }
- } else if (converted->second &&
- exprAnalyzer_.context().ShouldWarn(
- common::LanguageFeature::DataStmtExtensions)) {
- exprAnalyzer_.context().Say(
+ exprAnalyzer_.Warn(common::LanguageFeature::DataStmtExtensions,
+ "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_port_en_US,
+ DescribeElement(), designatorType->AsFortran());
+ } else if (converted->second) {
+ exprAnalyzer_.Warn(common::LanguageFeature::DataStmtExtensions,
"DATA statement value initializes '%s' of type '%s' with CHARACTER"_port_en_US,
DescribeElement(), designatorType->AsFortran());
}
@@ -462,12 +455,9 @@ bool DataInitializationCompiler<DSV>::InitElement(
} else if (status == evaluate::InitialImage::OutOfRange) {
OutOfRangeError();
} else if (status == evaluate::InitialImage::LengthMismatch) {
- if (exprAnalyzer_.context().ShouldWarn(
- common::UsageWarning::DataLength)) {
- exprAnalyzer_.Say(
- "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US,
- folded.AsFortran(), DescribeElement());
- }
+ exprAnalyzer_.Warn(common::UsageWarning::DataLength,
+ "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US,
+ folded.AsFortran(), DescribeElement());
return true;
} else if (status == evaluate::InitialImage::TooManyElems) {
exprAnalyzer_.Say("DATA statement has too many elements"_err_en_US);
diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index 5c41376d2a42bf..88f9463e35c787 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -349,7 +349,8 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
if (!portabilityWarning &&
scope.context().languageFeatures().ShouldWarn(
common::UsageWarning::VectorSubscriptFinalization)) {
- portabilityWarning = parser::Message{at,
+ portabilityWarning = parser::Message{
+ common::UsageWarning::VectorSubscriptFinalization, at,
"Variable '%s' has a vector subscript and will be finalized by non-elemental subroutine '%s'"_port_en_US,
expr.AsFortran(), anyRankMatch->name()};
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 364f99d73f5cc8..c70c8a8aecc2f8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -663,10 +663,8 @@ struct IntTypeVisitor {
auto unsignedNum{Int::Read(p, 10, false /*unsigned*/)};
num.value = unsignedNum.value.Negate().value;
num.overflow = unsignedNum.overflow || num.value > Int{0};
- if (!num.overflow && num.value.Negate().overflow &&
- analyzer.context().ShouldWarn(LanguageFeature::BigIntLiterals) &&
- !analyzer.context().IsInModuleFile(digits)) {
- analyzer.Say(digits,
+ if (!num.overflow && num.value.Negate().overflow) {
+ analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
"negated maximum INTEGER(KIND=%d) literal"_port_en_US, T::kind);
}
} else {
@@ -677,9 +675,8 @@ struct IntTypeVisitor {
if (!isDefaultKind ||
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
return std::nullopt;
- } else if (analyzer.context().ShouldWarn(
- LanguageFeature::BigIntLiterals)) {
- analyzer.Say(digits,
+ } else {
+ analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
"Integer literal is too large for default INTEGER(KIND=%d); "
"assuming INTEGER(KIND=%d)"_port_en_US,
kind, T::kind);
@@ -809,16 +806,12 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) {
auto kind{AnalyzeKindParam(x.kind, defaultKind)};
if (letterKind && expoLetter != 'e') {
if (kind != *letterKind) {
- if (context_.ShouldWarn(
- common::LanguageFeature::ExponentMatchingKindParam)) {
- Say("Explicit kind parameter on real constant disagrees with exponent letter '%c'"_warn_en_US,
- expoLetter);
- }
- } else if (x.kind &&
- context_.ShouldWarn(
- common::LanguageFeature::ExponentMatchingKindParam)) {
- Say("Explicit kind parameter together with non-'E' exponent letter "
- "is not standard"_port_en_US);
+ Warn(common::LanguageFeature::ExponentMatchingKindParam,
+ "Explicit kind parameter on real constant disagrees with exponent letter '%c'"_warn_en_US,
+ expoLetter);
+ } else if (x.kind) {
+ Warn(common::LanguageFeature::ExponentMatchingKindParam,
+ "Explicit kind parameter together with non-'E' exponent letter is not standard"_port_en_US);
}
}
auto result{common::SearchTypes(
@@ -1657,11 +1650,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
if (!type_) {
if (auto *boz{std::get_if<BOZLiteralConstant>(&x->u)}) {
// Treat an array constructor of BOZ as if default integer.
- if (exprAnalyzer_.context().ShouldWarn(
- common::LanguageFeature::BOZAsDefaultInteger)) {
- exprAnalyzer_.Say(
- "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_port_en_US);
- }
+ exprAnalyzer_.Warn(common::LanguageFeature::BOZAsDefaultInteger,
+ "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_port_en_US);
x = AsGenericExpr(ConvertToKind<TypeCategory::Integer>(
exprAnalyzer_.GetDefaultKind(TypeCategory::Integer),
std::move(*boz)));
@@ -1672,11 +1662,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
if (auto *boz{std::get_if<BOZLiteralConstant>(&x->u)}) {
if (!type_) {
// Treat an array constructor of BOZ as if default integer.
- if (exprAnalyzer_.context().ShouldWarn(
- common::LanguageFeature::BOZAsDefaultInteger)) {
- exprAnalyzer_.Say(
- "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_port_en_US);
- }
+ exprAnalyzer_.Warn(common::LanguageFeature::BOZAsDefaultInteger,
+ "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_port_en_US);
x = AsGenericExpr(ConvertToKind<TypeCategory::Integer>(
exprAnalyzer_.GetDefaultKind(TypeCategory::Integer),
std::move(*boz)));
@@ -1740,15 +1727,12 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
auto xLen{xType.LEN()};
if (auto thisLen{ToInt64(xLen)}) {
if (constantLength_) {
- if (exprAnalyzer_.context().ShouldWarn(
- common::LanguageFeature::DistinctArrayConstructorLengths) &&
- *thisLen != *constantLength_) {
- if (!(messageDisplayedSet_ & 1)) {
- exprAnalyzer_.Say(
- "Character literal in array constructor without explicit "
- "type has
diff erent length than earlier elements"_port_en_US);
- messageDisplayedSet_ |= 1;
- }
+ if (*thisLen != *constantLength_ && !(messageDisplayedSet_ & 1)) {
+ exprAnalyzer_.Warn(
+ common::LanguageFeature::DistinctArrayConstructorLengths,
+ "Character literal in array constructor without explicit "
+ "type has
diff erent length than earlier elements"_port_en_US);
+ messageDisplayedSet_ |= 1;
}
if (*thisLen > *constantLength_) {
// Language extension: use the longest literal to determine the
@@ -2091,11 +2075,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(
valueType->IsEquivalentTo(*parentType)) {
symbol = &*parent;
nextAnonymous = ++parent;
- if (context().ShouldWarn(LanguageFeature::AnonymousParents)) {
- Say(source,
- "Whole parent component '%s' in structure constructor should not be anonymous"_port_en_US,
- symbol->name());
- }
+ Warn(LanguageFeature::AnonymousParents, source,
+ "Whole parent component '%s' in structure constructor should not be anonymous"_port_en_US,
+ symbol->name());
break;
}
}
@@ -2166,14 +2148,13 @@ MaybeExpr ExpressionAnalyzer::Analyze(
continue;
}
if (IsNullObjectPointer(*value)) {
- if (context().ShouldWarn(common::LanguageFeature::
- NullMoldAllocatableComponentValue)) {
- AttachDeclaration(
- Say(expr.source,
- "NULL() with arguments is not standard conforming as the value for allocatable component '%s'"_port_en_US,
- symbol->name()),
- *symbol);
- }
+ AttachDeclaration(
+ Warn(common::LanguageFeature::
+ NullMoldAllocatableComponentValue,
+ expr.source,
+ "NULL() with arguments is not standard conforming as the value for allocatable component '%s'"_port_en_US,
+ symbol->name()),
+ *symbol);
// proceed to check type & shape
} else {
AttachDeclaration(
@@ -2459,13 +2440,11 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
sym->attrs().test(semantics::Attr::NOPASS)) {
// F'2023 C1529 seems unnecessary and most compilers don't
// enforce it.
- if (context().ShouldWarn(
- common::LanguageFeature::NopassScalarBase)) {
- AttachDeclaration(
- Say(sc.component.source,
- "Base of NOPASS type-bound procedure reference should be scalar"_port_en_US),
- *sym);
- }
+ AttachDeclaration(
+ Warn(common::LanguageFeature::NopassScalarBase,
+ sc.component.source,
+ "Base of NOPASS type-bound procedure reference should be scalar"_port_en_US),
+ *sym);
} else if (IsProcedurePointer(*sym)) { // C919
Say(sc.component.source,
"Base of procedure component reference must be scalar"_err_en_US);
@@ -2970,10 +2949,9 @@ void ExpressionAnalyzer::CheckBadExplicitType(
if (const auto *typeAndShape{result->GetTypeAndShape()}) {
if (auto declared{
typeAndShape->Characterize(intrinsic, GetFoldingContext())}) {
- if (!declared->type().IsTkCompatibleWith(typeAndShape->type()) &&
- context_.ShouldWarn(
- common::UsageWarning::IgnoredIntrinsicFunctionType)) {
- if (auto *msg{Say(
+ if (!declared->type().IsTkCompatibleWith(typeAndShape->type())) {
+ if (auto *msg{Warn(
+ common::UsageWarning::IgnoredIntrinsicFunctionType,
"The result type '%s' of the intrinsic function '%s' is not the explicit declared type '%s'"_warn_en_US,
typeAndShape->AsFortran(), intrinsic.name(),
declared->AsFortran())}) {
@@ -3345,10 +3323,10 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
iter != implicitInterfaces_.end()) {
std::string whyNot;
if (!chars->IsCompatibleWith(iter->second.second,
- /*ignoreImplicitVsExplicit=*/false, &whyNot) &&
- context_.ShouldWarn(
- common::UsageWarning::IncompatibleImplicitInterfaces)) {
- if (auto *msg{Say(callSite,
+ /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
+ if (auto *msg{Warn(
+ common::UsageWarning::IncompatibleImplicitInterfaces,
+ callSite,
"Reference to the procedure '%s' has an implicit interface that is distinct from another reference: %s"_warn_en_US,
name, whyNot)}) {
msg->Attach(
@@ -3558,10 +3536,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::Expr::ComplexConstructor &z) {
- if (context_.ShouldWarn(common::LanguageFeature::ComplexConstructor)) {
- context_.Say(
- "nonstandard usage: generalized COMPLEX constructor"_port_en_US);
- }
+ Warn(common::LanguageFeature::ComplexConstructor,
+ "nonstandard usage: generalized COMPLEX constructor"_port_en_US);
return AnalyzeComplex(Analyze(std::get<0>(z.t).value()),
Analyze(std::get<1>(z.t).value()), "complex constructor");
}
@@ -4040,11 +4016,9 @@ bool ExpressionAnalyzer::CheckIntrinsicKind(
return true;
} else if (foldingContext_.targetCharacteristics().CanSupportType(
category, kind)) {
- if (context_.ShouldWarn(common::UsageWarning::BadTypeForTarget) &&
- !context_.IsInModuleFile(GetContextualMessages().at())) {
- Say("%s(KIND=%jd) is not an enabled type for this target"_warn_en_US,
- ToUpperCase(EnumToString(category)), kind);
- }
+ Warn(common::UsageWarning::BadTypeForTarget,
+ "%s(KIND=%jd) is not an enabled type for this target"_warn_en_US,
+ ToUpperCase(EnumToString(category)), kind);
return true;
} else {
Say("%s(KIND=%jd) is not a supported type"_err_en_US,
@@ -4070,10 +4044,9 @@ bool ExpressionAnalyzer::CheckIntrinsicSize(
return true;
} else if (foldingContext_.targetCharacteristics().CanSupportType(
category, kind)) {
- if (context_.ShouldWarn(common::UsageWarning::BadTypeForTarget)) {
- Say("%s*%jd is not an enabled type for this target"_warn_en_US,
- ToUpperCase(EnumToString(category)), size);
- }
+ Warn(common::UsageWarning::BadTypeForTarget,
+ "%s*%jd is not an enabled type for this target"_warn_en_US,
+ ToUpperCase(EnumToString(category)), size);
return true;
} else {
Say("%s*%jd is not a supported type"_err_en_US,
@@ -4177,13 +4150,13 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
MaybeExpr ExpressionAnalyzer::AnalyzeComplex(
MaybeExpr &&re, MaybeExpr &&im, const char *what) {
- if (context().ShouldWarn(common::LanguageFeature::ComplexConstructor)) {
- if (re && re->Rank() > 0) {
- Say("Real part of %s is not scalar"_port_en_US, what);
- }
- if (im && im->Rank() > 0) {
- Say("Imaginary part of %s is not scalar"_port_en_US, what);
- }
+ if (re && re->Rank() > 0) {
+ Warn(common::LanguageFeature::ComplexConstructor,
+ "Real part of %s is not scalar"_port_en_US, what);
+ }
+ if (im && im->Rank() > 0) {
+ Warn(common::LanguageFeature::ComplexConstructor,
+ "Imaginary part of %s is not scalar"_port_en_US, what);
}
if (re && im) {
ConformabilityCheck(GetContextualMessages(), *re, *im);
@@ -4594,10 +4567,8 @@ bool ArgumentAnalyzer::OkLogicalIntegerAssignment(
} else {
return false;
}
- if (context_.context().ShouldWarn(
- common::LanguageFeature::LogicalIntegerAssignment)) {
- context_.Say(std::move(*msg));
- }
+ context_.Warn(
+ common::LanguageFeature::LogicalIntegerAssignment, std::move(*msg));
return true;
}
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 52a5a321aba646..075f33cb684885 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1482,14 +1482,16 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
if (!checkSum) {
if (context_.ShouldWarn(common::UsageWarning::ModuleFile)) {
Say(name, ancestorName, "File has invalid checksum: %s"_warn_en_US,
- sourceFile->path());
+ sourceFile->path())
+ .set_usageWarning(common::UsageWarning::ModuleFile);
}
return nullptr;
} else if (requiredHash && *requiredHash != *checkSum) {
if (context_.ShouldWarn(common::UsageWarning::ModuleFile)) {
Say(name, ancestorName,
"File is not the right module file for %s"_warn_en_US,
- "'"s + name.ToString() + "': "s + sourceFile->path());
+ "'"s + name.ToString() + "': "s + sourceFile->path())
+ .set_usageWarning(common::UsageWarning::ModuleFile);
}
return nullptr;
}
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 2813a0cf968cbd..2450ce39215ec9 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -77,6 +77,8 @@ class PointerAssignmentChecker {
const evaluate::SpecificIntrinsic *specific = nullptr);
bool LhsOkForUnlimitedPoly() const;
template <typename... A> parser::Message *Say(A &&...);
+ template <typename FeatureOrUsageWarning, typename... A>
+ parser::Message *Warn(FeatureOrUsageWarning, A &&...);
SemanticsContext &context_;
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -215,20 +217,17 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
return false;
}
- } else if (context_.ShouldWarn(
- common::UsageWarning::PointerToPossibleNoncontiguous)) {
- Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
+ } else {
+ Warn(common::UsageWarning::PointerToPossibleNoncontiguous,
+ "Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
}
}
// Warn about undefinable data targets
- 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->set_severity(parser::Severity::Because)));
- }
+ if (auto because{
+ WhyNotDefinable(foldingContext_.messages().at(), scope_, {}, rhs)}) {
+ if (auto *msg{Warn(common::UsageWarning::PointerToUndefinable,
+ "Pointer target is not a definable variable"_warn_en_US)}) {
+ msg->Attach(std::move(because->set_severity(parser::Severity::Because)));
return false;
}
}
@@ -270,10 +269,11 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
" that is a not a pointer"_err_en_US;
} else if (isContiguous_ &&
!funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
- if (context_.ShouldWarn(
- common::UsageWarning::PointerToPossibleNoncontiguous)) {
- msg =
- "CONTIGUOUS %s is associated with the result of reference to function '%s' that is not known to be contiguous"_warn_en_US;
+ auto restorer{common::ScopedSet(lhs_, symbol)};
+ if (Warn(common::UsageWarning::PointerToPossibleNoncontiguous,
+ "CONTIGUOUS %s is associated with the result of reference to function '%s' that is not known to be contiguous"_warn_en_US,
+ description_, funcName)) {
+ return false;
}
} else if (lhsType_) {
const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
@@ -377,9 +377,9 @@ bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
Say(std::move(*msg), description_, rhsName, whyNot);
return false;
}
- if (context_.ShouldWarn(common::UsageWarning::ProcDummyArgShapes) &&
- warning) {
- Say("%s and %s may not be completely compatible procedures: %s"_warn_en_US,
+ if (warning) {
+ Warn(common::UsageWarning::ProcDummyArgShapes,
+ "%s and %s may not be completely compatible procedures: %s"_warn_en_US,
description_, rhsName, std::move(*warning));
}
return true;
@@ -396,11 +396,12 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
symbol->name());
return false;
}
- } else if (symbol->has<ProcBindingDetails>() &&
- context_.ShouldWarn(common::LanguageFeature::BindingAsProcedure)) {
- evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
- "Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
- symbol->name());
+ } else if (symbol->has<ProcBindingDetails>()) {
+ evaluate::AttachDeclaration(
+ Warn(common::LanguageFeature::BindingAsProcedure,
+ "Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
+ symbol->name()),
+ *symbol);
}
}
if (auto chars{
@@ -447,6 +448,22 @@ parser::Message *PointerAssignmentChecker::Say(A &&...x) {
return msg;
}
+template <typename FeatureOrUsageWarning, typename... A>
+parser::Message *PointerAssignmentChecker::Warn(
+ FeatureOrUsageWarning warning, A &&...x) {
+ auto *msg{context_.Warn(
+ warning, foldingContext_.messages().at(), std::forward<A>(x)...)};
+ if (msg) {
+ if (lhs_) {
+ return evaluate::AttachDeclaration(msg, *lhs_);
+ }
+ if (!source_.empty()) {
+ msg->Attach(source_, "Declaration of %s"_en_US, description_);
+ }
+ }
+ return msg;
+}
+
// Verify that any bounds on the LHS of a pointer assignment are valid.
// Return true if it is a bound-remapping so we can perform further checks.
static bool CheckPointerBounds(
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 23a1ecbd2842d5..2b9bf0824d5340 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2888,8 +2888,7 @@ void OmpAttributeVisitor::IssueNonConformanceWarning(
default:
warnStr = "OpenMP directive '" + dirName + "' has been deprecated.";
}
- if (context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) {
- context_.Say(source, "%s"_warn_en_US, warnStr);
- }
+ context_.Warn(
+ common::UsageWarning::OpenMPUsage, source, "%s"_warn_en_US, warnStr);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp
index e5e96ec6327e2b..04e4b142efedf8 100644
--- a/flang/lib/Semantics/resolve-labels.cpp
+++ b/flang/lib/Semantics/resolve-labels.cpp
@@ -938,7 +938,9 @@ void CheckBranchesIntoDoBody(const SourceStmtList &branches,
context
.Say(
fromPosition, "branch into loop body from outside"_warn_en_US)
- .Attach(body.first, "the loop branched into"_en_US);
+ .Attach(body.first, "the loop branched into"_en_US)
+ .set_languageFeature(
+ common::LanguageFeature::BranchIntoConstruct);
}
}
}
@@ -1007,7 +1009,9 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
.Say(position,
"A DO loop should terminate with an END DO or CONTINUE"_port_en_US)
.Attach(doTarget.parserCharBlock,
- "DO loop currently ends at statement:"_en_US);
+ "DO loop currently ends at statement:"_en_US)
+ .set_languageFeature(
+ common::LanguageFeature::OldLabelDoEndStatements);
}
} else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {
context.Say(position, "Label '%u' is not in DO loop scope"_err_en_US,
@@ -1067,9 +1071,11 @@ void CheckScopeConstraints(const SourceStmtList &stmts,
SayLabel(label));
} else if (context.ShouldWarn(
common::LanguageFeature::BranchIntoConstruct)) {
- context.Say(position,
- "Label '%u' is in a construct that should not be used as a branch target here"_warn_en_US,
- SayLabel(label));
+ context
+ .Say(position,
+ "Label '%u' is in a construct that should not be used as a branch target here"_warn_en_US,
+ SayLabel(label))
+ .set_languageFeature(common::LanguageFeature::BranchIntoConstruct);
}
}
}
@@ -1097,7 +1103,8 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts,
.Say(branchTarget.parserCharBlock,
"Label '%u' is not a branch target"_warn_en_US, SayLabel(label))
.Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US,
- SayLabel(label));
+ SayLabel(label))
+ .set_languageFeature(common::LanguageFeature::BadBranchTarget);
}
}
}
@@ -1152,9 +1159,12 @@ void CheckAssignTargetConstraints(const SourceStmtList &stmts,
"Label '%u' is not a branch target or FORMAT"_err_en_US,
SayLabel(label));
} else if (context.ShouldWarn(common::LanguageFeature::BadBranchTarget)) {
- msg = &context.Say(target.parserCharBlock,
- "Label '%u' is not a branch target or FORMAT"_warn_en_US,
- SayLabel(label));
+ msg =
+ &context
+ .Say(target.parserCharBlock,
+ "Label '%u' is not a branch target or FORMAT"_warn_en_US,
+ SayLabel(label))
+ .set_languageFeature(common::LanguageFeature::BadBranchTarget);
}
if (msg) {
msg->Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US,
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 39392257938d66..b8ce8d14a33faa 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -435,6 +435,7 @@ void EquivalenceSets::FinishSet(const parser::CharBlock &source) {
// set.
bool EquivalenceSets::CheckCanEquivalence(
const parser::CharBlock &source, const Symbol &sym1, const Symbol &sym2) {
+ std::optional<common::LanguageFeature> feature;
std::optional<parser::MessageFixedText> msg;
const DeclTypeSpec *type1{sym1.GetType()};
const DeclTypeSpec *type2{sym2.GetType()};
@@ -453,24 +454,19 @@ bool EquivalenceSets::CheckCanEquivalence(
} else if (!(isAnyNum1 || isChar1) &&
!(isAnyNum2 || isChar2)) { // C8110 - C8113
if (AreTkCompatibleTypes(type1, type2)) {
- if (context_.ShouldWarn(LanguageFeature::EquivalenceSameNonSequence)) {
- msg =
- "nonstandard: Equivalence set contains '%s' and '%s' with same "
- "type that is neither numeric nor character sequence type"_port_en_US;
- }
+ msg =
+ "nonstandard: Equivalence set contains '%s' and '%s' with same type that is neither numeric nor character sequence type"_port_en_US;
+ feature = LanguageFeature::EquivalenceSameNonSequence;
} else {
msg = "Equivalence set cannot contain '%s' and '%s' with distinct types "
"that are not both numeric or character sequence types"_err_en_US;
}
} else if (isAnyNum1) {
if (isChar2) {
- if (context_.ShouldWarn(
- LanguageFeature::EquivalenceNumericWithCharacter)) {
- msg = "nonstandard: Equivalence set contains '%s' that is numeric "
- "sequence type and '%s' that is character"_port_en_US;
- }
- } else if (isAnyNum2 &&
- context_.ShouldWarn(LanguageFeature::EquivalenceNonDefaultNumeric)) {
+ msg =
+ "nonstandard: Equivalence set contains '%s' that is numeric sequence type and '%s' that is character"_port_en_US;
+ feature = LanguageFeature::EquivalenceNumericWithCharacter;
+ } else if (isAnyNum2) {
if (isDefaultNum1) {
msg =
"nonstandard: Equivalence set contains '%s' that is a default "
@@ -479,12 +475,16 @@ bool EquivalenceSets::CheckCanEquivalence(
msg = "nonstandard: Equivalence set contains '%s' and '%s' that are "
"numeric sequence types with non-default kinds"_port_en_US;
}
+ feature = LanguageFeature::EquivalenceNonDefaultNumeric;
}
}
- if (msg &&
- (!context_.IsInModuleFile(source) ||
- msg->severity() == parser::Severity::Error)) {
- context_.Say(source, std::move(*msg), sym1.name(), sym2.name());
+ if (msg) {
+ if (feature) {
+ context_.Warn(
+ *feature, source, std::move(*msg), sym1.name(), sym2.name());
+ } else {
+ context_.Say(source, std::move(*msg), sym1.name(), sym2.name());
+ }
return false;
}
return true;
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7c26e398924889..e5e03f644f1b00 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -540,15 +540,16 @@ class ScopeHandler : public ImplicitRulesVisitor {
void SayWithReason(
const parser::Name &, Symbol &, MessageFixedText &&, Message &&);
template <typename... A>
- void SayWithDecl(
+ Message &SayWithDecl(
const parser::Name &, Symbol &, MessageFixedText &&, A &&...args);
void SayLocalMustBeVariable(const parser::Name &, Symbol &);
- void SayDerivedType(const SourceName &, MessageFixedText &&, const Scope &);
- void Say2(const SourceName &, MessageFixedText &&, const SourceName &,
+ Message &SayDerivedType(
+ const SourceName &, MessageFixedText &&, const Scope &);
+ Message &Say2(const SourceName &, MessageFixedText &&, const SourceName &,
MessageFixedText &&);
- void Say2(
+ Message &Say2(
const SourceName &, MessageFixedText &&, Symbol &, MessageFixedText &&);
- void Say2(
+ Message &Say2(
const parser::Name &, MessageFixedText &&, Symbol &, MessageFixedText &&);
// Search for symbol by name in current, parent derived type, and
@@ -1867,11 +1868,10 @@ bool AttrsVisitor::Pre(const parser::Pass &x) {
bool AttrsVisitor::IsDuplicateAttr(Attr attrName) {
CHECK(attrs_);
if (attrs_->test(attrName)) {
- if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
- Say(currStmtSource().value(),
- "Attribute '%s' cannot be used more than once"_warn_en_US,
- AttrToString(attrName));
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ currStmtSource().value(),
+ "Attribute '%s' cannot be used more than once"_warn_en_US,
+ AttrToString(attrName));
return true;
}
return false;
@@ -2283,7 +2283,7 @@ void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,
}
template <typename... A>
-void ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
+Message &ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
MessageFixedText &&msg, A &&...args) {
auto &message{
Say(name.source, std::move(msg), symbol.name(), std::forward<A>(args)...)
@@ -2299,6 +2299,7 @@ void ScopeHandler::SayWithDecl(const parser::Name &name, Symbol &symbol,
}
}
}
+ return message;
}
void ScopeHandler::SayLocalMustBeVariable(
@@ -2308,28 +2309,31 @@ void ScopeHandler::SayLocalMustBeVariable(
" in a locality-spec"_err_en_US);
}
-void ScopeHandler::SayDerivedType(
+Message &ScopeHandler::SayDerivedType(
const SourceName &name, MessageFixedText &&msg, const Scope &type) {
const Symbol &typeSymbol{DEREF(type.GetSymbol())};
- Say(name, std::move(msg), name, typeSymbol.name())
+ return Say(name, std::move(msg), name, typeSymbol.name())
.Attach(typeSymbol.name(), "Declaration of derived type '%s'"_en_US,
typeSymbol.name());
}
-void ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
+Message &ScopeHandler::Say2(const SourceName &name1, MessageFixedText &&msg1,
const SourceName &name2, MessageFixedText &&msg2) {
- Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
+ return Say(name1, std::move(msg1)).Attach(name2, std::move(msg2), name2);
}
-void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
+Message &ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
Symbol &symbol, MessageFixedText &&msg2) {
bool isFatal{msg1.IsFatal()};
- Say2(name, std::move(msg1), symbol.name(), std::move(msg2));
+ Message &result{Say2(name, std::move(msg1), symbol.name(), std::move(msg2))};
context().SetError(symbol, isFatal);
+ return result;
}
-void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
+Message &ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
Symbol &symbol, MessageFixedText &&msg2) {
bool isFatal{msg1.IsFatal()};
- Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
+ Message &result{
+ Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2))};
context().SetError(symbol, isFatal);
+ return result;
}
// This is essentially GetProgramUnitContaining(), but it can return
@@ -2613,11 +2617,9 @@ bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
return false;
}
// TODO: check no INTENT(OUT) if dummy?
- if (context().ShouldWarn(common::LanguageFeature::ForwardRefImplicitNone)) {
- Say(symbol.name(),
- "'%s' was used without (or before) being explicitly typed"_warn_en_US,
- symbol.name());
- }
+ context().Warn(common::LanguageFeature::ForwardRefImplicitNone, symbol.name(),
+ "'%s' was used without (or before) being explicitly typed"_warn_en_US,
+ symbol.name());
symbol.set(Symbol::Flag::Implicit);
symbol.SetType(*type);
return true;
@@ -3391,21 +3393,21 @@ void ModuleVisitor::AddAndCheckModuleUse(SourceName name, bool isIntrinsic) {
if (isIntrinsic) {
if (auto iter{nonIntrinsicUses_.find(name)};
iter != nonIntrinsicUses_.end()) {
- if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
- Say(name,
- "Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,
- name)
- .Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
+ if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
+ name,
+ "Should not USE the intrinsic module '%s' in the same scope as a USE of the non-intrinsic module"_port_en_US,
+ name)}) {
+ msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
}
}
intrinsicUses_.insert(name);
} else {
if (auto iter{intrinsicUses_.find(name)}; iter != intrinsicUses_.end()) {
- if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
- Say(name,
- "Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,
- name)
- .Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
+ if (auto *msg{context().Warn(common::LanguageFeature::MiscUseExtensions,
+ name,
+ "Should not USE the non-intrinsic module '%s' in the same scope as a USE of the intrinsic module"_port_en_US,
+ name)}) {
+ msg->Attach(*iter, "Previous USE of '%s'"_en_US, *iter);
}
}
nonIntrinsicUses_.insert(name);
@@ -3675,11 +3677,11 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
ResolveSpecificsInGeneric(generic, true);
auto &details{generic.get<GenericDetails>()};
if (auto *proc{details.CheckSpecific()}) {
- if (context().ShouldWarn(common::UsageWarning::HomonymousSpecific)) {
- Say(proc->name().begin() > generic.name().begin() ? proc->name()
- : generic.name(),
- "'%s' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic"_warn_en_US);
- }
+ context().Warn(common::UsageWarning::HomonymousSpecific,
+ proc->name().begin() > generic.name().begin() ? proc->name()
+ : generic.name(),
+ "'%s' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic"_warn_en_US,
+ generic.name());
}
auto &specifics{details.specificProcs()};
if (specifics.empty()) {
@@ -3697,19 +3699,23 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
subroutine = &specific;
if (details.derivedType() &&
context().ShouldWarn(
- common::LanguageFeature::SubroutineAndFunctionSpecifics)) {
+ common::LanguageFeature::SubroutineAndFunctionSpecifics) &&
+ !InModuleFile()) {
SayDerivedType(generic.name(),
"Generic interface '%s' should only contain functions due to derived type with same name"_warn_en_US,
- *details.derivedType()->GetUltimate().scope());
+ *details.derivedType()->GetUltimate().scope())
+ .set_languageFeature(
+ common::LanguageFeature::SubroutineAndFunctionSpecifics);
}
}
- if (function && subroutine) {
- if (context().ShouldWarn(common::LanguageFeature::
- SubroutineAndFunctionSpecifics)) { // C1514
- auto &msg{Say(generic.name(),
- "Generic interface '%s' has both a function and a subroutine"_warn_en_US)};
- msg.Attach(function->name(), "Function declaration"_en_US);
- msg.Attach(subroutine->name(), "Subroutine declaration"_en_US);
+ if (function && subroutine) { // F'2023 C1514
+ if (auto *msg{context().Warn(
+ common::LanguageFeature::SubroutineAndFunctionSpecifics,
+ generic.name(),
+ "Generic interface '%s' has both a function and a subroutine"_warn_en_US,
+ generic.name())}) {
+ msg->Attach(function->name(), "Function declaration"_en_US)
+ .Attach(subroutine->name(), "Subroutine declaration"_en_US);
}
break;
}
@@ -3738,11 +3744,10 @@ bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
return false;
}
if (IsHostAssociated(*symbol, currScope())) {
- if (context().ShouldWarn(
- common::LanguageFeature::StatementFunctionExtensions)) {
- Say(name,
- "Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US);
- }
+ context().Warn(common::LanguageFeature::StatementFunctionExtensions,
+ name.source,
+ "Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US,
+ name.source);
MakeSymbol(name, Attrs{}, UnknownDetails{});
} else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
entity && !ultimate.has<ProcEntityDetails>()) {
@@ -3844,12 +3849,10 @@ bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) {
(*current == common::CUDASubprogramAttrs::HostDevice &&
(attr == common::CUDASubprogramAttrs::Host ||
attr == common::CUDASubprogramAttrs::Device))) {
- if (context().ShouldWarn(
- common::LanguageFeature::RedundantAttribute)) {
- Say(currStmtSource().value(),
- "ATTRIBUTES(%s) appears more than once"_warn_en_US,
- common::EnumToString(attr));
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ currStmtSource().value(),
+ "ATTRIBUTES(%s) appears more than once"_warn_en_US,
+ common::EnumToString(attr));
} else if ((attr == common::CUDASubprogramAttrs::Host ||
attr == common::CUDASubprogramAttrs::Device) &&
(*current == common::CUDASubprogramAttrs::Host ||
@@ -4054,13 +4057,12 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
}
// C1560.
if (info.resultName && !distinctResultName) {
- if (context().ShouldWarn(common::UsageWarning::HomonymousResult)) {
- Say(info.resultName->source,
- "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);
- }
+ context().Warn(common::UsageWarning::HomonymousResult,
+ info.resultName->source,
+ "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);
// RESULT name was ignored above, the only side effect from doing so will be
// the inability to make recursive calls. The related parser::Name is still
// resolved to the created function result symbol because every parser::Name
@@ -4468,10 +4470,9 @@ bool SubprogramVisitor::HandlePreviousCalls(
if (symbol.attrs().test(Attr::EXTERNAL) &&
!symbol.implicitAttrs().test(Attr::EXTERNAL)) {
// Warn if external statement previously declared.
- if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
- Say(name,
- "EXTERNAL attribute was already specified on '%s'"_warn_en_US);
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute, name.source,
+ "EXTERNAL attribute was already specified on '%s'"_warn_en_US,
+ name.source);
} else if (symbol.test(other)) {
Say2(name,
subpFlag == Symbol::Flag::Function
@@ -4924,11 +4925,10 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
if (details->isInterface()) {
// Warn if interface previously declared.
- if (context().ShouldWarn(
- common::LanguageFeature::RedundantAttribute)) {
- Say(name,
- "EXTERNAL attribute was already specified on '%s'"_warn_en_US);
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ name.source,
+ "EXTERNAL attribute was already specified on '%s'"_warn_en_US,
+ name.source);
}
} else {
SayWithDecl(
@@ -4973,14 +4973,12 @@ void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
if (symbol.GetType()) {
// These warnings are worded so that they should make sense in either
// order.
- if (context().ShouldWarn(
- common::UsageWarning::IgnoredIntrinsicFunctionType)) {
- Say(symbol.name(),
- "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
- symbol.name())
- .Attach(name.source,
- "INTRINSIC statement for explicitly-typed '%s'"_en_US,
- name.source);
+ if (auto *msg{context().Warn(
+ common::UsageWarning::IgnoredIntrinsicFunctionType, symbol.name(),
+ "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
+ symbol.name())}) {
+ msg->Attach(name.source,
+ "INTRINSIC statement for explicitly-typed '%s'"_en_US, name.source);
}
}
if (!symbol.test(Symbol::Flag::Function) &&
@@ -5047,11 +5045,10 @@ Symbol &DeclarationVisitor::HandleAttributeStmt(
}
} else if (symbol && symbol->has<UseDetails>()) {
if (symbol->GetUltimate().attrs().test(attr)) {
- if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
- Say(currStmtSource().value(),
- "Use-associated '%s' already has '%s' attribute"_warn_en_US,
- name.source, EnumToString(attr));
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ currStmtSource().value(),
+ "Use-associated '%s' already has '%s' attribute"_warn_en_US,
+ name.source, EnumToString(attr));
} else {
Say(currStmtSource().value(),
"Cannot change %s attribute on use-associated '%s'"_err_en_US,
@@ -5193,10 +5190,9 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
context().SetError(symbol);
}
} else if (MustBeScalar(symbol)) {
- if (context().ShouldWarn(common::UsageWarning::PreviousScalarUse)) {
- Say(name,
- "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US);
- }
+ context().Warn(common::UsageWarning::PreviousScalarUse, name.source,
+ "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US,
+ name.source);
} else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);
} else {
@@ -5554,10 +5550,8 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) {
details.set_sequence(true);
if (componentDefs.empty()) {
// F'2023 C745 - not enforced by any compiler
- if (context().ShouldWarn(common::LanguageFeature::EmptySequenceType)) {
- Say(stmt.source,
- "A sequence type should have at least one component"_warn_en_US);
- }
+ context().Warn(common::LanguageFeature::EmptySequenceType, stmt.source,
+ "A sequence type should have at least one component"_warn_en_US);
}
if (!details.paramDeclOrder().empty()) { // C740
Say(stmt.source,
@@ -5683,17 +5677,15 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
} else if (!derivedTypeInfo_.privateComps) {
derivedTypeInfo_.privateComps = true;
} else { // C738
- if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
- Say("PRIVATE should not appear more than once in derived type components"_warn_en_US);
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ "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) { // C738
- if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
- Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US);
- }
+ context().Warn(common::LanguageFeature::RedundantAttribute,
+ "SEQUENCE should not appear more than once in derived type components"_warn_en_US);
}
derivedTypeInfo_.sequence = true;
return false;
@@ -5800,9 +5792,8 @@ bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
!InModuleFile()) {
if (GetAttrs().test(Attr::POINTER) &&
context().IsEnabled(common::LanguageFeature::PointerInSeqType)) {
- if (context().ShouldWarn(common::LanguageFeature::PointerInSeqType)) {
- Say("A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);
- }
+ context().Warn(common::LanguageFeature::PointerInSeqType,
+ "A sequence type data component that is a pointer to a non-sequence type is not standard"_port_en_US);
} else {
Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US);
}
@@ -6219,11 +6210,11 @@ void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
}
if (const auto *pointeeType{pointee->GetType()}) {
if (const auto *derived{pointeeType->AsDerived()}) {
- if (!IsSequenceOrBindCType(derived) &&
- context().ShouldWarn(
- common::LanguageFeature::NonSequenceCrayPointee)) {
- Say(pointeeName,
- "Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US);
+ if (!IsSequenceOrBindCType(derived)) {
+ context().Warn(common::LanguageFeature::NonSequenceCrayPointee,
+ pointeeName.source,
+ "Type of Cray pointee '%s' is a derived type that is neither SEQUENCE nor BIND(C)"_warn_en_US,
+ pointeeName.source);
}
}
}
@@ -6372,7 +6363,8 @@ void DeclarationVisitor::CheckSaveStmts() {
if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
Say2(name,
"Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US,
- *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US);
+ *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US)
+ .set_languageFeature(common::LanguageFeature::RedundantAttribute);
}
} else if (!IsSaved(*symbol)) {
SetExplicitAttr(*symbol, Attr::SAVE);
@@ -6418,7 +6410,8 @@ void DeclarationVisitor::AddSaveName(
if (!pair.second &&
context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
Say2(name, "SAVE attribute was already specified on '%s'"_warn_en_US,
- *pair.first, "Previous specification of SAVE attribute"_en_US);
+ *pair.first, "Previous specification of SAVE attribute"_en_US)
+ .set_languageFeature(common::LanguageFeature::RedundantAttribute);
}
}
@@ -6728,11 +6721,11 @@ void DeclarationVisitor::SetType(
}
auto *prevType{symbol.GetType()};
if (!prevType) {
- if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType() &&
- context().ShouldWarn(
- common::LanguageFeature::ForwardRefImplicitNoneData)) {
- Say(name,
- "'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US);
+ if (symbol.test(Symbol::Flag::InDataStmt) && isImplicitNoneType()) {
+ context().Warn(common::LanguageFeature::ForwardRefImplicitNoneData,
+ name.source,
+ "'%s' appeared in a DATA statement before its type was declared under IMPLICIT NONE(TYPE)"_port_en_US,
+ name.source);
}
symbol.SetType(type);
} else if (symbol.has<UseDetails>()) {
@@ -6877,6 +6870,7 @@ bool DeclarationVisitor::OkToAddComponent(
CHECK(scope->IsDerivedType());
if (auto *prev{FindInScope(*scope, name.source)}) {
std::optional<parser::MessageFixedText> msg;
+ std::optional<common::UsageWarning> warning;
if (context().HasError(*prev)) { // don't pile on
} else if (extends) {
msg = "Type cannot be extended as it has a component named"
@@ -6887,24 +6881,28 @@ bool DeclarationVisitor::OkToAddComponent(
common::UsageWarning::RedeclaredInaccessibleComponent)) {
msg =
"Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US;
+ warning = common::UsageWarning::RedeclaredInaccessibleComponent;
}
} else if (prev->test(Symbol::Flag::ParentComp)) {
- msg = "'%s' is a parent type of this type and so cannot be"
- " a component"_err_en_US;
+ msg =
+ "'%s' is a parent type of this type and so cannot be a component"_err_en_US;
} else if (scope == &currScope()) {
- msg = "Component '%s' is already declared in this"
- " derived type"_err_en_US;
+ msg =
+ "Component '%s' is already declared in this derived type"_err_en_US;
} else {
- msg = "Component '%s' is already declared in a parent of this"
- " derived type"_err_en_US;
+ msg =
+ "Component '%s' is already declared in a parent of this derived type"_err_en_US;
}
if (msg) {
- Say2(
- name, std::move(*msg), *prev, "Previous declaration of '%s'"_en_US);
+ auto &said{Say2(name, std::move(*msg), *prev,
+ "Previous declaration of '%s'"_en_US)};
if (msg->severity() == parser::Severity::Error) {
Resolve(name, *prev);
return false;
}
+ if (warning) {
+ said.set_usageWarning(*warning);
+ }
}
}
if (scope == &currScope() && extends) {
@@ -6946,7 +6944,9 @@ void ConstructVisitor::ResolveIndexName(
context().ShouldWarn(
common::LanguageFeature::OddIndexVariableRestrictions)) {
SayWithDecl(name, *prev,
- "Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US);
+ "Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US)
+ .set_languageFeature(
+ common::LanguageFeature::OddIndexVariableRestrictions);
}
name.symbol = nullptr;
}
@@ -6969,13 +6969,17 @@ void ConstructVisitor::ResolveIndexName(
context().ShouldWarn(
common::LanguageFeature::OddIndexVariableRestrictions)) {
SayWithDecl(name, *prev,
- "Index variable '%s' should be scalar in the enclosing scope"_port_en_US);
+ "Index variable '%s' should be scalar in the enclosing scope"_port_en_US)
+ .set_languageFeature(
+ common::LanguageFeature::OddIndexVariableRestrictions);
}
} else if (!prevRoot.has<CommonBlockDetails>() &&
context().ShouldWarn(
common::LanguageFeature::OddIndexVariableRestrictions)) {
SayWithDecl(name, *prev,
- "Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US);
+ "Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US)
+ .set_languageFeature(
+ common::LanguageFeature::OddIndexVariableRestrictions);
}
}
EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
@@ -7022,10 +7026,9 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Reduce &x) {
bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
for (const auto &name : x.v) {
if (!FindSymbol(name)) {
- if (context().ShouldWarn(common::UsageWarning::ImplicitShared)) {
- Say(name,
- "Variable '%s' with SHARED locality implicitly declared"_warn_en_US);
- }
+ context().Warn(common::UsageWarning::ImplicitShared, name.source,
+ "Variable '%s' with SHARED locality implicitly declared"_warn_en_US,
+ name.source);
}
Symbol &prev{FindOrDeclareEnclosingEntity(name)};
if (PassesSharedLocalityChecks(name, prev)) {
@@ -7403,7 +7406,8 @@ bool ConstructVisitor::CheckDef(const std::optional<parser::Name> &x) {
if (Symbol *
other{FindInScopeOrBlockConstructs(InclusiveScope(), x->source)}) {
SayWithDecl(*x, *other,
- "The construct name '%s' should be distinct at the subprogram level"_port_en_US);
+ "The construct name '%s' should be distinct at the subprogram level"_port_en_US)
+ .set_languageFeature(common::LanguageFeature::BenignNameClash);
}
}
MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName});
@@ -7827,10 +7831,9 @@ bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
scope.add_importName(name.source);
if (Symbol * symbol{FindInScope(name)}) {
if (outer->GetUltimate() == symbol->GetUltimate()) {
- if (context().ShouldWarn(common::LanguageFeature::BenignNameClash)) {
- Say(name,
- "The same '%s' is already present in this scope"_port_en_US);
- }
+ context().Warn(common::LanguageFeature::BenignNameClash, name.source,
+ "The same '%s' is already present in this scope"_port_en_US,
+ name.source);
} else {
Say(name,
"A distinct '%s' is already present in this scope"_err_en_US)
@@ -7924,11 +7927,9 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
}
if (checkIndexUseInOwnBounds_ &&
*checkIndexUseInOwnBounds_ == name.source && !InModuleFile()) {
- if (context().ShouldWarn(common::LanguageFeature::ImpliedDoIndexScope)) {
- Say(name,
- "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
- name.source);
- }
+ context().Warn(common::LanguageFeature::ImpliedDoIndexScope, name.source,
+ "Implied DO index '%s' uses an object of the same name in its bounds expressions"_port_en_US,
+ name.source);
}
return &name;
}
@@ -8498,13 +8499,13 @@ Symbol &ModuleVisitor::SetAccess(
if (attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
// PUBLIC/PRIVATE already set: make it a fatal error if it changed
Attr prev{attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE};
- if (attr != prev ||
- context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) {
+ if (attr != prev) {
Say(name,
- WithSeverity(
- "The accessibility of '%s' has already been specified as %s"_warn_en_US,
- attr != prev ? parser::Severity::Error
- : parser::Severity::Warning),
+ "The accessibility of '%s' has already been specified as %s"_err_en_US,
+ MakeOpName(name), EnumToString(prev));
+ } else {
+ context().Warn(common::LanguageFeature::RedundantAttribute, name,
+ "The accessibility of '%s' has already been specified as %s"_warn_en_US,
MakeOpName(name), EnumToString(prev));
}
} else {
@@ -9103,7 +9104,8 @@ void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
}
}
} else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) {
- Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US);
+ Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US)
+ .set_usageWarning(common::UsageWarning::IgnoredDirective);
}
}
@@ -9165,7 +9167,8 @@ bool ResolveNamesVisitor::Pre(const parser::Program &x) {
if (auto iter{uses.find(name)}; iter != uses.end()) {
if (context().ShouldWarn(common::LanguageFeature::MiscUseExtensions)) {
Say(name,
- "A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US)
+ "A USE statement referencing module '%s' appears earlier in this compilation unit"_port_en_US,
+ name)
.Attach(*iter, "First USE of module"_en_US);
}
disordered = true;
@@ -9203,7 +9206,7 @@ bool ResolveNamesVisitor::Pre(const parser::Program &x) {
}
}
if (!ok) {
- parser::Message *msg{nullptr};
+ Message *msg{nullptr};
for (const auto &pair : modules) {
if (msg) {
msg->Attach(pair.first, "Module in a cycle"_en_US);
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 1f2980b07b3e0e..e743c628f1ed11 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -181,7 +181,7 @@ static void WarnUndefinedFunctionResult(
}
}
if (!wasDefined) {
- context.Say(
+ context.Warn(common::UsageWarning::UndefinedFunctionResult,
symbol->name(), "Function result is never defined"_warn_en_US);
}
}
@@ -222,10 +222,7 @@ static bool PerformStatementSemantics(
SemanticsVisitor<CUDAChecker>{context}.Walk(program);
}
if (!context.messages().AnyFatalError()) {
- // Do this if all messages are only warnings
- if (context.ShouldWarn(common::UsageWarning::UndefinedFunctionResult)) {
- WarnUndefinedFunctionResult(context, context.globalScope());
- }
+ WarnUndefinedFunctionResult(context, context.globalScope());
}
if (!context.AnyFatalError()) {
pass2.CompileDataInitializationsIntoInitializers();
@@ -285,15 +282,15 @@ class CommonBlockMap {
info.initialization = common;
}
}
- if (common.size() != info.biggestSize->size() && !common.name().empty() &&
- context.ShouldWarn(common::LanguageFeature::DistinctCommonSizes)) {
- context
- .Say(common.name(),
+ if (common.size() != info.biggestSize->size() && !common.name().empty()) {
+ if (auto *msg{context.Warn(common::LanguageFeature::DistinctCommonSizes,
+ common.name(),
"A named COMMON block should have the same size everywhere it appears (%zd bytes here)"_port_en_US,
- common.size())
- .Attach(info.biggestSize->name(),
- "Previously defined with a size of %zd bytes"_en_US,
- info.biggestSize->size());
+ common.size())}) {
+ msg->Attach(info.biggestSize->name(),
+ "Previously defined with a size of %zd bytes"_en_US,
+ info.biggestSize->size());
+ }
}
if (common.size() > info.biggestSize->size()) {
info.biggestSize = common;
@@ -473,22 +470,28 @@ void SemanticsContext::PopConstruct() {
constructStack_.pop_back();
}
-void SemanticsContext::CheckIndexVarRedefine(const parser::CharBlock &location,
- const Symbol &variable, parser::MessageFixedText &&message) {
+parser::Message *SemanticsContext::CheckIndexVarRedefine(
+ const parser::CharBlock &location, const Symbol &variable,
+ parser::MessageFixedText &&message) {
const Symbol &symbol{ResolveAssociations(variable)};
auto it{activeIndexVars_.find(symbol)};
if (it != activeIndexVars_.end()) {
std::string kind{EnumToString(it->second.kind)};
- Say(location, std::move(message), kind, symbol.name())
- .Attach(it->second.location, "Enclosing %s construct"_en_US, kind);
+ return &Say(location, std::move(message), kind, symbol.name())
+ .Attach(
+ it->second.location, "Enclosing %s construct"_en_US, kind);
+ } else {
+ return nullptr;
}
}
void SemanticsContext::WarnIndexVarRedefine(
const parser::CharBlock &location, const Symbol &variable) {
if (ShouldWarn(common::UsageWarning::IndexVarRedefinition)) {
- CheckIndexVarRedefine(location, variable,
- "Possible redefinition of %s variable '%s'"_warn_en_US);
+ if (auto *msg{CheckIndexVarRedefine(location, variable,
+ "Possible redefinition of %s variable '%s'"_warn_en_US)}) {
+ msg->set_usageWarning(common::UsageWarning::IndexVarRedefinition);
+ }
}
}
More information about the flang-commits
mailing list