[flang] Finer control over warnings

Establish a set of optional usage warnings, and enable some
only in "-pedantic" mode that, in our subjective experience
with application codes, seem to issue frequently without
indicating usage that really needs to be corrected.  By default,
with this patch the compiler should appear to be somewhat less
persnickety but not less informative.

Differential Revision: https://reviews.llvm.org/D150710

31 files changed, 235 insertions, 190 deletions

diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 390a97185923..987e56200ae6 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -16,6 +16,7 @@
 
 namespace Fortran::common {
 
+// Non-conforming extensions & legacies
 ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations,
     XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions,
@@ -34,9 +35,17 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
     ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
-    SaveMainProgram, SaveBigMainProgramVariables)
+    SaveMainProgram, SaveBigMainProgramVariables,
+    DistinctArrayConstructorLengths)
+
+// Portability and suspicious usage warnings for conforming code
+ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
+    NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
+    ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
+    PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
+using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
 
 class LanguageFeatureControl {
 public:
@@ -58,13 +67,22 @@ public:
   }
   LanguageFeatureControl(const LanguageFeatureControl &) = default;
   void Enable(LanguageFeature f, bool yes = true) { disable_.set(f, !yes); }
-  void EnableWarning(LanguageFeature f, bool yes = true) { warn_.set(f, yes); }
-  void WarnOnAllNonstandard(bool yes = true) { warnAll_ = yes; }
+  void EnableWarning(LanguageFeature f, bool yes = true) {
+    warnLanguage_.set(f, yes);
+  }
+  void EnableWarning(UsageWarning w, bool yes = true) {
+    warnUsage_.set(w, yes);
+  }
+  void WarnOnAllNonstandard(bool yes = true) { warnAllLanguage_ = yes; }
+  void WarnOnAllUsage(bool yes = true) { warnAllUsage_ = yes; }
   bool IsEnabled(LanguageFeature f) const { return !disable_.test(f); }
   bool ShouldWarn(LanguageFeature f) const {
-    return (warnAll_ && f != LanguageFeature::OpenMP &&
+    return (warnAllLanguage_ && f != LanguageFeature::OpenMP &&
                f != LanguageFeature::OpenACC) ||
-        warn_.test(f);
+        warnLanguage_.test(f);
+  }
+  bool ShouldWarn(UsageWarning w) const {
+    return warnAllUsage_ || warnUsage_.test(w);
   }
   // Return all spellings of operators names, depending on features enabled
   std::vector<const char *> GetNames(LogicalOperator) const;
@@ -72,8 +90,10 @@ public:
 
 private:
   LanguageFeatures disable_;
-  LanguageFeatures warn_;
-  bool warnAll_{false};
+  LanguageFeatures warnLanguage_;
+  bool warnAllLanguage_{false};
+  UsageWarnings warnUsage_;
+  bool warnAllUsage_{false};
 };
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_FEATURES_H_
diff --git a/flang/include/flang/Frontend/CompilerInvocation.h b/flang/include/flang/Frontend/CompilerInvocation.h
index 58479c841851..b3ea098ede57 100644
--- a/flang/include/flang/Frontend/CompilerInvocation.h
+++ b/flang/include/flang/Frontend/CompilerInvocation.h
@@ -106,6 +106,7 @@ class CompilerInvocation : public CompilerInvocationBase {
   Fortran::common::IntrinsicTypeDefaultKinds defaultKinds;
 
   bool enableConformanceChecks = false;
+  bool enableUsageChecks = false;
 
   /// Used in e.g. unparsing to dump the analyzed rather than the original
   /// parse-tree objects.
@@ -184,6 +185,9 @@ public:
     return enableConformanceChecks;
   }
 
+  bool &getEnableUsageChecks() { return enableUsageChecks; }
+  const bool &getEnableUsageChecks() const { return enableUsageChecks; }
+
   Fortran::parser::AnalyzedObjectsAsFortran &getAsFortran() {
     return asFortran;
   }
@@ -209,6 +213,9 @@ public:
   // Enables the std=f2018 conformance check
   void setEnableConformanceChecks() { enableConformanceChecks = true; }
 
+  // Enables the usage checks
+  void setEnableUsageChecks() { enableUsageChecks = true; }
+
   /// Useful setters
   void setModuleDir(std::string &dir) { moduleDir = dir; }
 
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 1c4654f6438b..569147cfa753 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -81,8 +81,8 @@ public:
   bool IsEnabled(common::LanguageFeature feature) const {
     return languageFeatures_.IsEnabled(feature);
   }
