diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index 86c6e02b0f2f..f813cbae40a5 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 #include 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; using UsageWarnings = EnumSet; +std::optional FindLanguageFeature(const char *); +std::optional 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 668559aeec94..bc38f571ca3d 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 @@ public: 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 @@ public: 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 Message(RANGE r, const MessageFixedText &t, A &&x, As &&...xs) : location_{r}, text_{MessageFormattedText{ t, std::forward(x), std::forward(xs)...}} {} + template + Message(common::LanguageFeature feature, RANGE r, const MessageFixedText &t, + A &&x, As &&...xs) + : location_{r}, text_{MessageFormattedText{ + t, std::forward(x), std::forward(xs)...}}, + languageFeature_{feature} {} + template + Message(common::UsageWarning warning, RANGE r, const MessageFixedText &t, + A &&x, As &&...xs) + : location_{r}, text_{MessageFormattedText{ + t, std::forward(x), std::forward(xs)...}}, + usageWarning_{warning} {} Reference attachment() const { return attachment_; } @@ -232,6 +284,10 @@ public: bool IsFatal() const; Severity severity() const; Message &set_severity(Severity); + std::optional languageFeature() const; + Message &set_languageFeature(common::LanguageFeature); + std::optional usageWarning() const; + Message &set_usageWarning(common::UsageWarning); std::string ToString() const; std::optional GetProvenanceRange( const AllCookedSources &) const; @@ -256,6 +312,8 @@ private: text_; bool attachmentIsContext_{false}; Reference attachment_; + std::optional languageFeature_; + std::optional usageWarning_; }; class Messages { @@ -275,6 +333,16 @@ public: return messages_.emplace_back(std::forward(args)...); } + template + Message &Say(common::LanguageFeature feature, A &&...args) { + return Say(std::forward(args)...).set_languageFeature(feature); + } + + template + Message &Say(common::UsageWarning warning, A &&...args) { + return Say(std::forward(args)...).set_usageWarning(warning); + } + void Annex(Messages &&that) { messages_.splice(messages_.end(), that.messages_); } @@ -330,6 +398,10 @@ public: return common::ScopedSet(messages_, nullptr); } + template Message *Say(A &&...args) { + return Say(at_, std::forward(args)...); + } + template Message *Say(CharBlock at, A &&...args) { if (messages_ != nullptr) { auto &msg{messages_->Say(at, std::forward(args)...)}; @@ -347,8 +419,22 @@ public: return Say(at.value_or(at_), std::forward(args)...); } - template Message *Say(A &&...args) { - return Say(at_, std::forward(args)...); + template + Message *Say(common::LanguageFeature feature, A &&...args) { + Message *msg{Say(std::forward(args)...)}; + if (msg) { + msg->set_languageFeature(feature); + } + return msg; + } + + template + Message *Say(common::UsageWarning warning, A &&...args) { + Message *msg{Say(std::forward(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 c90c8c4b3cc7..a90801db7338 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -123,6 +123,16 @@ public: template parser::Message *Say(A &&...args) { return GetContextualMessages().Say(std::forward(args)...); } + template + parser::Message *Warn( + FeatureOrUsageWarning warning, parser::CharBlock at, A &&...args) { + return context_.Warn(warning, at, std::forward(args)...); + } + template + parser::Message *Warn(FeatureOrUsageWarning warning, A &&...args) { + return Warn( + warning, GetContextualMessages().at(), std::forward(args)...); + } template 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 2a326074b3dc..606afbe288c3 100644 --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -188,6 +188,24 @@ public: return message; } + template + 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(args)...)}; + return &msg; + } else { + return nullptr; + } + } + + template + parser::Message *Warn(FeatureOrUsageWarning warning, A &&...args) { + CHECK(location_); + return Warn(warning, *location_, std::forward(args)...); + } + const Scope &FindScope(parser::CharBlock) const; Scope &FindScope(parser::CharBlock); void UpdateScopeIndex(Scope &, parser::CharBlock); @@ -270,7 +288,7 @@ private: std::multimap; 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 25a948818e65..59f570e6ab6e 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 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 +std::optional ScanEnum(const char *name) { + if (name) { + for (std::size_t j{0}; j < N; ++j) { + auto feature{static_cast(j)}; + if (WarningNameMatch(name, EnumToString(feature).data())) { + return feature; + } + } + } + return std::nullopt; +} + +std::optional FindLanguageFeature(const char *name) { + return ScanEnum(name); +} + +std::optional FindUsageWarning(const char *name) { + return ScanEnum(name); +} + std::vector LanguageFeatureControl::GetNames( LogicalOperator opr) const { std::vector result; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index a1ede7d7553b..38794a2d8aac 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -412,6 +412,7 @@ std::optional> 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 @@ public: 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; using Base = AnyTraverse; + + 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(); + Result Return(parser::Message &&msg) const { + if (severity_) { + msg.set_severity(*severity_); + if (*severity_ != parser::Severity::Error) { + msg.set_languageFeature(feature); + } + } + return std::move(msg); + } + template Result operator()(const ArrayConstructor &) 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()}; + 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 @@ public: 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 @@ public: } 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 c633bff57b1e..6a960d46166e 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 5bdfa539eb0e..76ac497e1664 100644 --- a/flang/lib/Evaluate/fold-character.cpp +++ b/flang/lib/Evaluate/fold-character.cpp @@ -60,7 +60,7 @@ Expr> FoldIntrinsicFunction( if (i.IsNegative() || i.BGE(Scalar{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(i.ToInt64()), KIND); @@ -108,7 +108,7 @@ Expr> 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(n) * str.size()); } diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp index d44cc9c69dd6..3eb8e1f3f1fc 100644 --- a/flang/lib/Evaluate/fold-complex.cpp +++ b/flang/lib/Evaluate/fold-complex.cpp @@ -31,7 +31,7 @@ Expr> 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 89477dfb3643..b9c75448b754 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1735,7 +1735,7 @@ Expr 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 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 FoldOperation(FoldingContext &context, Negate &&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{Constant{std::move(negated.value)}}; @@ -1907,7 +1907,7 @@ Expr FoldOperation(FoldingContext &context, Add &&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{Constant{sum.value}}; @@ -1935,7 +1935,7 @@ Expr FoldOperation(FoldingContext &context, Subtract &&x) { if (difference.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{Constant{difference.value}}; @@ -1963,7 +1963,7 @@ Expr FoldOperation(FoldingContext &context, Multiply &&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{Constant{product.lower}}; @@ -2009,7 +2009,7 @@ Expr FoldOperation(FoldingContext &context, Divide &&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{std::move(x)}; @@ -2017,7 +2017,7 @@ Expr FoldOperation(FoldingContext &context, Divide &&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{Constant{quotAndRem.quotient}}; @@ -2060,13 +2060,13 @@ Expr FoldOperation(FoldingContext &context, Power &&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 FoldOperation(FoldingContext &context, Power &&x) { Constant{(*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> 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()) { diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index 821fa4e5dadf..594a614a5f2e 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -300,7 +300,7 @@ static Expr FoldCount(FoldingContext &context, FunctionRef &&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{std::move(result)}; @@ -562,7 +562,7 @@ Expr> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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{8 * std::min(intBytes, realBytes)}; diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp index ee6655f83871..f5bbe7e42933 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -534,7 +534,8 @@ static Expr> 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 a799cfb80a59..be9c547d4528 100644 --- a/flang/lib/Evaluate/fold-matmul.h +++ b/flang/lib/Evaluate/fold-matmul.h @@ -95,7 +95,7 @@ static Expr FoldMatmul(FoldingContext &context, FunctionRef &&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 fd8eca28a679..ed7749e88030 100644 --- a/flang/lib/Evaluate/fold-real.cpp +++ b/flang/lib/Evaluate/fold-real.cpp @@ -37,7 +37,7 @@ static Expr 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> 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{std::move(result)}; @@ -167,7 +167,7 @@ Expr> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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> 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 fbdae8f4eee0..8ca0794ab0fc 100644 --- a/flang/lib/Evaluate/fold-reduction.h +++ b/flang/lib/Evaluate/fold-reduction.h @@ -108,7 +108,7 @@ static Expr 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 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 FoldSum(FoldingContext &context, FunctionRef &&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 31bc43838580..187bb2f09806 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 3734cc6814f9..1f48fc21662e 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2375,10 +2375,10 @@ std::optional 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 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 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 b074ae6d811a..707a2065ca30 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -215,7 +215,7 @@ std::optional> 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(*lbi)); } @@ -224,7 +224,7 @@ std::optional> 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(*ubi), static_cast(*length)); diff --git a/flang/lib/Parser/message.cpp b/flang/lib/Parser/message.cpp index a56337d65e5f..69e4814bf246 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 Message::languageFeature() const { + return languageFeature_; +} + +Message &Message::set_languageFeature(common::LanguageFeature feature) { + languageFeature_ = feature; + return *this; +} + +std::optional 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 cb3725bc4ea6..f9b8716941b3 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 eabfcc244001..47260c068046 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 c0f834c845a8..623e31341a7c 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 a5363a6710d3..1e5412324916 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 28903304f622..28a12a5798cb 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -169,37 +169,40 @@ static void CheckCharacterActual(evaluate::Expr &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(actualChars), dummyName, + static_cast(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(actualChars), dummyName, + static_cast(dummyChars)); } - messages.Say(std::move(msg), - static_cast(actualChars), dummyName, - static_cast(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(*actualSize * *actualLength), + dummyName, + static_cast(*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(*actualSize * *actualLength), + dummyName, + static_cast(*dummySize * *dummyLength)); } - messages.Say(std::move(msg), - static_cast(*actualSize * *actualLength), - dummyName, - static_cast(*dummySize * *dummyLength)); } } } @@ -217,11 +220,11 @@ static void CheckCharacterActual(evaluate::Expr &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 &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 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(*actualElements), dummyName, + static_cast(*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(*actualElements), dummyName, + static_cast(*dummySize)); } - messages.Say(std::move(msg), - static_cast(*actualElements), dummyName, - static_cast(*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(*actualSize), dummyName, + static_cast(*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(*actualSize), dummyName, + static_cast(*dummySize)); } - messages.Say(std::move(msg), - static_cast(*actualSize), dummyName, - static_cast(*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()) { - 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 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 d296460127e1..caa8f8b6e70b 100644 --- a/flang/lib/Semantics/check-case.cpp +++ b/flang/lib/Semantics/check-case.cpp @@ -49,10 +49,8 @@ private: 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 @@ private: 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 d8bd435bf09f..eaf1d52a9fc1 100644 --- a/flang/lib/Semantics/check-cuda.cpp +++ b/flang/lib/Semantics/check-cuda.cpp @@ -296,10 +296,8 @@ private: 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 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 9d3e8c5a4ea8..d6f1351c12d3 100644 --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -89,9 +89,8 @@ public: "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 @@ public: "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 dfd49db74eea..7778561fb5bd 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -124,19 +124,23 @@ private: return FindModuleFileContaining(context_.FindScope(messages_.at())) != nullptr; } - template parser::Message *WarnIfNotInModuleFile(A &&...x) { - if (InModuleFile()) { + template + parser::Message *Warn(FeatureOrUsageWarning warning, A &&...x) { + if (!context_.ShouldWarn(warning) || InModuleFile()) { return nullptr; } else { - return messages_.Say(std::forward(x)...); + return messages_.Say(warning, std::forward(x)...); } } - template - parser::Message *WarnIfNotInModuleFile(parser::CharBlock source, A &&...x) { - if (FindModuleFileContaining(context_.FindScope(source))) { + template + 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(x)...); } - return messages_.Say(source, std::forward(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 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(&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() : 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().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().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()) { - 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()) { - 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 b32c10b0f333..a1aff52f3a68 100644 --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -463,12 +463,11 @@ void DirectiveStructureChecker::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 b9778e96080a..84e6b6455cc6 100644 --- a/flang/lib/Semantics/check-do-forall.cpp +++ b/flang/lib/Semantics/check-do-forall.cpp @@ -495,10 +495,8 @@ private: 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 @@ private: 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 @@ private: if (std::holds_alternative(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 @@ private: }, 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 46f07842b92c..eeeda553d8a4 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 51341b3faf3a..741227741f94 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(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 ec2600bac3c6..22729f659ed5 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 b5a58ddca0ec..028633813a91 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 0f8b36de4608..c9b86a930437 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -298,12 +298,10 @@ DataInitializationCompiler::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::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::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 5c41376d2a42..88f9463e35c7 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -349,7 +349,8 @@ std::optional 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 364f99d73f5c..c70c8a8aecc2 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(&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( exprAnalyzer_.GetDefaultKind(TypeCategory::Integer), std::move(*boz))); @@ -1672,11 +1662,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) { if (auto *boz{std::get_if(&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( 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 different 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 different 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 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 52a5a321aba6..075f33cb6848 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 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 2813a0cf968c..2450ce39215e 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -77,6 +77,8 @@ private: const evaluate::SpecificIntrinsic *specific = nullptr); bool LhsOkForUnlimitedPoly() const; template parser::Message *Say(A &&...); + template + 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 &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() && - 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()) { + 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 +parser::Message *PointerAssignmentChecker::Warn( + FeatureOrUsageWarning warning, A &&...x) { + auto *msg{context_.Warn( + warning, foldingContext_.messages().at(), std::forward(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 23a1ecbd2842..2b9bf0824d53 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 e5e96ec6327e..04e4b142efed 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 39392257938d..b8ce8d14a33f 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 feature; std::optional 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 7c26e3989248..e5e03f644f1b 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -540,15 +540,16 @@ public: void SayWithReason( const parser::Name &, Symbol &, MessageFixedText &&, Message &&); template - 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 -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(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()}; 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()}; entity && !ultimate.has()) { @@ -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()}) { 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()) { 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()) { @@ -6877,6 +6870,7 @@ bool DeclarationVisitor::OkToAddComponent( CHECK(scope->IsDerivedType()); if (auto *prev{FindInScope(*scope, name.source)}) { std::optional msg; + std::optional 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() && 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 &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 1f2980b07b3e..e743c628f1ed 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{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 @@ public: 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); + } } }