[flang-commits] [flang] 505f6da - [flang] Ensure all warning/portability messages are guarded by Should… (#90518)
via flang-commits
flang-commits at lists.llvm.org
Wed May 1 14:33:19 PDT 2024
Author: Peter Klausler
Date: 2024-05-01T14:33:14-07:00
New Revision: 505f6da1961ab55c601d7239648c53ce863b5d70
URL: https://github.com/llvm/llvm-project/commit/505f6da1961ab55c601d7239648c53ce863b5d70
DIFF: https://github.com/llvm/llvm-project/commit/505f6da1961ab55c601d7239648c53ce863b5d70.diff
LOG: [flang] Ensure all warning/portability messages are guarded by Should… (#90518)
…Warn()
Many warning messages were being emitted unconditionally. Ensure that
all warnings are conditional on a true result from a call to
common::LanguageFeatureControl::ShouldWarn() so that it is easy for a
driver to disable them all, or, in the future, to provide per-warning
control over them.
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/common.cpp
flang/lib/Evaluate/fold-character.cpp
flang/lib/Evaluate/fold-complex.cpp
flang/lib/Evaluate/fold-implementation.h
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/fold-logical.cpp
flang/lib/Evaluate/fold-matmul.h
flang/lib/Evaluate/fold-real.cpp
flang/lib/Evaluate/fold-reduction.h
flang/lib/Evaluate/host.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Parser/preprocessor.cpp
flang/lib/Parser/prescan.cpp
flang/lib/Parser/prescan.h
flang/lib/Semantics/check-acc-structure.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-case.cpp
flang/lib/Semantics/check-cuda.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/check-do-forall.cpp
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/pointer-assignment.cpp
flang/lib/Semantics/program-tree.cpp
flang/lib/Semantics/resolve-labels.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/semantics.cpp
flang/lib/Semantics/tools.cpp
flang/test/Driver/prescanner-diag.f90
flang/test/Evaluate/fold-out_of_range.f90
flang/test/Preprocessing/include-comment.F90
flang/test/Semantics/kinds04_q10.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 1e678c341d8132..6b3e37cd9c25f1 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<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
@@ -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 da10969ebc7021..efb5c9ba1077d4 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 c659a5002ba0fc..c633bff57b1ecd 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 5d9cc11754a7dd..877bc2eac1fc27 100644
--- a/flang/lib/Evaluate/fold-character.cpp
+++ b/flang/lib/Evaluate/fold-character.cpp
@@ -58,10 +58,13 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
return FoldElementalIntrinsic<T, IntT>(context, std::move(funcRef),
ScalarFunc<T, IntT>([&](const Scalar<IntT> &i) {
if (i.IsNegative() || i.BGE(Scalar<IntT>{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<std::intmax_t>(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<std::intmax_t>(i.ToInt64()), KIND);
+ }
}
return CharacterUtils<KIND>::CHAR(i.ToUInt64());
}));
@@ -103,9 +106,12 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction(
static_cast<std::intmax_t>(n));
} else if (static_cast<double>(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<double>(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<double>(n) * str.size());
+ }
} else {
return Expr<T>{Constant<T>{CharacterUtils<KIND>::REPEAT(str, n)}};
}
diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp
index 3260f82ffe8d73..d44cc9c69dd68d 100644
--- a/flang/lib/Evaluate/fold-complex.cpp
+++ b/flang/lib/Evaluate/fold-complex.cpp
@@ -29,7 +29,8 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction(
if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) {
return FoldElementalIntrinsic<T, T>(
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 2c0e0883207e1b..e3b49449b88866 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1686,7 +1686,7 @@ Expr<TO> FoldOperation(
Convert<TO, FROMCAT> &convert;
} msvcWorkaround{context, convert};
return common::visit(
- [&msvcWorkaround](auto &kindExpr) -> Expr<TO> {
+ [&msvcWorkaround, &context](auto &kindExpr) -> Expr<TO> {
using Operand = ResultType<decltype(kindExpr)>;
// This variable is a workaround for msvc which emits an error when
// using the FROMCAT template parameter below.
@@ -1698,7 +1698,9 @@ Expr<TO> FoldOperation(
if constexpr (TO::category == TypeCategory::Integer) {
if constexpr (FromCat == TypeCategory::Integer) {
auto converted{Scalar<TO>::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);
@@ -1706,14 +1708,17 @@ Expr<TO> FoldOperation(
return ScalarConstantToExpr(std::move(converted.value));
} else if constexpr (FromCat == TypeCategory::Real) {
auto converted{value->template ToInteger<Scalar<TO>>()};
- 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));
}
@@ -1822,7 +1827,9 @@ Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
} else if (auto value{GetScalarConstantValue<T>(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);
}
@@ -1862,7 +1869,9 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&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);
}
@@ -1888,7 +1897,9 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
if (auto folded{OperandsAreConstants(x)}) {
if constexpr (T::category == TypeCategory::Integer) {
auto
diff erence{folded->first.SubtractSigned(folded->second)};
- if (
diff erence.overflow) {
+ if (
diff erence.overflow &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
context.messages().Say(
"INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
}
@@ -1914,7 +1925,9 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&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);
}
@@ -1959,11 +1972,16 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&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<T>{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);
}
@@ -2004,22 +2022,26 @@ Expr<T> FoldOperation(FoldingContext &context, Power<T> &&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<T>{Constant<T>{power.power}};
} else {
if (auto callable{GetHostRuntimeWrapper<T, T, T>("pow")}) {
return Expr<T>{
Constant<T>{(*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());
@@ -2103,7 +2125,9 @@ Expr<Type<TypeCategory::Real, KIND>> ToReal(
CHECK(constant);
Scalar<Result> 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 0a6ff12049f301..b76b9d49b58238 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -297,7 +297,9 @@ static Expr<T> FoldCount(FoldingContext &context, FunctionRef<T> &&ref) {
CountAccumulator<T, maskKind> accumulator{arrayAndMask->array};
Constant<T> result{DoReduction<T>(arrayAndMask->array, arrayAndMask->mask,
dim, Scalar<T>{}, 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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
std::string name{intrinsic->name};
auto FromInt64{[&name, &context](std::int64_t n) {
Scalar<T> 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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
typename Scalar<T>::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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
auto y{x.template ToInteger<Scalar<T>>(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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
[](FoldingContext &context, const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
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<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>([&context](const Scalar<T> &j,
const Scalar<T> &k) -> Scalar<T> {
typename Scalar<T>::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<Type<TypeCategory::Integer, KIND>> 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 b7d641711c363d..a7c655b72f56ef 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -530,7 +530,9 @@ static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
// Bounds depend on round= value
if (auto *round{UnwrapExpr<Expr<SomeType>>(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 bd61969a822c3b..a799cfb80a59de 100644
--- a/flang/lib/Evaluate/fold-matmul.h
+++ b/flang/lib/Evaluate/fold-matmul.h
@@ -92,7 +92,9 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&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 4df709d3d2c215..1ccf3f979ecef2 100644
--- a/flang/lib/Evaluate/fold-real.cpp
+++ b/flang/lib/Evaluate/fold-real.cpp
@@ -35,7 +35,8 @@ static Expr<T> FoldTransformationalBessel(
}
return Expr<T>{Constant<T>{
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);
@@ -130,7 +131,9 @@ static Expr<Type<TypeCategory::Real, KIND>> FoldNorm2(FoldingContext &context,
context.targetCharacteristics().roundingMode()};
Constant<T> result{DoReduction<T>(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);
}
@@ -162,7 +165,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (auto callable{GetHostRuntimeWrapper<T, T>(name)}) {
return FoldElementalIntrinsic<T, T>(
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);
}
@@ -175,7 +179,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (auto callable{GetHostRuntimeWrapper<T, T, T>(localName)}) {
return FoldElementalIntrinsic<T, T, T>(
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);
@@ -186,7 +191,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
if (auto callable{GetHostRuntimeWrapper<T, Int4, T>(name)}) {
return FoldElementalIntrinsic<T, Int4, T>(
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);
@@ -204,7 +210,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, ComplexT>([&name, &context](
const Scalar<ComplexT> &z) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> 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);
}
@@ -226,7 +234,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T>(
[&name, &context, mode](const Scalar<T> &x) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> 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);
}
@@ -237,7 +247,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
const Scalar<T> &y) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> 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;
@@ -269,7 +281,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>(
[&](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
ValueWithRealFlags<Scalar<T>> 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);
}
@@ -293,7 +307,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>(
[&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
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);
}
@@ -305,7 +321,9 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
ScalarFunc<T, T, T>(
[&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
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);
}
@@ -319,17 +337,22 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return FoldElementalIntrinsic<T, T, TS>(context, std::move(funcRef),
ScalarFunc<T, T, TS>([&](const Scalar<T> &x,
const Scalar<TS> &s) -> Scalar<T> {
- 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;
}));
@@ -365,7 +388,9 @@ Expr<Type<TypeCategory::Real, KIND>> 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);
}
@@ -415,8 +440,11 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
bool upward{true};
switch (x.Compare(Scalar<T>::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;
@@ -428,7 +456,9 @@ Expr<Type<TypeCategory::Real, KIND>> 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);
}
@@ -444,12 +474,15 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
ScalarFunc<T, T>([&](const Scalar<T> &x) -> Scalar<T> {
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 ae17770dc2961e..fbdae8f4eee01b 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -105,7 +105,9 @@ static Expr<T> FoldDotProduct(
}
}
}
- 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());
@@ -321,7 +323,9 @@ static Expr<T> FoldProduct(
ProductAccumulator accumulator{arrayAndMask->array};
auto result{Expr<T>{DoReduction<T>(
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());
}
@@ -387,7 +391,9 @@ static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
arrayAndMask->array, context.targetCharacteristics().roundingMode()};
auto result{Expr<T>{DoReduction<T>(
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 a5817bd0b59ad1..31bc4383858033 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 1b73cadb682d98..441a762c930d85 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2283,7 +2283,7 @@ std::optional<SpecificCall> 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<SpecificCall> 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 d73ba835a0524a..247386a365de93 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -214,17 +214,21 @@ std::optional<Expr<SomeCharacter>> 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<std::intmax_t>(*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<std::intmax_t>(*lbi));
+ }
*lbi = 1;
lower_ = AsExpr(Constant<SubscriptInteger>{1});
}
if (length && *ubi > *length) {
- context.messages().Say(
- "Upper bound (%jd) on substring is greater than character length (%jd)"_warn_en_US,
- static_cast<std::intmax_t>(*ubi),
- static_cast<std::intmax_t>(*length));
+ 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<std::intmax_t>(*ubi),
+ static_cast<std::intmax_t>(*length));
+ }
*ubi = *length;
upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
}
diff --git a/flang/lib/Parser/preprocessor.cpp b/flang/lib/Parser/preprocessor.cpp
index 2fba28b0c0c7d8..ce95dc4b7aaec3 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 2d46eae531b186..c08a28cb43449f 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 3ee4c5a2c69eaa..4eb3713bd3e373 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 44aaa1fdd80364..18704b53c66f16 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 f0da779785142a..94afcbb68b3493 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -161,7 +161,10 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &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<evaluate::SomeType> &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<evaluate::SomeType> &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<evaluate::Ascii>(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,
@@ -1161,8 +1176,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);
@@ -1391,6 +1406,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);
@@ -1737,7 +1757,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);
}
@@ -1955,9 +1975,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 5bc166ef212620..d296460127e12c 100644
--- a/flang/lib/Semantics/check-case.cpp
+++ b/flang/lib/Semantics/check-case.cpp
@@ -49,8 +49,10 @@ template <typename T> 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 <typename T> 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 a9e57de7e2f2b5..96ab9023926330 100644
--- a/flang/lib/Semantics/check-cuda.cpp
+++ b/flang/lib/Semantics/check-cuda.cpp
@@ -296,8 +296,10 @@ template <bool IsCUFKernelDo> 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 <typename A>
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 63665c224e2be9..c1d9538e557f57 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -768,19 +768,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);
@@ -885,25 +891,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()) {
@@ -953,17 +965,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:
@@ -1477,12 +1495,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());
@@ -1504,7 +1526,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)}) {
@@ -1926,7 +1950,9 @@ std::optional<parser::MessageFixedText> 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;
}
@@ -1983,8 +2009,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()};
@@ -2046,8 +2074,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) {
@@ -2055,9 +2085,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;
@@ -2111,7 +2142,8 @@ void CheckHelper::WarnMissingFinal(const Symbol &symbol) {
while (const auto *derivedDetails{
derivedSym ? derivedSym->detailsIf<DerivedTypeDetails>() : 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 51f536f3d77231..c1eab090a4bb12 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 ad89a9be5a290f..8f8a4e800b4881 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 8a16299db319c2..ab76fe59911b78 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<parser::Name>(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 2ebc4e561a339a..64050874bcdecb 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -462,9 +462,12 @@ bool DataInitializationCompiler<DSV>::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 b8396209fc6854..f677973ca2753b 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<characteristics::Procedure> 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 923107210a94cc..e9aebe5b08f2ba 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<bool> isIntrinsic,
std::optional<ModuleCheckSumType> 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 60a496a63cb380..077072060e9b11 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<T> &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 13c85c17459e12..250f5801b39e1a 100644
--- a/flang/lib/Semantics/program-tree.cpp
+++ b/flang/lib/Semantics/program-tree.cpp
@@ -225,7 +225,9 @@ std::optional<ProgramTree> ProgramTree::Build(
std::optional<ProgramTree> 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 d04b8f3eb548a8..63fc2e1168b888 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 7bd1f4e4e96185..61394b0f41de75 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<GenericDetails>()};
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<SubprogramDetails>()}) {
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<UseDetails>()) {
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<SourceName> &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 7739b946c7b405..6ccd915c4dcbf2 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 df435906af68d0..2d0caff82eb2b4 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<std::list<parser::Label>>(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<parser::Label>(assignStmt.t));
+ CheckLabelUse(std::get<parser::Label>(assignStmt.t));
}
void LabelEnforce::Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
for (auto &i : std::get<std::list<parser::Label>>(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 7c2f8d4d7ef4fc..5064af13835f24 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 30665b9021a9bb..81551255135d2f 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 c55d07ec66d30e..7da4751f725a85 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 <empty.h> ! comment
! CHECK-NOT: :5:
diff --git a/flang/test/Semantics/kinds04_q10.f90 b/flang/test/Semantics/kinds04_q10.f90
index 3da619d24deecd..d352daa1cbbf06 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
More information about the flang-commits
mailing list