-  bool ShouldWarn(common::LanguageFeature feature) const {
-    return languageFeatures_.ShouldWarn(feature);
+  template <typename A> bool ShouldWarn(A x) const {
+    return languageFeatures_.ShouldWarn(x);
   }
   const std::optional<parser::CharBlock> &location() const { return location_; }
   const std::vector<std::string> &searchDirectories() const {
@@ -93,7 +93,6 @@ public:
   }
   const std::string &moduleDirectory() const { return moduleDirectory_; }
   const std::string &moduleFileSuffix() const { return moduleFileSuffix_; }
-  bool warnOnNonstandardUsage() const { return warnOnNonstandardUsage_; }
   bool warningsAreErrors() const { return warningsAreErrors_; }
   bool debugModuleWriter() const { return debugModuleWriter_; }
   const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 6672777f3437..84478f26b4b8 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -774,8 +774,9 @@ static bool parseDialectArgs(CompilerInvocation &res, llvm::opt::ArgList &args,
   // -pedantic
   if (args.hasArg(clang::driver::options::OPT_pedantic)) {
     res.setEnableConformanceChecks();
+    res.setEnableUsageChecks();
   }
-  // -std=f2018 (currently this implies -pedantic)
+  // -std=f2018
   // TODO: Set proper options when more fortran standards
   // are supported.
   if (args.hasArg(clang::driver::options::OPT_std_EQ)) {
@@ -1045,9 +1046,11 @@ void CompilerInvocation::setFortranOpts() {
   if (frontendOptions.needProvenanceRangeToCharBlockMappings)
     fortranOptions.needProvenanceRangeToCharBlockMappings = true;
 
-  if (getEnableConformanceChecks()) {
+  if (getEnableConformanceChecks())
     fortranOptions.features.WarnOnAllNonstandard();
-  }
+
+  if (getEnableUsageChecks())
+    fortranOptions.features.WarnOnAllUsage();
 }
 
 void CompilerInvocation::setSemanticsOpts(
@@ -1060,7 +1063,6 @@ void CompilerInvocation::setSemanticsOpts(
   semanticsContext->set_moduleDirectory(getModuleDir())
       .set_searchDirectories(fortranOptions.searchDirectories)
       .set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
-      .set_warnOnNonstandardUsage(getEnableConformanceChecks())
       .set_warningsAreErrors(getWarnAsErr())
       .set_moduleFileSuffix(getModuleFileSuffix());
 
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 26d539ace479..ef53e25bd1c5 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -90,8 +90,7 @@ void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
     parser::CharBlock at{context_.location().value()};
     auto restorer{foldingContext().messages().SetLocation(at)};
-    CheckPointerAssignment(
-        foldingContext(), *assignment, context_.FindScope(at));
+    CheckPointerAssignment(context_, *assignment, context_.FindScope(at));
   }
 }
 
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 2d1c16724906..4d6eb30b3e11 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -104,16 +104,17 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
 // the usage conforms to the standard and no warning is needed.
 static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
     const characteristics::DummyDataObject &dummy,
-    characteristics::TypeAndShape &actualType,
-    evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
+    characteristics::TypeAndShape &actualType, SemanticsContext &context,
+    parser::ContextualMessages &messages) {
   if (dummy.type.type().category() == TypeCategory::Character &&
       actualType.type().category() == TypeCategory::Character &&
       dummy.type.type().kind() == actualType.type().kind()) {
     if (dummy.type.LEN() && actualType.LEN()) {
+      evaluate::FoldingContext &foldingContext{context.foldingContext()};
       auto dummyLength{
-          ToInt64(Fold(context, common::Clone(*dummy.type.LEN())))};
+          ToInt64(Fold(foldingContext, common::Clone(*dummy.type.LEN())))};
       auto actualLength{
-          ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
+          ToInt64(Fold(foldingContext, common::Clone(*actualType.LEN())))};
       if (dummyLength && actualLength && *actualLength != *dummyLength) {
         if (dummy.attrs.test(
                 characteristics::DummyDataObject::Attr::Allocatable) ||
@@ -126,7 +127,8 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
           messages.Say(
               "Actual argument variable length '%jd' does not match the expected length '%jd'"_err_en_US,
               *actualLength, *dummyLength);
-        } else if (*actualLength < *dummyLength) {
+        } else if (*actualLength < *dummyLength &&
+            context.ShouldWarn(common::UsageWarning::ShortCharacterActual)) {
           if (evaluate::IsVariable(actual)) {
             messages.Say(
                 "Actual argument variable length '%jd' is less than expected length '%jd'"_warn_en_US,
@@ -188,12 +190,12 @@ static bool DefersSameTypeParameters(
 static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
     characteristics::TypeAndShape &actualType, bool isElemental,
-    evaluate::FoldingContext &context, const Scope *scope,
-    const evaluate::SpecificIntrinsic *intrinsic,
+    SemanticsContext &context, evaluate::FoldingContext &foldingContext,
+    const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
     bool allowActualArgumentConversions) {
 
   // Basic type & rank checking
-  parser::ContextualMessages &messages{context.messages()};
+  parser::ContextualMessages &messages{foldingContext.messages()};
   CheckCharacterActual(actual, dummy, actualType, context, messages);
   bool dummyIsAllocatable{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
@@ -215,8 +217,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (!typesCompatible && dummy.type.Rank() == 0 &&
       allowActualArgumentConversions) {
     // Extension: pass Hollerith literal to scalar as if it had been BOZ
-    if (auto converted{
-            evaluate::HollerithToBOZ(context, actual, dummy.type.type())}) {
+    if (auto converted{evaluate::HollerithToBOZ(
+            foldingContext, actual, dummy.type.type())}) {
       messages.Say(
           "passing Hollerith or character literal as if it were BOZ"_port_en_US);
       actual = *converted;
@@ -355,7 +357,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
           ? actualLastSymbol->detailsIf<ObjectEntityDetails>()
           : nullptr};
   int actualRank{evaluate::GetRank(actualType.shape())};
-  bool actualIsPointer{evaluate::IsObjectPointer(actual, context)};
+  bool actualIsPointer{evaluate::IsObjectPointer(actual, foldingContext)};
   bool dummyIsAssumedRank{dummy.type.attrs().test(
       characteristics::TypeAndShape::Attr::AssumedRank)};
   if (dummy.type.attrs().test(
@@ -449,14 +451,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   // llvm-project issue #58973: constant actual argument passed in where dummy
   // argument is marked volatile
   bool actualIsVariable{evaluate::IsVariable(actual)};
-  if (dummyIsVolatile && !actualIsVariable) {
+  if (dummyIsVolatile && !actualIsVariable &&
+      context.ShouldWarn(common::UsageWarning::ExprPassedToVolatile)) {
     messages.Say(
         "actual argument associated with VOLATILE %s is not a variable"_warn_en_US,
         dummyName);
   }
 
   // Cases when temporaries might be needed but must not be permitted.
-  bool actualIsContiguous{IsSimplyContiguous(actual, context)};
+  bool actualIsContiguous{IsSimplyContiguous(actual, foldingContext)};
   bool dummyIsAssumedShape{dummy.type.attrs().test(
       characteristics::TypeAndShape::Attr::AssumedShape)};
   bool dummyIsContiguous{
@@ -602,7 +605,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   }
 
   // Warn about dubious actual argument association with a TARGET dummy argument
-  if (dummy.attrs.test(characteristics::DummyDataObject::Attr::Target)) {
+  if (dummy.attrs.test(characteristics::DummyDataObject::Attr::Target) &&
+      context.ShouldWarn(common::UsageWarning::NonTargetPassedToTarget)) {
     bool actualIsTemp{!actualIsVariable || HasVectorSubscript(actual) ||
         evaluate::ExtractCoarrayRef(actual)};
     if (actualIsTemp) {
@@ -623,8 +627,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
 static void CheckProcedureArg(evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc,
     const characteristics::DummyProcedure &dummy, const std::string &dummyName,
-    evaluate::FoldingContext &context) {
-  parser::ContextualMessages &messages{context.messages()};
+    SemanticsContext &context) {
+  evaluate::FoldingContext &foldingContext{context.foldingContext()};
+  parser::ContextualMessages &messages{foldingContext.messages()};
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   const characteristics::Procedure &interface { dummy.procedure.value() };
@@ -651,7 +656,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
       }
     }
     if (auto argChars{characteristics::DummyArgument::FromActual(
-            "actual argument", *expr, context)}) {
+            "actual argument", *expr, foldingContext)}) {
       if (!argChars->IsTypelessIntrinsicDummy()) {
         if (auto *argProc{
                 std::get_if<characteristics::DummyProcedure>(&argChars->u)}) {
@@ -687,11 +692,10 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
                 messages.Say(
                     "Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
                     dummyName);
-              } else {
+              } else if (context.ShouldWarn(
+                             common::UsageWarning::ImplicitInterfaceActual)) {
                 messages.Say(
-                    "Actual procedure argument has an implicit interface "
-                    "which is not known to be compatible with %s which has an "
-                    "explicit interface"_warn_en_US,
+                    "Actual procedure argument has an implicit interface which is not known to be compatible with %s which has an explicit interface"_warn_en_US,
                     dummyName);
               }
             }
@@ -775,10 +779,11 @@ static void ConvertBOZLiteralArg(
 
 static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
     const characteristics::DummyArgument &dummy,
-    const characteristics::Procedure &proc, evaluate::FoldingContext &context,
+    const characteristics::Procedure &proc, SemanticsContext &context,
     const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
     bool allowActualArgumentConversions) {
-  auto &messages{context.messages()};
+  evaluate::FoldingContext &foldingContext{context.foldingContext()};
+  auto &messages{foldingContext.messages()};
   std::string dummyName{"dummy argument"};
   if (!dummy.name.empty()) {
     dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
@@ -802,12 +807,12 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
               ConvertBOZLiteralArg(arg, object.type.type());
               if (auto *expr{arg.UnwrapExpr()}) {
                 if (auto type{characteristics::TypeAndShape::Characterize(
-                        *expr, context)}) {
+                        *expr, foldingContext)}) {
                   arg.set_dummyIntent(object.intent);
                   bool isElemental{
                       object.type.Rank() == 0 && proc.IsElemental()};
                   CheckExplicitDataArg(object, dummyName, *expr, *type,
-                      isElemental, context, scope, intrinsic,
+                      isElemental, context, foldingContext, scope, intrinsic,
                       allowActualArgumentConversions);
                 } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                     IsBOZLiteral(*expr)) {
@@ -1118,16 +1123,19 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
 }
 
 // TRANSFER (16.9.193)
-static void CheckTransferOperandType(parser::ContextualMessages &messages,
+static void CheckTransferOperandType(SemanticsContext &context,
     const evaluate::DynamicType &type, const char *which) {
-  if (type.IsPolymorphic()) {
-    messages.Say("%s of TRANSFER is polymorphic"_warn_en_US, which);
+  if (type.IsPolymorphic() &&
+      context.ShouldWarn(common::UsageWarning::PolymorphicTransferArg)) {
+    context.foldingContext().messages().Say(
+        "%s of TRANSFER is polymorphic"_warn_en_US, which);
   } else if (!type.IsUnlimitedPolymorphic() &&
-      type.category() == TypeCategory::Derived) {
+      type.category() == TypeCategory::Derived &&
+      context.ShouldWarn(common::UsageWarning::PointerComponentTransferArg)) {
     DirectComponentIterator directs{type.GetDerivedTypeSpec()};
     if (auto bad{std::find_if(directs.begin(), directs.end(), IsDescriptor)};
         bad != directs.end()) {
-      evaluate::SayWithDeclaration(messages, *bad,
+      evaluate::SayWithDeclaration(context.foldingContext().messages(), *bad,
           "%s of TRANSFER contains allocatable or pointer component %s"_warn_en_US,
           which, bad.BuildResultDesignatorName());
     }
@@ -1135,27 +1143,29 @@ static void CheckTransferOperandType(parser::ContextualMessages &messages,
 }
 
 static void CheckTransfer(evaluate::ActualArguments &arguments,
-    evaluate::FoldingContext &context, const Scope *scope) {
+    SemanticsContext &context, const Scope *scope) {
+  evaluate::FoldingContext &foldingContext{context.foldingContext()};
+  parser::ContextualMessages &messages{foldingContext.messages()};
   if (arguments.size() >= 2) {
     if (auto source{characteristics::TypeAndShape::Characterize(
-            arguments[0], context)}) {
-      CheckTransferOperandType(context.messages(), source->type(), "Source");
+            arguments[0], foldingContext)}) {
+      CheckTransferOperandType(context, source->type(), "Source");
       if (auto mold{characteristics::TypeAndShape::Characterize(
-              arguments[1], context)}) {
-        CheckTransferOperandType(context.messages(), mold->type(), "Mold");
+              arguments[1], foldingContext)}) {
+        CheckTransferOperandType(context, mold->type(), "Mold");
         if (mold->Rank() > 0 &&
             evaluate::ToInt64(
-                evaluate::Fold(
-                    context, mold->MeasureElementSizeInBytes(context, false)))
+                evaluate::Fold(foldingContext,
+                    mold->MeasureElementSizeInBytes(foldingContext, false)))
                     .value_or(1) == 0) {
-          if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(
-                  context, source->MeasureSizeInBytes(context)))}) {
+          if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+                  source->MeasureSizeInBytes(foldingContext)))}) {
             if (*sourceSize > 0) {
-              context.messages().Say(
+              messages.Say(
                   "Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
             }
           } else {
-            context.messages().Say(
+            messages.Say(
                 "Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
           }
         }
@@ -1165,11 +1175,13 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
       if (const Symbol *
           whole{UnwrapWholeSymbolOrComponentDataRef(arguments[2])}) {
         if (IsOptional(*whole)) {
-          context.messages().Say(
+          messages.Say(
               "SIZE= argument may not be the optional dummy argument '%s'"_err_en_US,
               whole->name());
-        } else if (IsAllocatableOrPointer(*whole)) {
-          context.messages().Say(
+        } else if (context.ShouldWarn(
+                       common::UsageWarning::TransferSizePresence) &&
+            IsAllocatableOrPointer(*whole)) {
+          messages.Say(
               "SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
         }
       }
@@ -1178,10 +1190,10 @@ static void CheckTransfer(evaluate::ActualArguments &arguments,
 }
 
 static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
-    evaluate::FoldingContext &context, const Scope *scope,
+    SemanticsContext &context, const Scope *scope,
     const evaluate::SpecificIntrinsic &intrinsic) {
   if (intrinsic.name == "associated") {
-    CheckAssociated(arguments, context, scope);
+    CheckAssociated(arguments, context.foldingContext(), scope);
   } else if (intrinsic.name == "transfer") {
     CheckTransfer(arguments, context, scope);
   }
@@ -1189,13 +1201,14 @@ static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
 
 static parser::Messages CheckExplicitInterface(
     const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
-    const evaluate::FoldingContext &context, const Scope *scope,
+    SemanticsContext &context, const Scope *scope,
     const evaluate::SpecificIntrinsic *intrinsic,
     bool allowActualArgumentConversions) {
+  evaluate::FoldingContext &foldingContext{context.foldingContext()};
+  parser::ContextualMessages &messages{foldingContext.messages()};
   parser::Messages buffer;
-  parser::ContextualMessages messages{context.messages().at(), &buffer};
+  auto restorer{messages.SetMessages(buffer)};
   RearrangeArguments(proc, actuals, messages);
-  evaluate::FoldingContext localContext{context, messages};
   if (!buffer.empty()) {
     return buffer;
   }
@@ -1203,8 +1216,8 @@ static parser::Messages CheckExplicitInterface(
   for (auto &actual : actuals) {
     const auto &dummy{proc.dummyArguments.at(index++)};
     if (actual) {
-      CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
-          intrinsic, allowActualArgumentConversions);
+      CheckExplicitInterfaceArg(*actual, dummy, proc, context, scope, intrinsic,
+          allowActualArgumentConversions);
     } else if (!dummy.IsOptional()) {
       if (dummy.name.empty()) {
         messages.Say(
@@ -1220,16 +1233,16 @@ static parser::Messages CheckExplicitInterface(
     }
   }
   if (proc.IsElemental() && !buffer.AnyFatalError()) {
-    CheckElementalConformance(messages, proc, actuals, localContext);
+    CheckElementalConformance(messages, proc, actuals, foldingContext);
   }
   if (intrinsic) {
-    CheckSpecificIntrinsic(actuals, localContext, scope, *intrinsic);
+    CheckSpecificIntrinsic(actuals, context, scope, *intrinsic);
   }
   return buffer;
 }
 
 bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
-    evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
+    evaluate::ActualArguments &actuals, SemanticsContext &context,
     bool allowActualArgumentConversions) {
   return proc.HasExplicitInterface() &&
       !CheckExplicitInterface(proc, actuals, context, nullptr, nullptr,
@@ -1289,18 +1302,19 @@ bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
 }
 
 bool CheckArguments(const characteristics::Procedure &proc,
-    evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
+    evaluate::ActualArguments &actuals, SemanticsContext &context,
     const Scope &scope, bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic) {
   bool explicitInterface{proc.HasExplicitInterface()};
-  parser::ContextualMessages &messages{context.messages()};
+  evaluate::FoldingContext foldingContext{context.foldingContext()};
+  parser::ContextualMessages &messages{foldingContext.messages()};
   if (!explicitInterface || treatingExternalAsImplicit) {
     parser::Messages buffer;
     {
       auto restorer{messages.SetMessages(buffer)};
       for (auto &actual : actuals) {
         if (actual) {
-          CheckImplicitInterfaceArg(*actual, messages, context);
+          CheckImplicitInterfaceArg(*actual, messages, foldingContext);
         }
       }
     }
diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h
index 1d03f81a989f..4275606225eb 100644
--- a/flang/lib/Semantics/check-call.h
+++ b/flang/lib/Semantics/check-call.h
@@ -26,6 +26,7 @@ class FoldingContext;
 
 namespace Fortran::semantics {
 class Scope;
+class SemanticsContext;
 
 // Argument treatingExternalAsImplicit should be true when the called procedure
 // does not actually have an explicit interface at the call site, but
@@ -33,7 +34,7 @@ class Scope;
 // defined at the top level in the same source file.  Returns false if
 // messages were created, true if all is well.
 bool CheckArguments(const evaluate::characteristics::Procedure &,
-    evaluate::ActualArguments &, evaluate::FoldingContext &, const Scope &,
+    evaluate::ActualArguments &, SemanticsContext &, const Scope &,
     bool treatingExternalAsImplicit,
     const evaluate::SpecificIntrinsic *intrinsic);
 
@@ -46,7 +47,7 @@ bool CheckArgumentIsConstantExprInRange(
 
 // Checks actual arguments for the purpose of resolving a generic interface.
 bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
-    evaluate::ActualArguments &, const evaluate::FoldingContext &,
+    evaluate::ActualArguments &, SemanticsContext &,
     bool allowActualArgumentConversions = false);
 } // namespace Fortran::semantics
 #endif
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index be9f49851955..3162af396efc 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -859,7 +859,7 @@ void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
           auto restorer{messages_.SetLocation(symbol.name())};
           context_.set_location(symbol.name());
           CheckInitialTarget(
-              foldingContext_, *designator, *object->init(), DEREF(scope_));
+              context_, *designator, *object->init(), DEREF(scope_));
         }
       }
     } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp
index b90bfd3ff5c6..7f61d2fc148e 100644
--- a/flang/lib/Semantics/check-do-forall.cpp
+++ b/flang/lib/Semantics/check-do-forall.cpp
@@ -467,12 +467,11 @@ private:
   }
 
   void CheckDoControl(const parser::CharBlock &sourceLocation, bool isReal) {
-    const bool warn{context_.warnOnNonstandardUsage() ||
-        context_.ShouldWarn(common::LanguageFeature::RealDoControls)};
-    if (isReal && !warn) {
-      // No messages for the default case
-    } else if (isReal && warn) {
-      context_.Say(sourceLocation, "DO controls should be INTEGER"_port_en_US);
+    if (isReal) {
+      if (context_.ShouldWarn(common::LanguageFeature::RealDoControls)) {
+        context_.Say(
+            sourceLocation, "DO controls should be INTEGER"_port_en_US);
+      }
     } else {
       SayBadDoControl(sourceLocation);
     }
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 1c1b07c422ba..ba3b41a75cad 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -35,7 +35,8 @@ private:
 };
 
 bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
-  if (!msg.isError && !context_.warnOnNonstandardUsage()) {
+  if (!msg.isError &&
+      !context_.ShouldWarn(common::LanguageFeature::AdditionalFormats)) {
     return false;
   }
   parser::MessageFormattedText text{
@@ -904,8 +905,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
   auto upper{Normalize(value)};
   if (specValues.at(specKind).count(upper) == 0) {
     if (specKind == IoSpecKind::Access && upper == "APPEND") {
-      if (context_.languageFeatures().ShouldWarn(
-              common::LanguageFeature::OpenAccessAppend)) {
+      if (context_.ShouldWarn(common::LanguageFeature::OpenAccessAppend)) {
         context_.Say(source,
             "ACCESS='%s' interpreted as POSITION='%s'"_port_en_US, value,
             upper);
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 959c74b62d7c..4fa8adbbc9a2 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -384,7 +384,8 @@ bool DataInitializationCompiler<DSV>::InitElement(
       return true;
     } else if (isProcPointer) {
       if (evaluate::IsProcedure(*expr)) {
-        if (CheckPointerAssignment(context, designator, *expr, DEREF(scope_))) {
+        if (CheckPointerAssignment(
+                exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
           if (lastSymbol->has<ProcEntityDetails>()) {
             GetImage().AddPointer(offsetSymbol.offset(), *expr);
             return true;
@@ -405,7 +406,8 @@ bool DataInitializationCompiler<DSV>::InitElement(
       exprAnalyzer_.Say(
           "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
           expr->AsFortran(), DescribeElement());
-    } else if (CheckInitialTarget(context, designator, *expr, DEREF(scope_))) {
+    } else if (CheckInitialTarget(
+                   exprAnalyzer_.context(), designator, *expr, DEREF(scope_))) {
       GetImage().AddPointer(offsetSymbol.offset(), *expr);
       return true;
     }
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index d30465eef86e..b946409d4783 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1613,7 +1613,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
       values_.Push(std::move(*x));
       if (auto thisLen{ToInt64(xType.LEN())}) {
         if (constantLength_) {
-          if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
+          if (exprAnalyzer_.context().ShouldWarn(
+                  common::LanguageFeature::DistinctArrayConstructorLengths) &&
               *thisLen != *constantLength_) {
             if (!(messageDisplayedSet_ & 1)) {
               exprAnalyzer_.Say(
@@ -1965,7 +1966,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
         }
         if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
           semantics::CheckStructConstructorPointerComponent(
-              GetFoldingContext(), *symbol, *value, innermost);
+              context_, *symbol, *value, innermost);
           result.Add(*symbol, Fold(std::move(*value)));
           continue;
         }
@@ -2395,7 +2396,7 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
           }
         }
         if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
-                GetFoldingContext(), false /* no integer conversions */) &&
+                context_, false /* no integer conversions */) &&
             CheckCompatibleArguments(*procedure, localActuals)) {
           if ((procedure->IsElemental() && elemental) ||
               (!procedure->IsElemental() && nonElemental)) {
@@ -2933,7 +2934,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
       Say(callSite,
           "Assumed-length character function must be defined with a length to be called"_err_en_US);
     }
-    ok &= semantics::CheckArguments(*chars, arguments, GetFoldingContext(),
+    ok &= semantics::CheckArguments(*chars, arguments, context_,
         context_.FindScope(callSite), treatExternalAsImplicit,
         specificIntrinsic);
     if (procSymbol && !IsPureProcedure(*procSymbol)) {
@@ -2953,7 +2954,7 @@ std::optional<characteristics::Procedure> ExpressionAnalyzer::CheckCall(
       // Check a known global definition behind a local interface
       if (auto globalChars{characteristics::Procedure::Characterize(
               *global, context_.foldingContext())}) {
-        semantics::CheckArguments(*globalChars, arguments, GetFoldingContext(),
+        semantics::CheckArguments(*globalChars, arguments, context_,
             context_.FindScope(callSite), true,
             nullptr /*not specific intrinsic*/);
       }
@@ -4058,7 +4059,7 @@ bool ArgumentAnalyzer::OkLogicalIntegerAssignment(
   } else {
     return false;
   }
-  if (context_.context().languageFeatures().ShouldWarn(
+  if (context_.context().ShouldWarn(
           common::LanguageFeature::LogicalIntegerAssignment)) {
     context_.Say(std::move(*msg));
   }
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index de6e78387b27..ba63159cee97 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -40,16 +40,15 @@ using parser::MessageFormattedText;
 
 class PointerAssignmentChecker {
 public:
-  PointerAssignmentChecker(evaluate::FoldingContext &context,
-      const Scope &scope, parser::CharBlock source,
-      const std::string &description)
+  PointerAssignmentChecker(SemanticsContext &context, const Scope &scope,
+      parser::CharBlock source, const std::string &description)
       : context_{context}, scope_{scope}, source_{source}, description_{
                                                                description} {}
   PointerAssignmentChecker(
-      evaluate::FoldingContext &context, const Scope &scope, const Symbol &lhs)
+      SemanticsContext &context, const Scope &scope, const Symbol &lhs)
       : context_{context}, scope_{scope}, source_{lhs.name()},
         description_{"pointer '"s + lhs.name().ToString() + '\''}, lhs_{&lhs} {
-    set_lhsType(TypeAndShape::Characterize(lhs, context));
+    set_lhsType(TypeAndShape::Characterize(lhs, foldingContext_));
     set_isContiguous(lhs.attrs().test(Attr::CONTIGUOUS));
     set_isVolatile(lhs.attrs().test(Attr::VOLATILE));
   }
@@ -77,7 +76,8 @@ private:
   bool LhsOkForUnlimitedPoly() const;
   template <typename... A> parser::Message *Say(A &&...);
 
-  evaluate::FoldingContext &context_;
+  SemanticsContext &context_;
+  evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
   const Scope &scope_;
   const parser::CharBlock source_;
   const std::string description_;
@@ -125,14 +125,14 @@ bool PointerAssignmentChecker::CharacterizeProcedure() {
   if (!characterizedProcedure_) {
     characterizedProcedure_ = true;
     if (lhs_ && IsProcedure(*lhs_)) {
-      procedure_ = Procedure::Characterize(*lhs_, context_);
+      procedure_ = Procedure::Characterize(*lhs_, foldingContext_);
     }
   }
   return procedure_.has_value();
 }
 
 bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
-  if (auto whyNot{WhyNotDefinable(context_.messages().at(), scope_,
+  if (auto whyNot{WhyNotDefinable(foldingContext_.messages().at(), scope_,
           DefinabilityFlags{DefinabilityFlag::PointerDefinition}, lhs)}) {
     if (auto *msg{Say(
             "The left-hand side of a pointer assignment is not definable"_err_en_US)}) {
@@ -190,7 +190,7 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
     } else if (const Symbol * base{GetFirstSymbol(rhs)}) {
       if (const char *why{WhyBaseObjectIsSuspicious(
               base->GetUltimate(), scope_)}) { // C1594(3)
-        evaluate::SayWithDeclaration(context_.messages(), *base,
+        evaluate::SayWithDeclaration(foldingContext_.messages(), *base,
             "A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
             base->name(), why);
         return false;
@@ -198,23 +198,26 @@ bool PointerAssignmentChecker::Check(const SomeExpr &rhs) {
     }
   }
   if (isContiguous_) {
-    if (auto contiguous{evaluate::IsContiguous(rhs, context_)}) {
+    if (auto contiguous{evaluate::IsContiguous(rhs, foldingContext_)}) {
       if (!*contiguous) {
         Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
         return false;
       }
-    } else {
+    } else if (context_.ShouldWarn(
+                   common::UsageWarning::PointerToPossibleNoncontiguous)) {
       Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
     }
   }
   // Warn about undefinable data targets
-  if (auto because{
-          WhyNotDefinable(context_.messages().at(), scope_, {}, rhs)}) {
-    if (auto *msg{
-            Say("Pointer target is not a definable variable"_warn_en_US)}) {
-      msg->Attach(std::move(*because));
+  if (context_.ShouldWarn(common::UsageWarning::PointerToUndefinable)) {
+    if (auto because{WhyNotDefinable(
+            foldingContext_.messages().at(), scope_, {}, rhs)}) {
+      if (auto *msg{
+              Say("Pointer target is not a definable variable"_warn_en_US)}) {
+        msg->Attach(std::move(*because));
+      }
+      return false;
     }
-    return false;
   }
   return true;
 }
@@ -232,7 +235,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
   } else if (const auto *intrinsic{f.proc().GetSpecificIntrinsic()}) {
     funcName = intrinsic->name;
   }
-  auto proc{Procedure::Characterize(f.proc(), context_)};
+  auto proc{Procedure::Characterize(f.proc(), foldingContext_)};
   if (!proc) {
     return false;
   }
@@ -258,7 +261,7 @@ bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
   } else if (lhsType_) {
     const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
     CHECK(frTypeAndShape);
-    if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape,
+    if (!lhsType_->IsCompatibleWith(foldingContext_.messages(), *frTypeAndShape,
             "pointer", "function result",
             isBoundsRemapping_ /*omit shape check*/,
             evaluate::CheckConformanceFlags::BothDeferredShape)) {
@@ -290,7 +293,7 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
   } else if (!evaluate::GetLastTarget(GetSymbolVector(d))) { // C1025
     msg = "In assignment to object %s, the target '%s' is not an object with"
           " POINTER or TARGET attributes"_err_en_US;
-  } else if (auto rhsType{TypeAndShape::Characterize(d, context_)}) {
+  } else if (auto rhsType{TypeAndShape::Characterize(d, foldingContext_)}) {
     if (!lhsType_) {
       msg = "%s associated with object '%s' with incompatible type or"
             " shape"_err_en_US;
@@ -361,18 +364,19 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
     if (const auto *subp{
             symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
       if (subp->stmtFunction()) {
-        evaluate::SayWithDeclaration(context_.messages(), *symbol,
+        evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
             "Statement function '%s' may not be the target of a pointer assignment"_err_en_US,
             symbol->name());
         return false;
       }
-    } else if (symbol->has<ProcBindingDetails>()) {
-      evaluate::SayWithDeclaration(context_.messages(), *symbol,
+    } else if (symbol->has<ProcBindingDetails>() &&
+        context_.ShouldWarn(common::UsageWarning::Portability)) {
+      evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
           "Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
           symbol->name());
     }
   }
-  if (auto chars{Procedure::Characterize(d, context_)}) {
+  if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
     return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
   } else {
     return Check(d.GetName(), false);
@@ -380,7 +384,7 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
 }
 
 bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
-  if (auto chars{Procedure::Characterize(ref, context_)}) {
+  if (auto chars{Procedure::Characterize(ref, foldingContext_)}) {
     if (chars->functionResult) {
       if (const auto *proc{chars->functionResult->IsProcedurePointer()}) {
         return Check(ref.proc().GetName(), true, proc);
@@ -407,7 +411,7 @@ bool PointerAssignmentChecker::LhsOkForUnlimitedPoly() const {
 
 template <typename... A>
 parser::Message *PointerAssignmentChecker::Say(A &&...x) {
-  auto *msg{context_.messages().Say(std::forward<A>(x)...)};
+  auto *msg{foldingContext_.messages().Say(std::forward<A>(x)...)};
   if (msg) {
     if (lhs_) {
       return evaluate::AttachDeclaration(msg, *lhs_);
@@ -477,15 +481,14 @@ static bool CheckPointerBounds(
   return isBoundsRemapping;
 }
 
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
+bool CheckPointerAssignment(SemanticsContext &context,
     const evaluate::Assignment &assignment, const Scope &scope) {
   return CheckPointerAssignment(context, assignment.lhs, assignment.rhs, scope,
-      CheckPointerBounds(context, assignment));
+      CheckPointerBounds(context.foldingContext(), assignment));
 }
 
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
-    const SomeExpr &lhs, const SomeExpr &rhs, const Scope &scope,
-    bool isBoundsRemapping) {
+bool CheckPointerAssignment(SemanticsContext &context, const SomeExpr &lhs,
+    const SomeExpr &rhs, const Scope &scope, bool isBoundsRemapping) {
   const Symbol *pointer{GetLastSymbol(lhs)};
   if (!pointer) {
     return false; // error was reported
@@ -497,16 +500,16 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
   return lhsOk && rhsOk; // don't short-circuit
 }
 
-bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &context,
+bool CheckStructConstructorPointerComponent(SemanticsContext &context,
     const Symbol &lhs, const SomeExpr &rhs, const Scope &scope) {
   return PointerAssignmentChecker{context, scope, lhs}
       .set_pointerComponentLHS(&lhs)
       .Check(rhs);
 }
 
-bool CheckPointerAssignment(evaluate::FoldingContext &context,
-    parser::CharBlock source, const std::string &description,
-    const DummyDataObject &lhs, const SomeExpr &rhs, const Scope &scope) {
+bool CheckPointerAssignment(SemanticsContext &context, parser::CharBlock source,
+    const std::string &description, const DummyDataObject &lhs,
+    const SomeExpr &rhs, const Scope &scope) {
   return PointerAssignmentChecker{context, scope, source, description}
       .set_lhsType(common::Clone(lhs.type))
       .set_isContiguous(lhs.attrs.test(DummyDataObject::Attr::Contiguous))
@@ -514,9 +517,10 @@ bool CheckPointerAssignment(evaluate::FoldingContext &context,
       .Check(rhs);
 }
 
-bool CheckInitialTarget(evaluate::FoldingContext &context,
-    const SomeExpr &pointer, const SomeExpr &init, const Scope &scope) {
-  return evaluate::IsInitialDataTarget(init, &context.messages()) &&
+bool CheckInitialTarget(SemanticsContext &context, const SomeExpr &pointer,
+    const SomeExpr &init, const Scope &scope) {
+  return evaluate::IsInitialDataTarget(
+             init, &context.foldingContext().messages()) &&
       CheckPointerAssignment(context, pointer, init, scope);
 }
 
diff --git a/flang/lib/Semantics/pointer-assignment.h b/flang/lib/Semantics/pointer-assignment.h
index 95ed67d1de5a..c6f89c494914 100644
--- a/flang/lib/Semantics/pointer-assignment.h
+++ b/flang/lib/Semantics/pointer-assignment.h
@@ -18,28 +18,25 @@ namespace Fortran::evaluate::characteristics {
 struct DummyDataObject;
 }
 
-namespace Fortran::evaluate {
-class FoldingContext;
-}
-
 namespace Fortran::semantics {
 
+class SemanticsContext;
 class Symbol;
 
 bool CheckPointerAssignment(
-    evaluate::FoldingContext &, const evaluate::Assignment &, const Scope &);
-bool CheckPointerAssignment(evaluate::FoldingContext &, const SomeExpr &lhs,
+    SemanticsContext &, const evaluate::Assignment &, const Scope &);
+bool CheckPointerAssignment(SemanticsContext &, const SomeExpr &lhs,
     const SomeExpr &rhs, const Scope &, bool isBoundsRemapping = false);
-bool CheckStructConstructorPointerComponent(evaluate::FoldingContext &,
-    const Symbol &lhs, const SomeExpr &rhs, const Scope &);
-bool CheckPointerAssignment(evaluate::FoldingContext &,
-    parser::CharBlock source, const std::string &description,
+bool CheckStructConstructorPointerComponent(
+    SemanticsContext &, const Symbol &lhs, const SomeExpr &rhs, const Scope &);
+bool CheckPointerAssignment(SemanticsContext &, parser::CharBlock source,
+    const std::string &description,
     const evaluate::characteristics::DummyDataObject &, const SomeExpr &rhs,
     const Scope &);
 
 // Checks whether an expression is a valid static initializer for a
 // particular pointer designator.
-bool CheckInitialTarget(evaluate::FoldingContext &, const SomeExpr &pointer,
+bool CheckInitialTarget(SemanticsContext &, const SomeExpr &pointer,
     const SomeExpr &init, const Scope &);
 
 } // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-labels.cpp b/flang/lib/Semantics/resolve-labels.cpp
index 3a2dd61cab05..f849b2238b08 100644
--- a/flang/lib/Semantics/resolve-labels.cpp
+++ b/flang/lib/Semantics/resolve-labels.cpp
@@ -961,8 +961,7 @@ void CheckLabelDoConstraints(const SourceStmtList &dos,
                        TargetStatementEnum::CompatibleDo)) ||
         (doTarget.isExecutableConstructEndStmt &&
             ParentScope(scopes, doTarget.proxyForScope) == scope)) {
-      if (context.warnOnNonstandardUsage() ||
-          context.ShouldWarn(
+      if (context.ShouldWarn(
               common::LanguageFeature::OldLabelDoEndStatements)) {
         context
             .Say(position,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 321f819e6b73..be9c130ca7e5 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2455,8 +2455,7 @@ bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
     return false;
   }
   // TODO: check no INTENT(OUT) if dummy?
-  if (context().languageFeatures().ShouldWarn(
-          common::LanguageFeature::ForwardRefImplicitNone)) {
+  if (context().ShouldWarn(common::LanguageFeature::ForwardRefImplicitNone)) {
     Say(symbol.name(),
         "'%s' was used without (or before) being explicitly typed"_warn_en_US,
         symbol.name());
@@ -3535,7 +3534,7 @@ 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' "
+        "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);
@@ -4915,16 +4914,14 @@ bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
     derivedTypeInfo_.privateBindings = true;
   } else if (!derivedTypeInfo_.privateComps) {
     derivedTypeInfo_.privateComps = true;
-  } else {
-    Say("PRIVATE may not appear more than once in"
-        " derived type components"_warn_en_US); // C738
+  } else { // C738
+    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) {
-    Say("SEQUENCE may not appear more than once in"
-        " derived type components"_warn_en_US); // C738
+  if (derivedTypeInfo_.sequence) { // C738
+    Say("SEQUENCE should not appear more than once in derived type components"_warn_en_US);
   }
   derivedTypeInfo_.sequence = true;
   return false;
diff --git a/flang/test/Semantics/assign09.f90 b/flang/test/Semantics/assign09.f90
index d8104b1dd60b..d3c72f355dd8 100644
--- a/flang/test/Semantics/assign09.f90
+++ b/flang/test/Semantics/assign09.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Procedure pointer assignments and argument association with intrinsic functions
 program test
   abstract interface
diff --git a/flang/test/Semantics/associate01.f90 b/flang/test/Semantics/associate01.f90
index 8916a3bab322..6f8e52077990 100644
--- a/flang/test/Semantics/associate01.f90
+++ b/flang/test/Semantics/associate01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Tests of selectors whose defining expressions are pointer-valued functions;
 ! they must be valid targets, but not pointers.
 ! (F'2018 11.1.3.3 p1) "The associating entity does not have the ALLOCATABLE or
diff --git a/flang/test/Semantics/bindings03.f90 b/flang/test/Semantics/bindings03.f90
index 84227348e203..baa8432a2701 100644
--- a/flang/test/Semantics/bindings03.f90
+++ b/flang/test/Semantics/bindings03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -pedantic
 ! Confirm a portability warning on use of a procedure binding apart from a call
 module m
   type t
diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90
index 7a860062262a..c31f2cc3eb8d 100644
--- a/flang/test/Semantics/call03.f90
+++ b/flang/test/Semantics/call03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Test 15.5.2.4 constraints and restrictions for non-POINTER non-ALLOCATABLE
 ! dummy arguments.
 
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index 08465a965e6a..71229875262b 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Test 15.5.2.7 constraints and restrictions for POINTER dummy arguments.
 
 module m
diff --git a/flang/test/Semantics/call21.f90 b/flang/test/Semantics/call21.f90
index 4877551b58f6..64b733288fdc 100644
--- a/flang/test/Semantics/call21.f90
+++ b/flang/test/Semantics/call21.f90
@@ -1,4 +1,4 @@
-! RUN: %flang -fsyntax-only 2>&1 %s | FileCheck %s
+! RUN: %flang -fsyntax-only -pedantic 2>&1 %s | FileCheck %s
 ! Verifies that warnings issue when actual arguments with implicit
 ! interfaces are associated with dummy procedures and dummy procedure
 ! pointers whose interfaces are explicit.
diff --git a/flang/test/Semantics/call30.f90 b/flang/test/Semantics/call30.f90
index f6725cdafcd1..3653c29faeeb 100644
--- a/flang/test/Semantics/call30.f90
+++ b/flang/test/Semantics/call30.f90
@@ -1,5 +1,5 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
-! This test is responsible for checking the fix for passing non-variables as 
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror -pedantic
+! This test is responsible for checking the fix for passing non-variables as
 ! actual arguments to subroutines/functions whose corresponding dummy argument
 ! expects a VOLATILE variable
 ! c.f. llvm-project GitHub issue #58973
@@ -25,36 +25,33 @@ module m
   subroutine test_all_subprograms()
     !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
     call vol_dum_int(6)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
     call vol_dum_int(6+12)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
     call vol_dum_int(6*12)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int=' is not a variable
     call vol_dum_int(-6/2)
-
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
     call vol_dum_real(3.141592653)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
-    call vol_dum_real(3.141592653 + -10.6e-11)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+    call vol_dum_real(3.141592653 + (-10.6e-11))
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
     call vol_dum_real(3.141592653 * 10.6e-11)
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
-    call vol_dum_real(3.141592653 / -10.6e-11)
-
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_real=' is not a variable
+    call vol_dum_real(3.141592653 / (-10.6e-11))
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
     call vol_dum_complex((1., 3.2))
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
     call vol_dum_complex((1., 3.2) + (-2., 3.14))
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
     call vol_dum_complex((1., 3.2) * (-2., 3.14))
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_complex=' is not a variable
     call vol_dum_complex((1., 3.2) / (-2., 3.14))
-
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
     call vol_dum_int_arr((/ 1, 2, 3, 4 /))
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
     call vol_dum_int_arr(reshape((/ 1, 2, 3, 4 /), (/ 2, 2/)))
-		!WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
-  	call vol_dum_int_arr((/ 1, 2, 3, 4 /))
+    !WARNING: actual argument associated with VOLATILE dummy argument 'my_int_arr=' is not a variable
+    call vol_dum_int_arr((/ 1, 2, 3, 4 /))
   end subroutine test_all_subprograms
 end module m
diff --git a/flang/test/Semantics/call33.f90 b/flang/test/Semantics/call33.f90
index 92051afc216c..2fc017f1e444 100644
--- a/flang/test/Semantics/call33.f90
+++ b/flang/test/Semantics/call33.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 module m
  contains
   subroutine s1(x)
diff --git a/flang/test/Semantics/call34.f90 b/flang/test/Semantics/call34.f90
index 4f939f2425d1..325a267309d4 100644
--- a/flang/test/Semantics/call34.f90
+++ b/flang/test/Semantics/call34.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
 module m
  contains
   subroutine foo(a)
diff --git a/flang/test/Semantics/resolve31.f90 b/flang/test/Semantics/resolve31.f90
index 5f41cbfd5111..0c604c0ee973 100644
--- a/flang/test/Semantics/resolve31.f90
+++ b/flang/test/Semantics/resolve31.f90
@@ -49,9 +49,9 @@ module m4
   type :: t1
     private
     sequence
-    !WARNING: PRIVATE may not appear more than once in derived type components
+    !WARNING: PRIVATE should not appear more than once in derived type components
     private
-    !WARNING: SEQUENCE may not appear more than once in derived type components
+    !WARNING: SEQUENCE should not appear more than once in derived type components
     sequence
     real :: t1Field
   end type
diff --git a/flang/test/Semantics/resolve59.f90 b/flang/test/Semantics/resolve59.f90
index a79c4a462067..7458710c52d9 100644
--- a/flang/test/Semantics/resolve59.f90
+++ b/flang/test/Semantics/resolve59.f90
@@ -59,10 +59,10 @@ contains
     x = acos(f5)
   end function
   ! Sanity test: f18 handles C1560 violation by ignoring RESULT
-  !WARNING: The function name should not appear in RESULT, references to 'f6' inside the function will be considered as references to the result only
+  !WARNING: The function name should not appear in RESULT; references to 'f6' inside the function will be considered as references to the result only
   function f6() result(f6)
   end function
-  !WARNING: The function name should not appear in RESULT, references to 'f7' inside the function will be considered as references to the result only
+  !WARNING: The function name should not appear in RESULT; references to 'f7' inside the function will be considered as references to the result only
   function f7() result(f7)
     real :: x, f7
     !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
diff --git a/flang/test/Semantics/structconst03.f90 b/flang/test/Semantics/structconst03.f90
index f2e659fb8974..7940ada94466 100644
--- a/flang/test/Semantics/structconst03.f90
+++ b/flang/test/Semantics/structconst03.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Error tests for structure constructors: C1594 violations
 ! from assigning globally-visible data to POINTER components.
 ! test/Semantics/structconst04.f90 is this same test without type
diff --git a/flang/test/Semantics/structconst04.f90 b/flang/test/Semantics/structconst04.f90
index 728d2772039b..f19852b95a60 100644
--- a/flang/test/Semantics/structconst04.f90
+++ b/flang/test/Semantics/structconst04.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Error tests for structure constructors: C1594 violations
 ! from assigning globally-visible data to POINTER components.
 ! This test is structconst03.f90 with the type parameters removed.
diff --git a/flang/test/Semantics/transfer01.f90 b/flang/test/Semantics/transfer01.f90
index 6cd8288e225c..26f4f1b3eb62 100644
--- a/flang/test/Semantics/transfer01.f90
+++ b/flang/test/Semantics/transfer01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Check errors in TRANSFER()
 
 subroutine subr(o)
diff --git a/flang/tools/f18-parse-demo/f18-parse-demo.cpp b/flang/tools/f18-parse-demo/f18-parse-demo.cpp
index ae0a3c4fb987..afaa18b018f1 100644
--- a/flang/tools/f18-parse-demo/f18-parse-demo.cpp
+++ b/flang/tools/f18-parse-demo/f18-parse-demo.cpp
@@ -85,6 +85,7 @@ struct DriverOptions {
   std::vector<std::string> searchDirectories{"."s}; // -I dir
   bool forcedForm{false}; // -Mfixed or -Mfree appeared
   bool warnOnNonstandardUsage{false}; // -Mstandard
+  bool warnOnSuspiciousUsage{false}; // -pedantic
   bool warningsAreErrors{false}; // -Werror
   Fortran::parser::Encoding encoding{Fortran::parser::Encoding::LATIN_1};
   bool lineDirectives{true}; // -P disables
@@ -352,6 +353,9 @@ int main(int argc, char *const argv[]) {
           Fortran::common::LanguageFeature::BackslashEscapes);
     } else if (arg == "-Mstandard") {
       driver.warnOnNonstandardUsage = true;
+    } else if (arg == "-pedantic") {
+      driver.warnOnNonstandardUsage = true;
+      driver.warnOnSuspiciousUsage = true;
     } else if (arg == "-fopenmp") {
       options.features.Enable(Fortran::common::LanguageFeature::OpenMP);
       options.predefinitions.emplace_back("_OPENMP", "201511");
@@ -444,6 +448,9 @@ int main(int argc, char *const argv[]) {
   if (driver.warnOnNonstandardUsage) {
     options.features.WarnOnAllNonstandard();
   }
+  if (driver.warnOnSuspiciousUsage) {
+    options.features.WarnOnAllUsage();
+  }
   if (!options.features.IsEnabled(
           Fortran::common::LanguageFeature::BackslashEscapes)) {
     driver.fcArgs.push_back("-fno-backslash"); // PGI "-Mbackslash"