[flang] Ensure all warning/portability messages are guarded by Should…

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 {

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_;

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);
   }
 }
 

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)}};
       }

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);

flang/lib/Evaluate/fold-implementation.h

@@ -1680,7 +1680,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.
@@ -1692,22 +1692,27 @@ 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);
               }
               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));
             }
@@ -1816,7 +1821,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);
       }
@@ -1856,7 +1863,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);
       }
@@ -1882,7 +1891,9 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
   if (auto folded{OperandsAreConstants(x)}) {
     if constexpr (T::category == TypeCategory::Integer) {
       auto difference{folded->first.SubtractSigned(folded->second)};
-      if (difference.overflow) {
+      if (difference.overflow &&
+          context.languageFeatures().ShouldWarn(
+              common::UsageWarning::FoldingException)) {
         context.messages().Say(
             "INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
       }
@@ -1908,7 +1919,9 @@ Expr<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);
       }
@@ -1953,11 +1966,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);
       }
@@ -1998,22 +2016,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());
@@ -2097,7 +2119,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);
           }