diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index 1e678c341d813..6b3e37cd9c25f 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -41,20 +41,33 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, ActualIntegerConvertedToSmallerKind, HollerithOrCharacterAsBOZ, BindingAsProcedure, StatementFunctionExtensions, UseGenericIntrinsicWhenSpecificDoesntMatch, DataStmtExtensions, - RedundantContiguous, InitBlankCommon, EmptyBindCDerivedType, - MiscSourceExtensions, AllocateToOtherLength, LongNames, IntrinsicAsSpecific, - BenignNameClash, BenignRedundancy, NullMoldAllocatableComponentValue, - NopassScalarBase, MiscUseExtensions, ImpliedDoIndexScope, - DistinctCommonSizes, OddIndexVariableRestrictions, - IndistinguishableSpecifics) + RedundantContiguous, RedundantAttribute, InitBlankCommon, + EmptyBindCDerivedType, MiscSourceExtensions, AllocateToOtherLength, + LongNames, IntrinsicAsSpecific, BenignNameClash, BenignRedundancy, + NullMoldAllocatableComponentValue, NopassScalarBase, MiscUseExtensions, + ImpliedDoIndexScope, DistinctCommonSizes, OddIndexVariableRestrictions, + IndistinguishableSpecifics, SubroutineAndFunctionSpecifics, + EmptySequenceType, NonSequenceCrayPointee, BranchIntoConstruct, + BadBranchTarget, ConvertedArgument, HollerithPolymorphic, ListDirectedSize) -// Portability and suspicious usage warnings for conforming code +// Portability and suspicious usage warnings ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, NonTargetPassedToTarget, PointerToPossibleNoncontiguous, - ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual, - PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence, - F202XAllocatableBreakingChange, DimMustBePresent, CommonBlockPadding, - LogicalVsCBool, BindCCharLength, ProcDummyArgShapes, ExternalNameConflict) + ShortCharacterActual, ShortArrayActual, ExprPassedToVolatile, + ImplicitInterfaceActual, PolymorphicTransferArg, + PointerComponentTransferArg, TransferSizePresence, + F202XAllocatableBreakingChange, OptionalMustBePresent, CommonBlockPadding, + LogicalVsCBool, BindCCharLength, ProcDummyArgShapes, ExternalNameConflict, + FoldingException, FoldingAvoidsRuntimeCrash, FoldingValueChecks, + FoldingFailure, FoldingLimit, Interoperability, Bounds, Preprocessing, + Scanning, OpenAccUsage, ProcPointerCompatibility, VoidMold, + KnownBadImplicitInterface, EmptyCase, CaseOverflow, CUDAUsage, + IgnoreTKRUsage, ExternalInterfaceMismatch, DefinedOperatorArgs, Final, + ZeroDoStep, UnusedForallIndex, OpenMPUsage, ModuleFile, DataLength, + IgnoredDirective, HomonymousSpecific, HomonymousResult, + IgnoredIntrinsicFunctionType, PreviousScalarUse, + RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition, + IncompatibleImplicitInterfaces, BadTypeForTarget) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; @@ -77,8 +90,57 @@ class LanguageFeatureControl { 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); } LanguageFeatureControl(const LanguageFeatureControl &) = default; + void Enable(LanguageFeature f, bool yes = true) { disable_.set(f, !yes); } void EnableWarning(LanguageFeature f, bool yes = true) { warnLanguage_.set(f, yes); @@ -88,10 +150,19 @@ class LanguageFeatureControl { } void WarnOnAllNonstandard(bool yes = true) { warnAllLanguage_ = yes; } void WarnOnAllUsage(bool yes = true) { warnAllUsage_ = yes; } + void DisableAllNonstandardWarnings() { + warnAllLanguage_ = false; + warnLanguage_.clear(); + } + void DisableAllUsageWarnings() { + warnAllUsage_ = false; + warnUsage_.clear(); + } + bool IsEnabled(LanguageFeature f) const { return !disable_.test(f); } bool ShouldWarn(LanguageFeature f) const { return (warnAllLanguage_ && f != LanguageFeature::OpenMP && - f != LanguageFeature::OpenACC) || + f != LanguageFeature::OpenACC && f != LanguageFeature::CUDA) || warnLanguage_.test(f); } bool ShouldWarn(UsageWarning w) const { diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index da10969ebc702..efb5c9ba1077d 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -634,7 +634,7 @@ class LabelEnforce { void Post(const parser::ErrLabel &errLabel); void Post(const parser::EndLabel &endLabel); void Post(const parser::EorLabel &eorLabel); - void checkLabelUse(const parser::Label &labelUsed); + void CheckLabelUse(const parser::Label &labelUsed); private: SemanticsContext &context_; diff --git a/flang/lib/Evaluate/common.cpp b/flang/lib/Evaluate/common.cpp index c659a5002ba0f..c633bff57b1ec 100644 --- a/flang/lib/Evaluate/common.cpp +++ b/flang/lib/Evaluate/common.cpp @@ -15,21 +15,24 @@ namespace Fortran::evaluate { void RealFlagWarnings( FoldingContext &context, const RealFlags &flags, const char *operation) { - if (flags.test(RealFlag::Overflow)) { - context.messages().Say("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); - } else { - context.messages().Say("division by zero on %s"_warn_en_US, operation); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + if (flags.test(RealFlag::Overflow)) { + context.messages().Say("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); + } else { + context.messages().Say("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); + } + if (flags.test(RealFlag::Underflow)) { + context.messages().Say("underflow on %s"_warn_en_US, operation); } - } - if (flags.test(RealFlag::InvalidArgument)) { - context.messages().Say("invalid argument on %s"_warn_en_US, operation); - } - if (flags.test(RealFlag::Underflow)) { - context.messages().Say("underflow on %s"_warn_en_US, operation); } } diff --git a/flang/lib/Evaluate/fold-character.cpp b/flang/lib/Evaluate/fold-character.cpp index 5d9cc11754a7d..877bc2eac1fc2 100644 --- a/flang/lib/Evaluate/fold-character.cpp +++ b/flang/lib/Evaluate/fold-character.cpp @@ -58,10 +58,13 @@ Expr> FoldIntrinsicFunction( return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&](const Scalar &i) { if (i.IsNegative() || i.BGE(Scalar{0}.IBSET(8 * KIND))) { - context.messages().Say( - "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US, - parser::ToUpperCaseLetters(name), - static_cast(i.ToInt64()), KIND); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingValueChecks)) { + context.messages().Say( + "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US, + parser::ToUpperCaseLetters(name), + static_cast(i.ToInt64()), KIND); + } } return CharacterUtils::CHAR(i.ToUInt64()); })); @@ -103,9 +106,12 @@ Expr> FoldIntrinsicFunction( static_cast(n)); } else if (static_cast(n) * str.size() > (1 << 20)) { // sanity limit of 1MiB - context.messages().Say( - "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US, - static_cast(n) * str.size()); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingLimit)) { + context.messages().Say( + "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US, + static_cast(n) * str.size()); + } } else { return Expr{Constant{CharacterUtils::REPEAT(str, n)}}; } diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp index 3260f82ffe8d7..d44cc9c69dd68 100644 --- a/flang/lib/Evaluate/fold-complex.cpp +++ b/flang/lib/Evaluate/fold-complex.cpp @@ -29,7 +29,8 @@ Expr> FoldIntrinsicFunction( if (auto callable{GetHostRuntimeWrapper(name)}) { return FoldElementalIntrinsic( context, std::move(funcRef), *callable); - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "%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 093f26bea1a44..b62b5965c877e 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1680,7 +1680,7 @@ Expr FoldOperation( Convert &convert; } msvcWorkaround{context, convert}; return common::visit( - [&msvcWorkaround](auto &kindExpr) -> Expr { + [&msvcWorkaround, &context](auto &kindExpr) -> Expr { using Operand = ResultType; // This variable is a workaround for msvc which emits an error when // using the FROMCAT template parameter below. @@ -1692,7 +1692,9 @@ Expr FoldOperation( if constexpr (TO::category == TypeCategory::Integer) { if constexpr (FromCat == TypeCategory::Integer) { auto converted{Scalar::ConvertSigned(*value)}; - if (converted.overflow) { + if (converted.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { ctx.messages().Say( "INTEGER(%d) to INTEGER(%d) conversion overflowed"_warn_en_US, Operand::kind, TO::kind); @@ -1700,14 +1702,17 @@ Expr FoldOperation( return ScalarConstantToExpr(std::move(converted.value)); } else if constexpr (FromCat == TypeCategory::Real) { auto converted{value->template ToInteger>()}; - if (converted.flags.test(RealFlag::InvalidArgument)) { - ctx.messages().Say( - "REAL(%d) to INTEGER(%d) conversion: invalid argument"_warn_en_US, - Operand::kind, TO::kind); - } else if (converted.flags.test(RealFlag::Overflow)) { - ctx.messages().Say( - "REAL(%d) to INTEGER(%d) conversion overflowed"_warn_en_US, - Operand::kind, TO::kind); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + if (converted.flags.test(RealFlag::InvalidArgument)) { + ctx.messages().Say( + "REAL(%d) to INTEGER(%d) conversion: invalid argument"_warn_en_US, + Operand::kind, TO::kind); + } else if (converted.flags.test(RealFlag::Overflow)) { + ctx.messages().Say( + "REAL(%d) to INTEGER(%d) conversion overflowed"_warn_en_US, + Operand::kind, TO::kind); + } } return ScalarConstantToExpr(std::move(converted.value)); } @@ -1816,7 +1821,9 @@ Expr FoldOperation(FoldingContext &context, Negate &&x) { } else if (auto value{GetScalarConstantValue(operand)}) { if constexpr (T::category == TypeCategory::Integer) { auto negated{value->Negate()}; - if (negated.overflow) { + if (negated.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "INTEGER(%d) negation overflowed"_warn_en_US, T::kind); } @@ -1856,7 +1863,9 @@ Expr FoldOperation(FoldingContext &context, Add &&x) { if (auto folded{OperandsAreConstants(x)}) { if constexpr (T::category == TypeCategory::Integer) { auto sum{folded->first.AddSigned(folded->second)}; - if (sum.overflow) { + if (sum.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "INTEGER(%d) addition overflowed"_warn_en_US, T::kind); } @@ -1882,7 +1891,9 @@ Expr FoldOperation(FoldingContext &context, Subtract &&x) { if (auto folded{OperandsAreConstants(x)}) { if constexpr (T::category == TypeCategory::Integer) { auto difference{folded->first.SubtractSigned(folded->second)}; - if (difference.overflow) { + if (difference.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind); } @@ -1908,7 +1919,9 @@ Expr FoldOperation(FoldingContext &context, Multiply &&x) { if (auto folded{OperandsAreConstants(x)}) { if constexpr (T::category == TypeCategory::Integer) { auto product{folded->first.MultiplySigned(folded->second)}; - if (product.SignedMultiplicationOverflowed()) { + if (product.SignedMultiplicationOverflowed() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind); } @@ -1953,11 +1966,16 @@ Expr FoldOperation(FoldingContext &context, Divide &&x) { if constexpr (T::category == TypeCategory::Integer) { auto quotAndRem{folded->first.DivideSigned(folded->second)}; if (quotAndRem.divisionByZero) { - context.messages().Say( - "INTEGER(%d) division by zero"_warn_en_US, T::kind); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + context.messages().Say( + "INTEGER(%d) division by zero"_warn_en_US, T::kind); + } return Expr{std::move(x)}; } - if (quotAndRem.overflow) { + if (quotAndRem.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "INTEGER(%d) division overflowed"_warn_en_US, T::kind); } @@ -1998,22 +2016,26 @@ Expr FoldOperation(FoldingContext &context, Power &&x) { if (auto folded{OperandsAreConstants(x)}) { if constexpr (T::category == TypeCategory::Integer) { auto power{folded->first.Power(folded->second)}; - if (power.divisionByZero) { - context.messages().Say( - "INTEGER(%d) zero to negative power"_warn_en_US, T::kind); - } else if (power.overflow) { - context.messages().Say( - "INTEGER(%d) power overflowed"_warn_en_US, T::kind); - } else if (power.zeroToZero) { - context.messages().Say( - "INTEGER(%d) 0**0 is not defined"_warn_en_US, T::kind); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + if (power.divisionByZero) { + context.messages().Say( + "INTEGER(%d) zero to negative power"_warn_en_US, T::kind); + } else if (power.overflow) { + context.messages().Say( + "INTEGER(%d) power overflowed"_warn_en_US, T::kind); + } else if (power.zeroToZero) { + context.messages().Say( + "INTEGER(%d) 0**0 is not defined"_warn_en_US, T::kind); + } } return Expr{Constant{power.power}}; } else { if (auto callable{GetHostRuntimeWrapper("pow")}) { return Expr{ Constant{(*callable)(context, folded->first, folded->second)}}; - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "Power for %s cannot be folded on host"_warn_en_US, T{}.AsFortran()); @@ -2097,7 +2119,9 @@ Expr> ToReal( CHECK(constant); Scalar real{constant->GetScalarValue().value()}; From converted{From::ConvertUnsigned(real.RawBits()).value}; - if (original != converted) { // C1601 + if (original != converted && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingValueChecks)) { // C1601 context.messages().Say( "Nonzero bits truncated from BOZ literal constant in REAL intrinsic"_warn_en_US); } diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index 0a6ff12049f30..b76b9d49b5823 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -297,7 +297,9 @@ static Expr FoldCount(FoldingContext &context, FunctionRef &&ref) { CountAccumulator accumulator{arrayAndMask->array}; Constant result{DoReduction(arrayAndMask->array, arrayAndMask->mask, dim, Scalar{}, accumulator)}; - if (accumulator.overflow()) { + if (accumulator.overflow() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "Result of intrinsic function COUNT overflows its result type"_warn_en_US); } @@ -556,7 +558,9 @@ Expr> FoldIntrinsicFunction( std::string name{intrinsic->name}; auto FromInt64{[&name, &context](std::int64_t n) { Scalar result{n}; - if (result.ToInt64() != n) { + if (result.ToInt64() != n && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US, name, std::intmax_t{n}); @@ -567,7 +571,9 @@ Expr> FoldIntrinsicFunction( return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&context](const Scalar &i) -> Scalar { typename Scalar::ValueWithOverflow j{i.ABS()}; - if (j.overflow) { + if (j.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND); } @@ -587,7 +593,9 @@ Expr> FoldIntrinsicFunction( return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&](const Scalar &x) { auto y{x.template ToInteger>(mode)}; - if (y.flags.test(RealFlag::Overflow)) { + if (y.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "%s intrinsic folding overflow"_warn_en_US, name); } @@ -634,7 +642,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc([&context](const Scalar &x, const Scalar &y) -> Scalar { auto result{x.DIM(y)}; - if (result.overflow) { + if (result.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say("DIM intrinsic folding overflow"_warn_en_US); } return result.value; @@ -1111,10 +1121,13 @@ Expr> FoldIntrinsicFunction( [](FoldingContext &context, const Scalar &x, const Scalar &y) -> Scalar { auto quotRem{x.DivideSigned(y)}; - if (quotRem.divisionByZero) { - context.messages().Say("mod() by zero"_warn_en_US); - } else if (quotRem.overflow) { - context.messages().Say("mod() folding overflowed"_warn_en_US); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingAvoidsRuntimeCrash)) { + if (quotRem.divisionByZero) { + context.messages().Say("mod() by zero"_warn_en_US); + } else if (quotRem.overflow) { + context.messages().Say("mod() folding overflowed"_warn_en_US); + } } return quotRem.remainder; })); @@ -1124,7 +1137,9 @@ Expr> FoldIntrinsicFunction( const Scalar &x, const Scalar &y) -> Scalar { auto result{x.MODULO(y)}; - if (result.overflow) { + if (result.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say("modulo() folding overflowed"_warn_en_US); } return result.value; @@ -1256,7 +1271,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc([&context](const Scalar &j, const Scalar &k) -> Scalar { typename Scalar::ValueWithOverflow result{j.SIGN(k)}; - if (result.overflow) { + if (result.overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "sign(integer(kind=%d)) folding overflowed"_warn_en_US, KIND); } @@ -1314,7 +1331,9 @@ Expr> FoldIntrinsicFunction( auto realBytes{ context.targetCharacteristics().GetByteSize(TypeCategory::Real, context.defaults().GetDefaultKind(TypeCategory::Real))}; - if (intBytes != realBytes) { + if (intBytes != realBytes && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingValueChecks)) { context.messages().Say(*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); } diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp index b7d641711c363..a7c655b72f56e 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -530,7 +530,9 @@ static Expr> RewriteOutOfRange( // Bounds depend on round= value if (auto *round{UnwrapExpr>(args[2])}) { if (const Symbol * whole{UnwrapWholeSymbolDataRef(*round)}; - whole && semantics::IsOptional(whole->GetUltimate())) { + whole && semantics::IsOptional(whole->GetUltimate()) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::OptionalMustBePresent)) { if (auto source{args[2]->sourceLocation()}) { context.messages().Say(*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 27b6db1fd8bf0..152fed436031d 100644 --- a/flang/lib/Evaluate/fold-matmul.h +++ b/flang/lib/Evaluate/fold-matmul.h @@ -85,7 +85,9 @@ static Expr FoldMatmul(FoldingContext &context, FunctionRef &&funcRef) { elements.push_back(sum); } } - if (overflow) { + if (overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "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 fd37437c643aa..1f2fd31297980 100644 --- a/flang/lib/Evaluate/fold-real.cpp +++ b/flang/lib/Evaluate/fold-real.cpp @@ -35,7 +35,8 @@ static Expr FoldTransformationalBessel( } return Expr{Constant{ std::move(results), ConstantSubscripts{std::max(n2 - n1 + 1, 0)}}}; - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US, name, T::kind); @@ -127,7 +128,9 @@ static Expr> FoldNorm2(FoldingContext &context, context.targetCharacteristics().roundingMode()}; Constant result{DoReduction(arrayAndMask->array, arrayAndMask->mask, dim, identity, norm2Accumulator)}; - if (norm2Accumulator.overflow()) { + if (norm2Accumulator.overflow() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "NORM2() of REAL(%d) data overflowed"_warn_en_US, KIND); } @@ -159,7 +162,8 @@ Expr> FoldIntrinsicFunction( if (auto callable{GetHostRuntimeWrapper(name)}) { return FoldElementalIntrinsic( context, std::move(funcRef), *callable); - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "%s(real(kind=%d)) cannot be folded on host"_warn_en_US, name, KIND); } @@ -172,7 +176,8 @@ Expr> FoldIntrinsicFunction( if (auto callable{GetHostRuntimeWrapper(localName)}) { return FoldElementalIntrinsic( context, std::move(funcRef), *callable); - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "%s(real(kind=%d), real(kind%d)) cannot be folded on host"_warn_en_US, name, KIND, KIND); @@ -183,7 +188,8 @@ Expr> FoldIntrinsicFunction( if (auto callable{GetHostRuntimeWrapper(name)}) { return FoldElementalIntrinsic( context, std::move(funcRef), *callable); - } else { + } else if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { context.messages().Say( "%s(integer(kind=4), real(kind=%d)) cannot be folded on host"_warn_en_US, name, KIND); @@ -201,7 +207,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc([&name, &context]( const Scalar &z) -> Scalar { ValueWithRealFlags> y{z.ABS()}; - if (y.flags.test(RealFlag::Overflow)) { + if (y.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "complex ABS intrinsic folding overflow"_warn_en_US, name); } @@ -223,7 +231,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc( [&name, &context, mode](const Scalar &x) -> Scalar { ValueWithRealFlags> y{x.ToWholeNumber(mode)}; - if (y.flags.test(RealFlag::Overflow)) { + if (y.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "%s intrinsic folding overflow"_warn_en_US, name); } @@ -234,7 +244,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc([&context](const Scalar &x, const Scalar &y) -> Scalar { ValueWithRealFlags> result{x.DIM(y)}; - if (result.flags.test(RealFlag::Overflow)) { + if (result.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say("DIM intrinsic folding overflow"_warn_en_US); } return result.value; @@ -266,7 +278,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc( [&](const Scalar &x, const Scalar &y) -> Scalar { ValueWithRealFlags> result{x.HYPOT(y)}; - if (result.flags.test(RealFlag::Overflow)) { + if (result.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "HYPOT intrinsic folding overflow"_warn_en_US); } @@ -290,7 +304,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc( [&context](const Scalar &x, const Scalar &y) -> Scalar { auto result{x.MOD(y)}; - if (result.flags.test(RealFlag::DivideByZero)) { + if (result.flags.test(RealFlag::DivideByZero) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingAvoidsRuntimeCrash)) { context.messages().Say( "second argument to MOD must not be zero"_warn_en_US); } @@ -302,7 +318,9 @@ Expr> FoldIntrinsicFunction( ScalarFunc( [&context](const Scalar &x, const Scalar &y) -> Scalar { auto result{x.MODULO(y)}; - if (result.flags.test(RealFlag::DivideByZero)) { + if (result.flags.test(RealFlag::DivideByZero) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingAvoidsRuntimeCrash)) { context.messages().Say( "second argument to MODULO must not be zero"_warn_en_US); } @@ -316,17 +334,22 @@ Expr> FoldIntrinsicFunction( return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&](const Scalar &x, const Scalar &s) -> Scalar { - if (s.IsZero()) { + if (s.IsZero() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingValueChecks)) { context.messages().Say( "NEAREST: S argument is zero"_warn_en_US); } auto result{x.NEAREST(!s.IsNegative())}; - if (result.flags.test(RealFlag::Overflow)) { - context.messages().Say( - "NEAREST intrinsic folding overflow"_warn_en_US); - } else if (result.flags.test(RealFlag::InvalidArgument)) { - context.messages().Say( - "NEAREST intrinsic folding: bad argument"_warn_en_US); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + if (result.flags.test(RealFlag::Overflow)) { + context.messages().Say( + "NEAREST intrinsic folding overflow"_warn_en_US); + } else if (result.flags.test(RealFlag::InvalidArgument)) { + context.messages().Say( + "NEAREST intrinsic folding: bad argument"_warn_en_US); + } } return result.value; })); @@ -362,7 +385,9 @@ Expr> FoldIntrinsicFunction( template #endif SCALE(y)}; - if (result.flags.test(RealFlag::Overflow)) { + if (result.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "SCALE intrinsic folding overflow"_warn_en_US); } @@ -412,8 +437,11 @@ Expr> FoldIntrinsicFunction( bool upward{true}; switch (x.Compare(Scalar::Convert(y).value)) { case Relation::Unordered: - context.messages().Say( - "IEEE_NEXT_AFTER intrinsic folding: bad argument"_warn_en_US); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingValueChecks)) { + context.messages().Say( + "IEEE_NEXT_AFTER intrinsic folding: bad argument"_warn_en_US); + } return x; case Relation::Equal: return x; @@ -425,7 +453,9 @@ Expr> FoldIntrinsicFunction( break; } auto result{x.NEAREST(upward)}; - if (result.flags.test(RealFlag::Overflow)) { + if (result.flags.test(RealFlag::Overflow) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "IEEE_NEXT_AFTER intrinsic folding overflow"_warn_en_US); } @@ -441,12 +471,15 @@ Expr> FoldIntrinsicFunction( return FoldElementalIntrinsic(context, std::move(funcRef), ScalarFunc([&](const Scalar &x) -> Scalar { auto result{x.NEAREST(upward)}; - if (result.flags.test(RealFlag::Overflow)) { - context.messages().Say( - "%s intrinsic folding overflow"_warn_en_US, iName); - } else if (result.flags.test(RealFlag::InvalidArgument)) { - context.messages().Say( - "%s intrinsic folding: bad argument"_warn_en_US, iName); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { + if (result.flags.test(RealFlag::Overflow)) { + context.messages().Say( + "%s intrinsic folding overflow"_warn_en_US, iName); + } else if (result.flags.test(RealFlag::InvalidArgument)) { + context.messages().Say( + "%s intrinsic folding: bad argument"_warn_en_US, iName); + } } return result.value; })); diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h index c84d35734ab5a..d15432665d2f2 100644 --- a/flang/lib/Evaluate/fold-reduction.h +++ b/flang/lib/Evaluate/fold-reduction.h @@ -93,7 +93,9 @@ static Expr FoldDotProduct( sum = std::move(added.value); } } - if (overflow) { + if (overflow && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "DOT_PRODUCT of %s data overflowed during computation"_warn_en_US, T::AsFortran()); @@ -309,7 +311,9 @@ static Expr FoldProduct( ProductAccumulator accumulator{arrayAndMask->array}; auto result{Expr{DoReduction( arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}}; - if (accumulator.overflow()) { + if (accumulator.overflow() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "PRODUCT() of %s data overflowed"_warn_en_US, T::AsFortran()); } @@ -375,7 +379,9 @@ static Expr FoldSum(FoldingContext &context, FunctionRef &&ref) { arrayAndMask->array, context.targetCharacteristics().roundingMode()}; auto result{Expr{DoReduction( arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)}}; - if (accumulator.overflow()) { + if (accumulator.overflow() && + context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingException)) { context.messages().Say( "SUM() of %s data overflowed"_warn_en_US, T::AsFortran()); } diff --git a/flang/lib/Evaluate/host.cpp b/flang/lib/Evaluate/host.cpp index a5817bd0b59ad..31bc438385803 100644 --- a/flang/lib/Evaluate/host.cpp +++ b/flang/lib/Evaluate/host.cpp @@ -100,9 +100,13 @@ void HostFloatingPointEnvironment::SetUpHostFloatingPointEnvironment( break; case common::RoundingMode::TiesAwayFromZero: fesetround(FE_TONEAREST); - context.messages().Say( - "TiesAwayFromZero rounding mode is not available when folding constants" - " with host runtime; using TiesToEven instead"_warn_en_US); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::FoldingFailure)) { + context.messages().Say( + "TiesAwayFromZero rounding mode is not available when folding " + "constants" + " with host runtime; using TiesToEven instead"_warn_en_US); + } break; } flags_.clear(); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 1b73cadb682d9..441a762c930d8 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -2283,7 +2283,7 @@ std::optional IntrinsicInterface::Match( UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) { if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) { if (context.languageFeatures().ShouldWarn( - common::UsageWarning::DimMustBePresent)) { + common::UsageWarning::OptionalMustBePresent)) { if (rank == Rank::scalarIfDim || arrayRank.value_or(-1) == 1) { messages.Say( "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); @@ -2741,16 +2741,21 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer( context.messages().Say(at, "FPTR= argument to C_F_POINTER() may not have a deferred type parameter"_err_en_US); } else if (type->category() == TypeCategory::Derived) { - if (type->IsUnlimitedPolymorphic()) { - context.messages().Say(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, - "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US); + if (context.languageFeatures().ShouldWarn( + common::UsageWarning::Interoperability)) { + if (type->IsUnlimitedPolymorphic()) { + context.messages().Say(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, + "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US); + } } } else if (!IsInteroperableIntrinsicType( - *type, &context.languageFeatures())) { + *type, &context.languageFeatures()) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::Interoperability)) { context.messages().Say(at, "FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type %s"_warn_en_US, type->AsFortran()); @@ -2850,7 +2855,9 @@ std::optional IntrinsicProcTable::Implementation::HandleC_Loc( context.messages().Say(arguments[0]->sourceLocation(), "C_LOC() argument may not be zero-length character"_err_en_US); } else if (typeAndShape->type().category() != TypeCategory::Derived && - !IsInteroperableIntrinsicType(typeAndShape->type())) { + !IsInteroperableIntrinsicType(typeAndShape->type()) && + context.languageFeatures().ShouldWarn( + common::UsageWarning::Interoperability)) { context.messages().Say(arguments[0]->sourceLocation(), "C_LOC() argument has non-interoperable intrinsic type, kind, or length"_warn_en_US); } diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index d73ba835a0524..247386a365de9 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -214,17 +214,21 @@ std::optional> Substring::Fold(FoldingContext &context) { } if (!result) { // error cases if (*lbi < 1) { - context.messages().Say( - "Lower bound (%jd) on substring is less than one"_warn_en_US, - static_cast(*lbi)); + if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) { + context.messages().Say( + "Lower bound (%jd) on substring is less than one"_warn_en_US, + static_cast(*lbi)); + } *lbi = 1; lower_ = AsExpr(Constant{1}); } if (length && *ubi > *length) { - context.messages().Say( - "Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US, - static_cast(*ubi), - static_cast(*length)); + if (context.languageFeatures().ShouldWarn(common::UsageWarning::Bounds)) { + context.messages().Say( + "Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US, + static_cast(*ubi), + static_cast(*length)); + } *ubi = *length; upper_ = AsExpr(Constant{*ubi}); } diff --git a/flang/lib/Parser/preprocessor.cpp b/flang/lib/Parser/preprocessor.cpp index 2fba28b0c0c7d..ce95dc4b7aaec 100644 --- a/flang/lib/Parser/preprocessor.cpp +++ b/flang/lib/Parser/preprocessor.cpp @@ -593,8 +593,11 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { "# missing or invalid name"_err_en_US); } else { if (dir.IsAnythingLeft(++j)) { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#undef: excess tokens at end of directive"_port_en_US); + if (prescanner.features().ShouldWarn( + common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#undef: excess tokens at end of directive"_port_en_US); + } } else { definitions_.erase(nameToken); } @@ -607,8 +610,11 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { "#%s: missing name"_err_en_US, dirName); } else { if (dir.IsAnythingLeft(++j)) { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#%s: excess tokens at end of directive"_port_en_US, dirName); + if (prescanner.features().ShouldWarn( + common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#%s: excess tokens at end of directive"_port_en_US, dirName); + } } doThen = IsNameDefined(nameToken) == (dirName == "ifdef"); } @@ -627,8 +633,10 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { } } else if (dirName == "else") { if (dir.IsAnythingLeft(j)) { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#else: excess tokens at end of directive"_port_en_US); + if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#else: excess tokens at end of directive"_port_en_US); + } } else if (ifStack_.empty()) { prescanner.Say(dir.GetTokenProvenanceRange(dirOffset), "#else: not nested within #if, #ifdef, or #ifndef"_err_en_US); @@ -654,8 +662,10 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { } } else if (dirName == "endif") { if (dir.IsAnythingLeft(j)) { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#endif: excess tokens at end of directive"_port_en_US); + if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#endif: excess tokens at end of directive"_port_en_US); + } } else if (ifStack_.empty()) { prescanner.Say(dir.GetTokenProvenanceRange(dirOffset), "#endif: no #if, #ifdef, or #ifndef"_err_en_US); @@ -702,8 +712,11 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { ++k; } if (k >= pathTokens) { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#include: expected '>' at end of included file"_port_en_US); + if (prescanner.features().ShouldWarn( + common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#include: expected '>' at end of included file"_port_en_US); + } } TokenSequence braced{path, 1, k - 1}; include = braced.ToString(); @@ -729,8 +742,10 @@ void Preprocessor::Directive(const TokenSequence &dir, Prescanner &prescanner) { } k = path.SkipBlanks(k + 1); if (k < pathTokens && path.TokenAt(k).ToString() != "!") { - prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), - "#include: extra stuff ignored after file name"_port_en_US); + if (prescanner.features().ShouldWarn(common::UsageWarning::Portability)) { + prescanner.Say(dir.GetIntervalProvenanceRange(j, tokens - j), + "#include: extra stuff ignored after file name"_port_en_US); + } } std::string buf; llvm::raw_string_ostream error{buf}; diff --git a/flang/lib/Parser/prescan.cpp b/flang/lib/Parser/prescan.cpp index 2d46eae531b18..c08a28cb43449 100644 --- a/flang/lib/Parser/prescan.cpp +++ b/flang/lib/Parser/prescan.cpp @@ -209,8 +209,10 @@ void Prescanner::Statement() { case LineClassification::Kind::IncludeDirective: case LineClassification::Kind::DefinitionDirective: case LineClassification::Kind::PreprocessorDirective: - Say(preprocessed->GetProvenanceRange(), - "Preprocessed line resembles a preprocessor directive"_warn_en_US); + if (features_.ShouldWarn(common::UsageWarning::Preprocessing)) { + Say(preprocessed->GetProvenanceRange(), + "Preprocessed line resembles a preprocessor directive"_warn_en_US); + } preprocessed->ToLowerCase() .CheckBadFortranCharacters(messages_, *this) .CheckBadParentheses(messages_) @@ -319,10 +321,12 @@ void Prescanner::LabelField(TokenSequence &token) { ++column_; } if (badColumn && !preprocessor_.IsNameDefined(token.CurrentOpenToken())) { - Say(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); + if (features_.ShouldWarn(common::UsageWarning::Scanning)) { + Say(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); + } token.clear(); if (*badColumn < 6) { at_ = start; @@ -799,8 +803,10 @@ void Prescanner::Hollerith( while (count-- > 0) { if (PadOutCharacterLiteral(tokens)) { } else if (*at_ == '\n') { - Say(GetProvenanceRange(start, at_), - "Possible truncated Hollerith literal"_warn_en_US); + if (features_.ShouldWarn(common::UsageWarning::Scanning)) { + Say(GetProvenanceRange(start, at_), + "Possible truncated Hollerith literal"_warn_en_US); + } break; } else { NextChar(); @@ -958,8 +964,10 @@ void Prescanner::FortranInclude(const char *firstQuote) { const char *garbage{p}; for (; *p != '\n' && *p != '!'; ++p) { } - Say(GetProvenanceRange(garbage, p), - "excess characters after path name"_warn_en_US); + if (features_.ShouldWarn(common::UsageWarning::Scanning)) { + Say(GetProvenanceRange(garbage, p), + "excess characters after path name"_warn_en_US); + } } std::string buf; llvm::raw_string_ostream error{buf}; diff --git a/flang/lib/Parser/prescan.h b/flang/lib/Parser/prescan.h index 3ee4c5a2c69ea..4eb3713bd3e37 100644 --- a/flang/lib/Parser/prescan.h +++ b/flang/lib/Parser/prescan.h @@ -43,6 +43,7 @@ class Prescanner { Messages &messages() { return messages_; } const Preprocessor &preprocessor() const { return preprocessor_; } Preprocessor &preprocessor() { return preprocessor_; } + common::LanguageFeatureControl &features() { return features_; } Prescanner &set_fixedForm(bool yes) { inFixedForm_ = yes; diff --git a/flang/lib/Semantics/check-acc-structure.cpp b/flang/lib/Semantics/check-acc-structure.cpp index 44aaa1fdd8036..18704b53c66f1 100644 --- a/flang/lib/Semantics/check-acc-structure.cpp +++ b/flang/lib/Semantics/check-acc-structure.cpp @@ -409,12 +409,16 @@ void AccStructureChecker::CheckMultipleOccurrenceInDeclare( if (const auto *name = getDesignatorNameIfDataRef(designator)) { if (declareSymbols.contains(&name->symbol->GetUltimate())) { if (declareSymbols[&name->symbol->GetUltimate()] == clause) { - 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())); + 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())); + } } else { context_.Say(GetContext().clauseSource, "'%s' in the %s clause is already present in another " @@ -780,7 +784,10 @@ void AccStructureChecker::Enter(const parser::AccClause::If &x) { } void AccStructureChecker::Enter(const parser::OpenACCEndConstruct &x) { - context_.Say(x.source, "Misplaced OpenACC end directive"_warn_en_US); + if (context_.languageFeatures().ShouldWarn( + common::UsageWarning::OpenAccUsage)) { + context_.Say(x.source, "Misplaced OpenACC end directive"_warn_en_US); + } } void AccStructureChecker::Enter(const parser::Module &) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index db0949e905a65..689d76e30337a 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -161,7 +161,10 @@ static void CheckCharacterActual(evaluate::Expr &actual, actualOffset->offset()) / actualType.type().kind(); } - if (actualChars < dummyChars) { + 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 (extentErrors) { @@ -177,7 +180,10 @@ static void CheckCharacterActual(evaluate::Expr &actual, foldingContext, evaluate::GetSize(evaluate::Shape(actualType.shape()))))}; actualSize && - *actualSize * *actualLength < *dummySize * *dummyLength) { + *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}; if (extentErrors) { @@ -255,12 +261,15 @@ static void ConvertIntegerActual(evaluate::Expr &actual, 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 { + } 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; } - messages.Say(std::move(msg.value()), actualType.type().kind(), - dummyType.type().kind()); + if (msg) { + messages.Say(std::move(msg.value()), actualType.type().kind(), + dummyType.type().kind()); + } } } actualType = dummyType; @@ -336,7 +345,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (const auto *constantChar{ evaluate::UnwrapConstantValue(actual)}; constantChar && constantChar->wasHollerith() && - dummy.type.type().IsUnlimitedPolymorphic()) { + dummy.type.type().IsUnlimitedPolymorphic() && + context.ShouldWarn(common::LanguageFeature::HollerithPolymorphic)) { messages.Say( "passing Hollerith to unlimited polymorphic as if it were CHARACTER"_port_en_US); } @@ -589,7 +599,10 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, *actualSymTypeBytes; } } - if (actualElements && *actualElements < *dummySize) { + 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 (extentErrors) { @@ -604,7 +617,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, } else { // actualRank > 0 || actualIsAssumedRank if (auto actualSize{evaluate::ToInt64(evaluate::Fold(foldingContext, evaluate::GetSize(evaluate::Shape(actualType.shape()))))}; - actualSize && *actualSize < *dummySize) { + 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}; if (extentErrors) { @@ -706,7 +721,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // Extension (Intel, NAG, XLF): a NULL() pointer is an acceptable // actual argument for an INTENT(IN) allocatable dummy, and it // is treated as an unassociated allocatable. - if (context.languageFeatures().ShouldWarn( + if (context.ShouldWarn( common::LanguageFeature::NullActualForAllocatable)) { messages.Say( "Allocatable %s is associated with a null pointer"_port_en_US, @@ -1160,8 +1175,8 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg, evaluate::IsNullPointer(*expr)) { if (object.intent == common::Intent::In) { // Extension (Intel, NAG, XLF); see CheckExplicitDataArg. - if (context.languageFeatures().ShouldWarn(common:: - LanguageFeature::NullActualForAllocatable)) { + if (context.ShouldWarn(common::LanguageFeature:: + NullActualForAllocatable)) { messages.Say( "Allocatable %s is associated with NULL()"_port_en_US, dummyName); @@ -1390,6 +1405,11 @@ static void CheckAssociated(evaluate::ActualArguments &arguments, 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( + common::UsageWarning::ProcPointerCompatibility)) { + msg.reset(); } if (msg) { msg->set_severity(parser::Severity::Warning); @@ -1736,7 +1756,7 @@ static void CheckTransfer(evaluate::ActualArguments &arguments, messages.Say( "Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US); } - } else { + } else if (context.ShouldWarn(common::UsageWarning::VoidMold)) { messages.Say( "Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US); } @@ -1954,9 +1974,14 @@ bool CheckArguments(const characteristics::Procedure &proc, /*extentErrors=*/true, ignoreImplicitVsExplicit)}; if (!buffer.empty()) { if (treatingExternalAsImplicit) { - if (auto *msg{messages.Say( - "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) { - buffer.AttachTo(*msg, parser::Severity::Because); + if (context.ShouldWarn( + common::UsageWarning::KnownBadImplicitInterface)) { + if (auto *msg{messages.Say( + "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) { + buffer.AttachTo(*msg, parser::Severity::Because); + } + } else { + buffer.clear(); } } if (auto *msgs{messages.messages()}) { diff --git a/flang/lib/Semantics/check-case.cpp b/flang/lib/Semantics/check-case.cpp index 5bc166ef21262..d296460127e12 100644 --- a/flang/lib/Semantics/check-case.cpp +++ b/flang/lib/Semantics/check-case.cpp @@ -49,8 +49,10 @@ template class CaseValues { for (const auto &range : ranges) { auto pair{ComputeBounds(range)}; if (pair.first && pair.second && *pair.first > *pair.second) { - context_.Say(stmt.source, - "CASE has lower bound greater than upper bound"_warn_en_US); + if (context_.ShouldWarn(common::UsageWarning::EmptyCase)) { + context_.Say(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) && @@ -93,9 +95,11 @@ template class CaseValues { x->v = converted; return value; } else { - context_.Say(expr.source, - "CASE value (%s) overflows type (%s) of SELECT CASE expression"_warn_en_US, - folded.AsFortran(), caseExprType_.AsFortran()); + 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()); + } hasErrors_ = true; return std::nullopt; } diff --git a/flang/lib/Semantics/check-cuda.cpp b/flang/lib/Semantics/check-cuda.cpp index a9e57de7e2f2b..96ab902392633 100644 --- a/flang/lib/Semantics/check-cuda.cpp +++ b/flang/lib/Semantics/check-cuda.cpp @@ -296,8 +296,10 @@ template class DeviceContextChecker { return false; } void WarnOnIoStmt(const parser::CharBlock &source) { - context_.Say( - source, "I/O statement might not be supported on device"_warn_en_US); + if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) { + context_.Say( + 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-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 901ac20f8aae9..16eb0e558df76 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -766,19 +766,25 @@ void CheckHelper::CheckObjectEntity( if (IsPassedViaDescriptor(symbol)) { if (IsAllocatableOrObjectPointer(&symbol)) { if (inExplicitInterface) { - WarnIfNotInModuleFile( - "!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US); + if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) { + WarnIfNotInModuleFile( + "!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)) { - WarnIfNotInModuleFile( - "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US); + if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) { + WarnIfNotInModuleFile( + "!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US); + } } else if (inExplicitInterface) { - WarnIfNotInModuleFile( - "!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US); + if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) { + WarnIfNotInModuleFile( + "!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); @@ -891,25 +897,31 @@ void CheckHelper::CheckObjectEntity( bool inDeviceSubprogram{IsCUDADeviceContext(&symbol.owner())}; if (inDeviceSubprogram) { if (IsSaved(symbol)) { - WarnIfNotInModuleFile( - "'%s' should not have the SAVE attribute or initialization in a device subprogram"_warn_en_US, - symbol.name()); + 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()); + } } if (IsPointer(symbol)) { - WarnIfNotInModuleFile( - "Pointer '%s' may not be associated in a device subprogram"_warn_en_US, - symbol.name()); + if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) { + WarnIfNotInModuleFile( + "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) { - WarnIfNotInModuleFile( - "Dummy argument '%s' may not have ATTRIBUTES(%s) in a device subprogram"_warn_en_US, - symbol.name(), - parser::ToUpperCaseLetters( - common::EnumToString(*details.cudaDataAttr()))); + 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()))); + } } } if (details.cudaDataAttr()) { @@ -959,17 +971,23 @@ void CheckHelper::CheckObjectEntity( break; case common::CUDADataAttr::Pinned: if (inDeviceSubprogram) { - WarnIfNotInModuleFile( - "Object '%s' with ATTRIBUTES(PINNED) may not be declared in a device subprogram"_warn_en_US, - symbol.name()); + 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()); + } } else if (IsPointer(symbol)) { - WarnIfNotInModuleFile( - "Object '%s' with ATTRIBUTES(PINNED) may not be a pointer"_warn_en_US, - symbol.name()); + if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) { + WarnIfNotInModuleFile( + "Object '%s' with ATTRIBUTES(PINNED) may not be a pointer"_warn_en_US, + symbol.name()); + } } else if (!IsAllocatable(symbol)) { - WarnIfNotInModuleFile( - "Object '%s' with ATTRIBUTES(PINNED) should also be allocatable"_warn_en_US, - symbol.name()); + if (context_.ShouldWarn(common::UsageWarning::CUDAUsage)) { + WarnIfNotInModuleFile( + "Object '%s' with ATTRIBUTES(PINNED) should also be allocatable"_warn_en_US, + symbol.name()); + } } break; case common::CUDADataAttr::Shared: @@ -1489,12 +1507,16 @@ void CheckHelper::CheckExternal(const Symbol &symbol) { if (chars->HasExplicitInterface()) { std::string whyNot; if (!chars->IsCompatibleWith(*globalChars, - /*ignoreImplicitVsExplicit=*/false, &whyNot)) { + /*ignoreImplicitVsExplicit=*/false, &whyNot) && + context_.ShouldWarn( + common::UsageWarning::ExternalInterfaceMismatch)) { msg = WarnIfNotInModuleFile( "The global subprogram '%s' is not compatible with its local procedure declaration (%s)"_warn_en_US, global->name(), whyNot); } - } else if (!globalChars->CanBeCalledViaImplicitInterface()) { + } else if (!globalChars->CanBeCalledViaImplicitInterface() && + context_.ShouldWarn( + common::UsageWarning::ExternalInterfaceMismatch)) { msg = messages_.Say( "The global subprogram '%s' may not be referenced via the implicit interface '%s'"_err_en_US, global->name(), symbol.name()); @@ -1516,7 +1538,9 @@ void CheckHelper::CheckExternal(const Symbol &symbol) { if (auto previousChars{Characterize(previous)}) { std::string whyNot; if (!chars->IsCompatibleWith(*previousChars, - /*ignoreImplicitVsExplicit=*/false, &whyNot)) { + /*ignoreImplicitVsExplicit=*/false, &whyNot) && + context_.ShouldWarn( + common::UsageWarning::ExternalInterfaceMismatch)) { if (auto *msg{WarnIfNotInModuleFile( "The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US, symbol.name(), whyNot)}) { @@ -1938,7 +1962,9 @@ std::optional CheckHelper::CheckNumberOfArgs( const GenericKind &kind, std::size_t nargs) { if (!kind.IsIntrinsicOperator()) { if (nargs < 1 || nargs > 2) { - return "%s function '%s' should have 1 or 2 dummy arguments"_warn_en_US; + if (context_.ShouldWarn(common::UsageWarning::DefinedOperatorArgs)) { + return "%s function '%s' should have 1 or 2 dummy arguments"_warn_en_US; + } } return std::nullopt; } @@ -1995,8 +2021,10 @@ bool CheckHelper::CheckDefinedOperatorArg(const SourceName &opName, "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)) { - msg = - "In %s function '%s', dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US; + if (context_.ShouldWarn(common::UsageWarning::DefinedOperatorArgs)) { + msg = + "In %s function '%s', dummy argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US; + } } if (msg) { bool isFatal{msg->IsFatal()}; @@ -2058,8 +2086,10 @@ bool CheckHelper::CheckDefinedAssignmentArg( " may not have INTENT(IN)"_err_en_US; } else if (dataObject->intent != common::Intent::Out && dataObject->intent != common::Intent::InOut) { - msg = "In defined assignment subroutine '%s', first dummy argument '%s'" - " should have INTENT(OUT) or INTENT(INOUT)"_warn_en_US; + 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; + } } } else if (pos == 1) { if (dataObject->intent == common::Intent::Out) { @@ -2067,9 +2097,10 @@ 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)) { - msg = - "In defined assignment subroutine '%s', second dummy" - " argument '%s' should have INTENT(IN) or VALUE attribute"_warn_en_US; + 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; + } } 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; @@ -2123,7 +2154,8 @@ void CheckHelper::WarnMissingFinal(const Symbol &symbol) { while (const auto *derivedDetails{ derivedSym ? derivedSym->detailsIf() : nullptr}) { if (!derivedDetails->finals().empty() && - !derivedDetails->GetFinalForRank(rank)) { + !derivedDetails->GetFinalForRank(rank) && + context_.ShouldWarn(common::UsageWarning::Final)) { if (auto *msg{derivedSym == initialDerivedSym ? WarnIfNotInModuleFile(symbol.name(), "'%s' of derived type '%s' does not have a FINAL subroutine for its rank (%d)"_warn_en_US, diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp index 51f536f3d7723..c1eab090a4bb1 100644 --- a/flang/lib/Semantics/check-do-forall.cpp +++ b/flang/lib/Semantics/check-do-forall.cpp @@ -540,7 +540,8 @@ class DoContext { CheckDoExpression(bounds.upper); if (bounds.step) { CheckDoExpression(*bounds.step); - if (IsZero(*bounds.step)) { + if (IsZero(*bounds.step) && + context_.ShouldWarn(common::UsageWarning::ZeroDoStep)) { context_.Say(bounds.step->thing.value().source, "DO step expression should not be zero"_warn_en_US); } @@ -791,7 +792,8 @@ class DoContext { }, assignment.u); for (const Symbol &index : indexVars) { - if (symbols.count(index) == 0) { + 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, index.name()); diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp index ad89a9be5a290..8f8a4e800b488 100644 --- a/flang/lib/Semantics/check-io.cpp +++ b/flang/lib/Semantics/check-io.cpp @@ -795,10 +795,12 @@ void IoChecker::Leave(const parser::ReadStmt &readStmt) { CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220 if (specifierSet_.test(IoSpecKind::Size)) { // F'2023 C1214 - allow with a warning - if (specifierSet_.test(IoSpecKind::Nml)) { - context_.Say("If NML appears, SIZE should not appear"_port_en_US); - } else if (flags_.test(Flag::StarFmt)) { - context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US); + if (context_.ShouldWarn(common::LanguageFeature::ListDirectedSize)) { + if (specifierSet_.test(IoSpecKind::Nml)) { + context_.Say("If NML appears, SIZE should not appear"_port_en_US); + } else if (flags_.test(Flag::StarFmt)) { + context_.Say("If FMT=* appears, SIZE should not appear"_port_en_US); + } } } CheckForRequiredSpecifier(IoSpecKind::Eor, diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 8a16299db319c..ab76fe59911b7 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1020,10 +1020,12 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar( ContextDirectiveAsFortran()); else if (GetContext().directive == llvm::omp::Directive::OMPD_declare_target) - context_.Say(name->source, - "The entity with PARAMETER attribute is used in a %s " - "directive"_warn_en_US, - ContextDirectiveAsFortran()); + 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()); + } } else if (FindCommonBlockContaining(*name->symbol)) { context_.Say(name->source, "A variable in a %s directive cannot be an element of a " @@ -1190,7 +1192,7 @@ void OmpStructureChecker::Leave(const parser::OmpDeclareTargetWithClause &x) { context_.Say(x.source, "If the DECLARE TARGET directive has a clause, it must contain at lease one ENTER clause or LINK clause"_err_en_US); } - if (toClause) { + if (toClause && context_.ShouldWarn(common::UsageWarning::OpenMPUsage)) { context_.Say(toClause->source, "The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead."_warn_en_US); } @@ -2964,9 +2966,11 @@ void OmpStructureChecker::Enter(const parser::OmpClause::UseDevicePtr &x) { if (const auto *name{parser::Unwrap(ompObject)}) { if (name->symbol) { if (!(IsBuiltinCPtr(*(name->symbol)))) { - 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()); + 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()); + } } else { useDevicePtrNameList.push_back(*name); } @@ -3023,16 +3027,20 @@ 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))) { - 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()); + 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()); + } } else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) { - 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()); + 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()); + } } } } diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp index 2ebc4e561a339..64050874bcdec 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -462,9 +462,12 @@ bool DataInitializationCompiler::InitElement( } else if (status == evaluate::InitialImage::OutOfRange) { OutOfRangeError(); } else if (status == evaluate::InitialImage::LengthMismatch) { - exprAnalyzer_.Say( - "DATA statement value '%s' for '%s' has the wrong length"_warn_en_US, - folded.AsFortran(), DescribeElement()); + 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()); + } 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/expression.cpp b/flang/lib/Semantics/expression.cpp index b8396209fc685..f677973ca2753 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -789,9 +789,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::RealLiteralConstant &x) { auto kind{AnalyzeKindParam(x.kind, defaultKind)}; if (letterKind && expoLetter != 'e') { if (kind != *letterKind) { - Say("Explicit kind parameter on real constant disagrees with " - "exponent letter '%c'"_warn_en_US, - expoLetter); + 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)) { @@ -2776,7 +2778,9 @@ void ExpressionAnalyzer::CheckBadExplicitType( if (const auto *typeAndShape{result->GetTypeAndShape()}) { if (auto declared{ typeAndShape->Characterize(intrinsic, GetFoldingContext())}) { - if (!declared->type().IsTkCompatibleWith(typeAndShape->type())) { + if (!declared->type().IsTkCompatibleWith(typeAndShape->type()) && + context_.ShouldWarn( + common::UsageWarning::IgnoredIntrinsicFunctionType)) { if (auto *msg{Say( "The result type '%s' of the intrinsic function '%s' is not the explicit declared type '%s'"_warn_en_US, typeAndShape->AsFortran(), intrinsic.name(), @@ -3149,7 +3153,9 @@ std::optional ExpressionAnalyzer::CheckCall( iter != implicitInterfaces_.end()) { std::string whyNot; if (!chars->IsCompatibleWith(iter->second.second, - /*ignoreImplicitVsExplicit=*/false, &whyNot)) { + /*ignoreImplicitVsExplicit=*/false, &whyNot) && + context_.ShouldWarn( + common::UsageWarning::IncompatibleImplicitInterfaces)) { if (auto *msg{Say(callSite, "Reference to the procedure '%s' has an implicit interface that is distinct from another reference: %s"_warn_en_US, name, whyNot)}) { @@ -3833,8 +3839,10 @@ bool ExpressionAnalyzer::CheckIntrinsicKind( return true; } else if (foldingContext_.targetCharacteristics().CanSupportType( category, kind)) { - Say("%s(KIND=%jd) is not an enabled type for this target"_warn_en_US, - ToUpperCase(EnumToString(category)), kind); + if (context_.ShouldWarn(common::UsageWarning::BadTypeForTarget)) { + Say("%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, @@ -3860,8 +3868,10 @@ bool ExpressionAnalyzer::CheckIntrinsicSize( return true; } else if (foldingContext_.targetCharacteristics().CanSupportType( category, kind)) { - Say("%s*%jd is not an enabled type for this target"_warn_en_US, - ToUpperCase(EnumToString(category)), size); + if (context_.ShouldWarn(common::UsageWarning::BadTypeForTarget)) { + Say("%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, diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 4a531c3c0f99f..31ad3dbdcec64 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -1397,13 +1397,17 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, std::optional checkSum{ VerifyHeader(sourceFile->content())}; if (!checkSum) { - Say(name, ancestorName, "File has invalid checksum: %s"_warn_en_US, - sourceFile->path()); + if (context_.ShouldWarn(common::UsageWarning::ModuleFile)) { + Say(name, ancestorName, "File has invalid checksum: %s"_warn_en_US, + sourceFile->path()); + } return nullptr; } else if (requiredHash && *requiredHash != *checkSum) { - Say(name, ancestorName, - "File is not the right module file for %s"_warn_en_US, - "'"s + name.ToString() + "': "s + sourceFile->path()); + 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()); + } return nullptr; } llvm::raw_null_ostream NullStream; diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp index 60a496a63cb38..077072060e9b1 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -266,8 +266,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)) { - msg = "CONTIGUOUS %s is associated with the result of reference to" - " function '%s' that is not known to be contiguous"_warn_en_US; + 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; + } } else if (lhsType_) { const auto *frTypeAndShape{funcResult->GetTypeAndShape()}; CHECK(frTypeAndShape); diff --git a/flang/lib/Semantics/program-tree.cpp b/flang/lib/Semantics/program-tree.cpp index 13c85c17459e1..250f5801b39e1 100644 --- a/flang/lib/Semantics/program-tree.cpp +++ b/flang/lib/Semantics/program-tree.cpp @@ -225,7 +225,9 @@ std::optional ProgramTree::Build( std::optional ProgramTree::Build( const parser::CompilerDirective &x, SemanticsContext &context) { - context.Say(x.source, "Compiler directive ignored here"_warn_en_US); + if (context.ShouldWarn(common::UsageWarning::IgnoredDirective)) { + context.Say(x.source, "Compiler directive ignored here"_warn_en_US); + } return std::nullopt; } diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp index d04b8f3eb548a..63fc2e1168b88 100644 --- a/flang/lib/Semantics/resolve-labels.cpp +++ b/flang/lib/Semantics/resolve-labels.cpp @@ -935,7 +935,8 @@ void CheckBranchesIntoDoBody(const SourceStmtList &branches, const auto &fromPosition{branch.parserCharBlock}; const auto &toPosition{branchTarget.parserCharBlock}; for (const auto &body : loopBodies) { - if (!InBody(fromPosition, body) && InBody(toPosition, body)) { + if (!InBody(fromPosition, body) && InBody(toPosition, body) && + context.ShouldWarn(common::LanguageFeature::BranchIntoConstruct)) { context .Say( fromPosition, "branch into loop body from outside"_warn_en_US) @@ -1062,11 +1063,16 @@ void CheckScopeConstraints(const SourceStmtList &stmts, break; } } - context.Say(position, - isFatal - ? "Label '%u' is in a construct that prevents its use as a branch target here"_err_en_US - : "Label '%u' is in a construct that should not be used as a branch target here"_warn_en_US, - SayLabel(label)); + if (isFatal) { + context.Say(position, + "Label '%u' is in a construct that prevents its use as a branch target here"_err_en_US, + 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)); + } } } } @@ -1087,7 +1093,8 @@ void CheckBranchTargetConstraints(const SourceStmtList &stmts, .Attach(stmt.parserCharBlock, "Control flow use of '%u'"_en_US, SayLabel(label)); } else if (!branchTarget.labeledStmtClassificationSet.test( - TargetStatementEnum::Branch)) { // warning + TargetStatementEnum::Branch) && + context.ShouldWarn(common::LanguageFeature::BadBranchTarget)) { context .Say(branchTarget.parserCharBlock, "Label '%u' is not a branch target"_warn_en_US, SayLabel(label)) @@ -1140,15 +1147,21 @@ void CheckAssignTargetConstraints(const SourceStmtList &stmts, TargetStatementEnum::Branch) && !target.labeledStmtClassificationSet.test( TargetStatementEnum::Format)) { - context - .Say(target.parserCharBlock, - target.labeledStmtClassificationSet.test( - TargetStatementEnum::CompatibleBranch) - ? "Label '%u' is not a branch target or FORMAT"_warn_en_US - : "Label '%u' is not a branch target or FORMAT"_err_en_US, - SayLabel(label)) - .Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US, - SayLabel(label)); + parser::Message *msg{nullptr}; + if (!target.labeledStmtClassificationSet.test( + TargetStatementEnum::CompatibleBranch)) { + msg = &context.Say(target.parserCharBlock, + "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)); + } + if (msg) { + msg->Attach(stmt.parserCharBlock, "ASSIGN statement use of '%u'"_en_US, + SayLabel(label)); + } } } } diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 7bd1f4e4e9618..61394b0f41de7 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1839,9 +1839,11 @@ bool AttrsVisitor::Pre(const parser::Pass &x) { bool AttrsVisitor::IsDuplicateAttr(Attr attrName) { CHECK(attrs_); if (attrs_->test(attrName)) { - Say(currStmtSource().value(), - "Attribute '%s' cannot be used more than once"_warn_en_US, - AttrToString(attrName)); + if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say(currStmtSource().value(), + "Attribute '%s' cannot be used more than once"_warn_en_US, + AttrToString(attrName)); + } return true; } return false; @@ -3603,9 +3605,11 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) { ResolveSpecificsInGeneric(generic, true); auto &details{generic.get()}; if (auto *proc{details.CheckSpecific()}) { - 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); + 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); + } } auto &specifics{details.specificProcs()}; if (specifics.empty()) { @@ -3619,14 +3623,17 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) { bool isBoth{false}; for (const Symbol &specific : specifics) { if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514 - auto &msg{Say(generic.name(), - "Generic interface '%s' has both a function and a subroutine"_warn_en_US)}; - if (isFunction) { - msg.Attach(firstSpecific.name(), "Function declaration"_en_US); - msg.Attach(specific.name(), "Subroutine declaration"_en_US); - } else { - msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US); - msg.Attach(specific.name(), "Function declaration"_en_US); + if (context().ShouldWarn( + common::LanguageFeature::SubroutineAndFunctionSpecifics)) { + auto &msg{Say(generic.name(), + "Generic interface '%s' has both a function and a subroutine"_warn_en_US)}; + if (isFunction) { + msg.Attach(firstSpecific.name(), "Function declaration"_en_US); + msg.Attach(specific.name(), "Subroutine declaration"_en_US); + } else { + msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US); + msg.Attach(specific.name(), "Function declaration"_en_US); + } } isFunction = false; isBoth = true; @@ -3767,9 +3774,12 @@ bool SubprogramVisitor::Pre(const parser::PrefixSpec::Attributes &attrs) { (*current == common::CUDASubprogramAttrs::HostDevice && (attr == common::CUDASubprogramAttrs::Host || attr == common::CUDASubprogramAttrs::Device))) { - Say(currStmtSource().value(), - "ATTRIBUTES(%s) appears more than once"_warn_en_US, - common::EnumToString(attr)); + if (context().ShouldWarn( + common::LanguageFeature::RedundantAttribute)) { + Say(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 || @@ -3951,11 +3961,13 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) { } // C1560. if (info.resultName && !distinctResultName) { - Say(info.resultName->source, - "The function name should not appear in RESULT; references to '%s' " - "inside the function will be considered as references to the " - "result only"_warn_en_US, - name.source); + 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); + } // 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 @@ -4369,8 +4381,10 @@ bool SubprogramVisitor::HandlePreviousCalls( if (symbol.attrs().test(Attr::EXTERNAL) && !symbol.implicitAttrs().test(Attr::EXTERNAL)) { // Warn if external statement previously declared. - Say(name, - "EXTERNAL attribute was already specified on '%s'"_warn_en_US); + if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say(name, + "EXTERNAL attribute was already specified on '%s'"_warn_en_US); + } } else if (symbol.test(other)) { Say2(name, subpFlag == Symbol::Flag::Function @@ -4820,8 +4834,11 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) { if (auto *details{symbol->detailsIf()}) { if (details->isInterface()) { // Warn if interface previously declared. - Say(name, - "EXTERNAL attribute was already specified on '%s'"_warn_en_US); + if (context().ShouldWarn( + common::LanguageFeature::RedundantAttribute)) { + Say(name, + "EXTERNAL attribute was already specified on '%s'"_warn_en_US); + } } } else { SayWithDecl( @@ -4866,12 +4883,15 @@ void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) { if (symbol.GetType()) { // These warnings are worded so that they should make sense in either // order. - 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 (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 (!symbol.test(Symbol::Flag::Function) && !symbol.test(Symbol::Flag::Subroutine)) { @@ -4937,9 +4957,11 @@ Symbol &DeclarationVisitor::HandleAttributeStmt( } } else if (symbol && symbol->has()) { if (symbol->GetUltimate().attrs().test(attr)) { - Say(currStmtSource().value(), - "Use-associated '%s' already has '%s' attribute"_warn_en_US, - name.source, EnumToString(attr)); + if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say(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, @@ -5070,8 +5092,10 @@ Symbol &DeclarationVisitor::DeclareObjectEntity( context().SetError(symbol); } } else if (MustBeScalar(symbol)) { - Say(name, - "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US); + if (context().ShouldWarn(common::UsageWarning::PreviousScalarUse)) { + Say(name, + "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US); + } } else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) { Say(name, "'%s' was initialized earlier as a scalar"_err_en_US); } else { @@ -5449,8 +5473,10 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { details.set_sequence(true); if (componentDefs.empty()) { // F'2023 C745 - not enforced by any compiler - Say(stmt.source, - "A sequence type should have at least one component"_warn_en_US); + if (context().ShouldWarn(common::LanguageFeature::EmptySequenceType)) { + Say(stmt.source, + "A sequence type should have at least one component"_warn_en_US); + } } if (!details.paramNames().empty()) { // C740 Say(stmt.source, @@ -5554,13 +5580,17 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &) { } else if (!derivedTypeInfo_.privateComps) { derivedTypeInfo_.privateComps = true; } else { // C738 - Say("PRIVATE should not appear more than once in derived type components"_warn_en_US); + if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say("PRIVATE should not appear more than once in derived type components"_warn_en_US); + } } return false; } bool DeclarationVisitor::Pre(const parser::SequenceStmt &) { if (derivedTypeInfo_.sequence) { // C738 - Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US); + if (context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US); + } } derivedTypeInfo_.sequence = true; return false; @@ -6084,7 +6114,9 @@ void DeclarationVisitor::Post(const parser::BasedPointer &bp) { } if (const auto *pointeeType{pointee->GetType()}) { if (const auto *derived{pointeeType->AsDerived()}) { - if (!IsSequenceOrBindCType(derived)) { + 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); } @@ -6232,9 +6264,11 @@ void DeclarationVisitor::CheckSaveStmts() { // error was reported } else if (specPartState_.saveInfo.saveAll) { // C889 - note that pgi, ifort, xlf do not enforce this constraint - Say2(name, - "Explicit SAVE of '%s' is redundant due to global SAVE statement"_warn_en_US, - *specPartState_.saveInfo.saveAll, "Global SAVE statement"_en_US); + 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); + } } else if (!IsSaved(*symbol)) { SetExplicitAttr(*symbol, Attr::SAVE); } @@ -6276,7 +6310,8 @@ Attrs DeclarationVisitor::HandleSaveName(const SourceName &name, Attrs attrs) { void DeclarationVisitor::AddSaveName( std::set &set, const SourceName &name) { auto pair{set.insert(name)}; - if (!pair.second) { + 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); } @@ -6728,8 +6763,11 @@ bool DeclarationVisitor::OkToAddComponent( " '%s'"_err_en_US; } else if (CheckAccessibleSymbol(currScope(), *prev)) { // inaccessible component -- redeclaration is ok - msg = "Component '%s' is inaccessibly declared in or as a " - "parent of this derived type"_warn_en_US; + if (context().ShouldWarn( + common::UsageWarning::RedeclaredInaccessibleComponent)) { + msg = + "Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US; + } } 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; @@ -6861,8 +6899,10 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::LocalInit &x) { bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) { for (const auto &name : x.v) { if (!FindSymbol(name)) { - Say(name, - "Variable '%s' with SHARED locality implicitly declared"_warn_en_US); + if (context().ShouldWarn(common::UsageWarning::ImplicitShared)) { + Say(name, + "Variable '%s' with SHARED locality implicitly declared"_warn_en_US); + } } Symbol &prev{FindOrDeclareEnclosingEntity(name)}; if (PassesSharedLocalityChecks(name, prev)) { @@ -8324,12 +8364,16 @@ Symbol &ModuleVisitor::SetAccess( Attrs &attrs{symbol->attrs()}; 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; - Say(name, - WithSeverity( - "The accessibility of '%s' has already been specified as %s"_warn_en_US, - attr != prev ? parser::Severity::Error : parser::Severity::Warning), - MakeOpName(name), EnumToString(prev)); + Attr prev{attrs.test(Attr::PUBLIC) ? Attr::PUBLIC : Attr::PRIVATE}; + if (attr != prev || + context().ShouldWarn(common::LanguageFeature::RedundantAttribute)) { + Say(name, + WithSeverity( + "The accessibility of '%s' has already been specified as %s"_warn_en_US, + attr != prev ? parser::Severity::Error + : parser::Severity::Warning), + MakeOpName(name), EnumToString(prev)); + } } else { attrs.set(attr); } @@ -8888,7 +8932,7 @@ void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) { } } } - } else { + } else if (context().ShouldWarn(common::UsageWarning::IgnoredDirective)) { Say(x.source, "Unrecognized compiler directive was ignored"_warn_en_US); } } diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp index e58a8f3b22c06..9f30c428b9045 100644 --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -443,8 +443,10 @@ void SemanticsContext::CheckIndexVarRedefine(const parser::CharBlock &location, void SemanticsContext::WarnIndexVarRedefine( const parser::CharBlock &location, const Symbol &variable) { - CheckIndexVarRedefine(location, variable, - "Possible redefinition of %s variable '%s'"_warn_en_US); + if (ShouldWarn(common::UsageWarning::IndexVarRedefinition)) { + CheckIndexVarRedefine(location, variable, + "Possible redefinition of %s variable '%s'"_warn_en_US); + } } void SemanticsContext::CheckIndexVarRedefine( diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index df435906af68d..2d0caff82eb2b 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1485,45 +1485,45 @@ const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) { } void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) { - checkLabelUse(gotoStmt.v); + CheckLabelUse(gotoStmt.v); } void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) { for (auto &i : std::get>(computedGotoStmt.t)) { - checkLabelUse(i); + CheckLabelUse(i); } } void LabelEnforce::Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) { - checkLabelUse(std::get<1>(arithmeticIfStmt.t)); - checkLabelUse(std::get<2>(arithmeticIfStmt.t)); - checkLabelUse(std::get<3>(arithmeticIfStmt.t)); + CheckLabelUse(std::get<1>(arithmeticIfStmt.t)); + CheckLabelUse(std::get<2>(arithmeticIfStmt.t)); + CheckLabelUse(std::get<3>(arithmeticIfStmt.t)); } void LabelEnforce::Post(const parser::AssignStmt &assignStmt) { - checkLabelUse(std::get(assignStmt.t)); + CheckLabelUse(std::get(assignStmt.t)); } void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) { for (auto &i : std::get>(assignedGotoStmt.t)) { - checkLabelUse(i); + CheckLabelUse(i); } } void LabelEnforce::Post(const parser::AltReturnSpec &altReturnSpec) { - checkLabelUse(altReturnSpec.v); + CheckLabelUse(altReturnSpec.v); } void LabelEnforce::Post(const parser::ErrLabel &errLabel) { - checkLabelUse(errLabel.v); + CheckLabelUse(errLabel.v); } void LabelEnforce::Post(const parser::EndLabel &endLabel) { - checkLabelUse(endLabel.v); + CheckLabelUse(endLabel.v); } void LabelEnforce::Post(const parser::EorLabel &eorLabel) { - checkLabelUse(eorLabel.v); + CheckLabelUse(eorLabel.v); } -void LabelEnforce::checkLabelUse(const parser::Label &labelUsed) { +void LabelEnforce::CheckLabelUse(const parser::Label &labelUsed) { if (labels_.find(labelUsed) == labels_.end()) { SayWithConstruct(context_, currentStatementSourcePosition_, parser::MessageFormattedText{ diff --git a/flang/test/Driver/prescanner-diag.f90 b/flang/test/Driver/prescanner-diag.f90 index 7c2f8d4d7ef4f..5064af13835f2 100644 --- a/flang/test/Driver/prescanner-diag.f90 +++ b/flang/test/Driver/prescanner-diag.f90 @@ -5,12 +5,12 @@ ! on some DiagnosticsEngine). ! Test with -E (i.e. PrintPreprocessedAction, stops after prescanning) -! RUN: %flang -E -I %S/Inputs/ %s 2>&1 | FileCheck %s -! RUN: %flang_fc1 -E -I %S/Inputs/ %s 2>&1 | FileCheck %s +! RUN: %flang -pedantic -E -I %S/Inputs/ %s 2>&1 | FileCheck %s +! RUN: %flang_fc1 -pedantic -E -I %S/Inputs/ %s 2>&1 | FileCheck %s ! Test with -fsyntax-only (i.e. ParseSyntaxOnlyAction, stops after semantic checks) -! RUN: %flang -fsyntax-only -I %S/Inputs/ %s 2>&1 | FileCheck %s -! RUN: %flang_fc1 -fsyntax-only -I %S/Inputs/ %s 2>&1 | FileCheck %s +! RUN: %flang -pedantic -fsyntax-only -I %S/Inputs/ %s 2>&1 | FileCheck %s +! RUN: %flang_fc1 -pedantic -fsyntax-only -I %S/Inputs/ %s 2>&1 | FileCheck %s ! CHECK: prescanner-diag.f90:[[#@LINE+3]]:10: portability: #include: extra stuff ignored after file name ! CHECK: prescanner-diag.f90:[[#@LINE+3]]:10: portability: #include: extra stuff ignored after file name diff --git a/flang/test/Evaluate/fold-out_of_range.f90 b/flang/test/Evaluate/fold-out_of_range.f90 index 30665b9021a9b..81551255135d2 100644 --- a/flang/test/Evaluate/fold-out_of_range.f90 +++ b/flang/test/Evaluate/fold-out_of_range.f90 @@ -1,4 +1,4 @@ -! RUN: %python %S/test_folding.py %s %flang_fc1 +! RUN: %python %S/test_folding.py %s %flang_fc1 -pedantic ! UNSUPPORTED: target=powerpc{{.*}}, target=aarch{{.*}}, target=arm{{.*}}, system-windows, system-solaris ! Tests folding of OUT_OF_RANGE(). module m diff --git a/flang/test/Preprocessing/include-comment.F90 b/flang/test/Preprocessing/include-comment.F90 index c55d07ec66d30..7da4751f725a8 100644 --- a/flang/test/Preprocessing/include-comment.F90 +++ b/flang/test/Preprocessing/include-comment.F90 @@ -1,4 +1,4 @@ -! RUN: %flang -I%S -E %s 2>&1 | FileCheck %s +! RUN: %flang -pedantic -I%S -E %s 2>&1 | FileCheck %s ! CHECK-NOT: :3: #include ! comment ! CHECK-NOT: :5: diff --git a/flang/test/Semantics/kinds04_q10.f90 b/flang/test/Semantics/kinds04_q10.f90 index 3da619d24deec..d352daa1cbbf0 100644 --- a/flang/test/Semantics/kinds04_q10.f90 +++ b/flang/test/Semantics/kinds04_q10.f90 @@ -14,7 +14,9 @@ subroutine s(var) real :: realvar1 = 4.0E6_4 real :: realvar2 = 4.0D6 real :: realvar3 = 4.0Q6 + !PORTABILITY: Explicit kind parameter together with non-'E' exponent letter is not standard real :: realvar4 = 4.0D6_8 + !PORTABILITY: Explicit kind parameter together with non-'E' exponent letter is not standard real :: realvar5 = 4.0Q6_10 !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'q' real :: realvar6 = 4.0Q6_16 @@ -27,6 +29,7 @@ subroutine s(var) double precision :: doublevar1 = 4.0E6_4 double precision :: doublevar2 = 4.0D6 double precision :: doublevar3 = 4.0Q6 + !PORTABILITY: Explicit kind parameter together with non-'E' exponent letter is not standard double precision :: doublevar4 = 4.0D6_8 !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'q' double precision :: doublevar5 = 4.0Q6_16