initial commit

Author: akuhlens

flang/include/flang/Evaluate/common.h

@@ -255,6 +255,16 @@ class FoldingContext {
   const common::LanguageFeatureControl &languageFeatures() const {
     return languageFeatures_;
   }
+  template <typename... A>
+  parser::Message *Warn(common::LanguageFeature feature, A &&...args) {
+    return messages_.Warn(/*isInModuleFile=*/false, languageFeatures_, feature,
+        std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(common::UsageWarning warning, A &&...args) {
+    return messages_.Warn(/*isInModuleFile=*/false, languageFeatures_, warning,
+        std::forward<A>(args)...);
+  }
   std::optional<parser::CharBlock> moduleFileName() const {
     return moduleFileName_;
   }

flang/include/flang/Evaluate/tools.h

@@ -1116,6 +1116,18 @@ parser::Message *SayWithDeclaration(
     MESSAGES &messages, const Symbol &symbol, A &&...x) {
   return AttachDeclaration(messages.Say(std::forward<A>(x)...), symbol);
 }
+template <typename... A>
+parser::Message *WarnWithDeclaration(FoldingContext context,
+    const Symbol &symbol, common::LanguageFeature feature, A &&...x) {
+  return AttachDeclaration(
+      context.Warn(feature, std::forward<A>(x)...), symbol);
+}
+template <typename... A>
+parser::Message *WarnWithDeclaration(FoldingContext &context,
+    const Symbol &symbol, common::UsageWarning warning, A &&...x) {
+  return AttachDeclaration(
+      context.Warn(warning, std::forward<A>(x)...), symbol);
+}
 
 // Check for references to impure procedures; returns the name
 // of one to complain about, if any exist.

flang/include/flang/Parser/message.h

@@ -19,6 +19,7 @@
 #include "flang/Common/reference-counted.h"
 #include "flang/Common/restorer.h"
 #include "flang/Support/Fortran-features.h"
+#include "llvm/Support/ErrorHandling.h"
 #include <cstddef>
 #include <cstring>
 #include <forward_list>
@@ -334,14 +335,36 @@ class Messages {
     return messages_.emplace_back(std::forward<A>(args)...);
   }
 
+  // AddWarning bypasses the language feature control, it is only exposed for
+  // legacy code that cannot be easily refactored to use Warn().
   template <typename... A>
-  Message &Say(common::LanguageFeature feature, A &&...args) {
-    return Say(std::forward<A>(args)...).set_languageFeature(feature);
+  Message &AddWarning(common::UsageWarning warning, A &&...args) {
+    return messages_.emplace_back(warning, std::forward<A>(args)...);
   }
 
   template <typename... A>
-  Message &Say(common::UsageWarning warning, A &&...args) {
-    return Say(std::forward<A>(args)...).set_usageWarning(warning);
+  Message &AddWarning(common::LanguageFeature feature, A &&...args) {
+    return messages_.emplace_back(feature, std::forward<A>(args)...);
+  }
+
+  template <typename... A>
+  Message *Warn(bool isInModuleFile,
+      const common::LanguageFeatureControl &control,
+      common::LanguageFeature feature, A &&...args) {
+    if (!isInModuleFile && control.ShouldWarn(feature)) {
+      return &AddWarning(feature, std::forward<A>(args)...);
+    }
+    return nullptr;
+  }
+
+  template <typename... A>
+  Message *Warn(bool isInModuleFile,
+      const common::LanguageFeatureControl &control,
+      common::UsageWarning warning, A &&...args) {
+    if (!isInModuleFile && control.ShouldWarn(warning)) {
+      return &AddWarning(warning, std::forward<A>(args)...);
+    }
+    return nullptr;
   }
 
   void Annex(Messages &&that) {
@@ -422,24 +445,6 @@ class ContextualMessages {
     return Say(at.value_or(at_), std::forward<A>(args)...);
   }
 
-  template <typename... A>
-  Message *Say(common::LanguageFeature feature, A &&...args) {
-    Message *msg{Say(std::forward<A>(args)...)};
-    if (msg) {
-      msg->set_languageFeature(feature);
-    }
-    return msg;
-  }
-
-  template <typename... A>
-  Message *Say(common::UsageWarning warning, A &&...args) {
-    Message *msg{Say(std::forward<A>(args)...)};
-    if (msg) {
-      msg->set_usageWarning(warning);
-    }
-    return msg;
-  }
-
   Message *Say(Message &&msg) {
     if (messages_ != nullptr) {
       if (contextMessage_) {
@@ -451,6 +456,39 @@ class ContextualMessages {
     }
   }
 
+  template <typename FeatureOrUsageWarning, typename... A>
+  Message *Warn(bool isInModuleFile,
+      const common::LanguageFeatureControl &control,
+      FeatureOrUsageWarning feature, CharBlock at, A &&...args) {
+    if (messages_ != nullptr) {
+      if (Message *
+          msg{messages_->Warn(isInModuleFile, control, feature, at,
+              std::forward<A>(args)...)}) {
+        if (contextMessage_) {
+          msg->SetContext(contextMessage_.get());
+        }
+        return msg;
+      }
+    }
+    return nullptr;
+  }
+
+  template <typename FeatureOrUsageWarning, typename... A>
+  Message *Warn(bool isInModuleFile,
+      const common::LanguageFeatureControl &control,
+      FeatureOrUsageWarning feature, A &&...args) {
+    return Warn(
+        isInModuleFile, control, feature, at_, std::forward<A>(args)...);
+  }
+
+  template <typename FeatureOrUsageWarning, typename... A>
+  Message *Warn(bool isInModuleFile,
+      const common::LanguageFeatureControl &control,
+      FeatureOrUsageWarning feature, std::optional<CharBlock> at, A &&...args) {
+    return Warn(isInModuleFile, control, feature, at.value_or(at_),
+        std::forward<A>(args)...);
+  }
+
 private:
   CharBlock at_;
   Messages *messages_{nullptr};

flang/include/flang/Semantics/semantics.h

@@ -200,20 +200,59 @@ class SemanticsContext {
     return message;
   }
 
-  template <typename FeatureOrUsageWarning, typename... A>
+  template <typename... A>
+  parser::Message *Warn(parser::Messages &messages,
+      common::LanguageFeature feature, parser::CharBlock at, A &&...args) {
+    return messages.Warn(IsInModuleFile(at), languageFeatures_, feature, at,
+        std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(parser::Messages &messages,
+      common::UsageWarning warning, parser::CharBlock at, A &&...args) {
+    return messages.Warn(IsInModuleFile(at), languageFeatures_, warning, at,
+        std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(parser::ContextualMessages &messages,
+      common::LanguageFeature feature, parser::CharBlock at, A &&...args) {
+    return messages.Warn(IsInModuleFile(at), languageFeatures_, feature, at,
+        std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(parser::ContextualMessages &messages,
+      common::UsageWarning warning, parser::CharBlock at, A &&...args) {
+    return messages.Warn(IsInModuleFile(at), languageFeatures_, warning, at,
+        std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(parser::ContextualMessages &messages,
+      common::LanguageFeature feature, A &&...args) {
+    return messages.Warn(IsInModuleFile(messages.at()), languageFeatures_,
+        feature, messages.at(), std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(parser::ContextualMessages &messages,
+      common::UsageWarning warning, A &&...args) {
+    return messages.Warn(IsInModuleFile(messages.at()), languageFeatures_,
+        warning, messages.at(), std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(
+      common::LanguageFeature feature, parser::CharBlock at, A &&...args) {
+    return Warn(messages_, feature, at, std::forward<A>(args)...);
+  }
+  template <typename... A>
   parser::Message *Warn(
-      FeatureOrUsageWarning warning, parser::CharBlock at, A &&...args) {
-    if (languageFeatures_.ShouldWarn(warning) && !IsInModuleFile(at)) {
-      parser::Message &msg{
-          messages_.Say(warning, at, std::forward<A>(args)...)};
-      return &msg;
-    } else {
-      return nullptr;
-    }
-  }
-
-  template <typename FeatureOrUsageWarning, typename... A>
-  parser::Message *Warn(FeatureOrUsageWarning warning, A &&...args) {
+      common::UsageWarning warning, parser::CharBlock at, A &&...args) {
+    return Warn(messages_, warning, at, std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(common::LanguageFeature feature, A &&...args) {
+    CHECK(location_);
+    return Warn(feature, *location_, std::forward<A>(args)...);
+  }
+  template <typename... A>
+  parser::Message *Warn(common::UsageWarning warning, A &&...args) {
     CHECK(location_);
     return Warn(warning, *location_, std::forward<A>(args)...);
   }

flang/lib/Evaluate/check-expression.cpp

@@ -415,7 +415,7 @@ class SuspiciousRealLiteralFinder
   template <int KIND>
   bool operator()(const Constant<Type<TypeCategory::Real, KIND>> &x) const {
     if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
-      context_.messages().Say(common::UsageWarning::RealConstantWidening,
+      context_.Warn(common::UsageWarning::RealConstantWidening,
           "Default real literal in REAL(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
           kind_, x.AsFortran());
       return true;
@@ -426,7 +426,7 @@ class SuspiciousRealLiteralFinder
   template <int KIND>
   bool operator()(const Constant<Type<TypeCategory::Complex, KIND>> &x) const {
     if (kind_ > KIND && x.result().isFromInexactLiteralConversion()) {
-      context_.messages().Say(common::UsageWarning::RealConstantWidening,
+      context_.Warn(common::UsageWarning::RealConstantWidening,
           "Default real literal in COMPLEX(%d) context might need a kind suffix, as its rounded value %s is inexact"_warn_en_US,
           kind_, x.AsFortran());
       return true;
@@ -504,11 +504,8 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
         symbol.owner().context().IsEnabled(
             common::LanguageFeature::LogicalIntegerAssignment)) {
       converted = DataConstantConversionExtension(context, symTS->type(), x);
-      if (converted &&
-          symbol.owner().context().ShouldWarn(
-              common::LanguageFeature::LogicalIntegerAssignment)) {
-        context.messages().Say(
-            common::LanguageFeature::LogicalIntegerAssignment,
+      if (converted) {
+        context.Warn(common::LanguageFeature::LogicalIntegerAssignment,
             "nonstandard usage: initialization of %s with %s"_port_en_US,
             symTS->type().AsFortran(), x.GetType().value().AsFortran());
       }
@@ -663,10 +660,8 @@ class CheckSpecificationExprHelper
         // host-associated dummy argument, and that doesn't seem like a
         // good idea.
         if (!inInquiry_ && hasHostAssociation &&
-            ultimate.attrs().test(semantics::Attr::INTENT_OUT) &&
-            context_.languageFeatures().ShouldWarn(
-                common::UsageWarning::HostAssociatedIntentOutInSpecExpr)) {
-          context_.messages().Say(
+            ultimate.attrs().test(semantics::Attr::INTENT_OUT)) {
+          context_.Warn(common::UsageWarning::HostAssociatedIntentOutInSpecExpr,
               "specification expression refers to host-associated INTENT(OUT) dummy argument '%s'"_port_en_US,
               ultimate.name());
         }
@@ -677,13 +672,9 @@ class CheckSpecificationExprHelper
     } else if (isInitialized &&
         context_.languageFeatures().IsEnabled(
             common::LanguageFeature::SavedLocalInSpecExpr)) {
-      if (!scope_.IsModuleFile() &&
-          context_.languageFeatures().ShouldWarn(
-              common::LanguageFeature::SavedLocalInSpecExpr)) {
-        context_.messages().Say(common::LanguageFeature::SavedLocalInSpecExpr,
-            "specification expression refers to local object '%s' (initialized and saved)"_port_en_US,
-            ultimate.name());
-      }
+      context_.Warn(common::LanguageFeature::SavedLocalInSpecExpr,
+          "specification expression refers to local object '%s' (initialized and saved)"_port_en_US,
+          ultimate.name());
       return std::nullopt;
     } else if (const auto *object{
                    ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {

flang/lib/Evaluate/common.cpp

@@ -16,26 +16,22 @@ namespace Fortran::evaluate {
 void RealFlagWarnings(
     FoldingContext &context, const RealFlags &flags, const char *operation) {
   static constexpr auto warning{common::UsageWarning::FoldingException};
-  if (context.languageFeatures().ShouldWarn(warning)) {
-    if (flags.test(RealFlag::Overflow)) {
-      context.messages().Say(warning, "overflow on %s"_warn_en_US, operation);
-    }
-    if (flags.test(RealFlag::DivideByZero)) {
-      if (std::strcmp(operation, "division") == 0) {
-        context.messages().Say(warning, "division by zero"_warn_en_US);
-      } else {
-        context.messages().Say(
-            warning, "division by zero on %s"_warn_en_US, operation);
-      }
-    }
-    if (flags.test(RealFlag::InvalidArgument)) {
-      context.messages().Say(
-          warning, "invalid argument on %s"_warn_en_US, operation);
-    }
-    if (flags.test(RealFlag::Underflow)) {
-      context.messages().Say(warning, "underflow on %s"_warn_en_US, operation);
+  if (flags.test(RealFlag::Overflow)) {
+    context.Warn(warning, "overflow on %s"_warn_en_US, operation);
+  }
+  if (flags.test(RealFlag::DivideByZero)) {
+    if (std::strcmp(operation, "division") == 0) {
+      context.Warn(warning, "division by zero"_warn_en_US);
+    } else {
+      context.Warn(warning, "division by zero on %s"_warn_en_US, operation);
     }
   }
+  if (flags.test(RealFlag::InvalidArgument)) {
+    context.Warn(warning, "invalid argument on %s"_warn_en_US, operation);
+  }
+  if (flags.test(RealFlag::Underflow)) {
+    context.Warn(warning, "underflow on %s"_warn_en_US, operation);
+  }
 }
 
 ConstantSubscript &FoldingContext::StartImpliedDo(

flang/lib/Evaluate/fold-character.cpp

@@ -58,13 +58,10 @@ 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))) {
-            if (context.languageFeatures().ShouldWarn(
-                    common::UsageWarning::FoldingValueChecks)) {
-              context.messages().Say(common::UsageWarning::FoldingValueChecks,
-                  "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US,
-                  parser::ToUpperCaseLetters(name),
-                  static_cast<std::intmax_t>(i.ToInt64()), KIND);
-            }
+            context.Warn(common::UsageWarning::FoldingValueChecks,
+                "%s(I=%jd) is out of range for CHARACTER(KIND=%d)"_warn_en_US,
+                parser::ToUpperCaseLetters(name),
+                static_cast<std::intmax_t>(i.ToInt64()), KIND);
           }
           return CharacterUtils<KIND>::CHAR(i.ToUInt64());
         }));
@@ -106,12 +103,9 @@ 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
-        if (context.languageFeatures().ShouldWarn(
-                common::UsageWarning::FoldingLimit)) {
-          context.messages().Say(common::UsageWarning::FoldingLimit,
-              "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US,
-              static_cast<double>(n) * str.size());
-        }
+        context.Warn(common::UsageWarning::FoldingLimit,
+            "Result of REPEAT() is too large to compute at compilation time (%g characters)"_port_en_US,
+            static_cast<double>(n) * str.size());
       } else {
         return Expr<T>{Constant<T>{CharacterUtils<KIND>::REPEAT(str, n)}};
       }

flang/lib/Evaluate/fold-complex.cpp

@@ -29,9 +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 if (context.languageFeatures().ShouldWarn(
-                   common::UsageWarning::FoldingFailure)) {
-      context.messages().Say(common::UsageWarning::FoldingFailure,
+    } else {
+      context.Warn(common::UsageWarning::FoldingFailure,
           "%s(complex(kind=%d)) cannot be folded on host"_warn_en_US, name,
           KIND);
     }