[flang] Finer control over warnings

[klausler]

Summary

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.

flang/include/flang/Common/Fortran-features.h

 
 #include "flang/Common/Fortran.h"
 #include "flang/Common/enum-set.h"
 #include "flang/Common/idioms.h"
 #include <vector>
 
 namespace Fortran::common {
 
+// Non-conforming extensions & legacies
 ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations,
     XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions,
     EmptyStatement, AlternativeNE, ExecutionPartNamelist, DECStructures,
     DoubleComplex, Byte, StarKind, ExponentMatchingKindParam, QuadPrecision,
     SlashInitialization, TripletInArrayConstructor, MissingColons,
     SignedComplexLiteral, OldStyleParameter, ComplexConstructor, PercentLOC,
     SignedPrimary, FileName, Carriagecontrol, Convert, Dispose,
     IOListLeadingComma, AbbreviatedEditDescriptor, ProgramParentheses,
     PercentRefAndVal, OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF,
     Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand,
     ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     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:
   LanguageFeatureControl() {
     // These features must be explicitly enabled by command line options.
     disable_.set(LanguageFeature::OldDebugLines);
     disable_.set(LanguageFeature::OpenACC);
     disable_.set(LanguageFeature::OpenMP);
     disable_.set(LanguageFeature::ImplicitNoneTypeNever);
     disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
     disable_.set(LanguageFeature::DefaultSave);
     disable_.set(LanguageFeature::SaveMainProgram);
     // These features, if enabled, conflict with valid standard usage,
     // so there are disabled here by default.
     disable_.set(LanguageFeature::BackslashEscapes);
     disable_.set(LanguageFeature::LogicalAbbreviations);
     disable_.set(LanguageFeature::XOROperator);
     disable_.set(LanguageFeature::OldStyleParameter);
   }
   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;
   std::vector<const char *> GetNames(RelationalOperator) const;
 
 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_

flang/include/flang/Frontend/CompilerInvocation.h

class CompilerInvocation : public CompilerInvocationBase {
   /// plain version that does not include any information from semantic
   /// analysis.
   bool useAnalyzedObjectsForUnparse = true;
 
   // Fortran Dialect options
   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.
   Fortran::parser::AnalyzedObjectsAsFortran asFortran{
       [](llvm::raw_ostream &o, const Fortran::evaluate::GenericExprWrapper &x) {
         if (x.v) {
           x.v->AsFortran(o);
         } else {
const bool &getUseAnalyzedObjectsForUnparse() const {
     return useAnalyzedObjectsForUnparse;
   }
 
   bool &getEnableConformanceChecks() { return enableConformanceChecks; }
   const bool &getEnableConformanceChecks() const {
     return enableConformanceChecks;
   }
 
+  bool &getEnableUsageChecks() { return enableUsageChecks; }
+  const bool &getEnableUsageChecks() const { return enableUsageChecks; }
+
   Fortran::parser::AnalyzedObjectsAsFortran &getAsFortran() {
     return asFortran;
   }
   const Fortran::parser::AnalyzedObjectsAsFortran &getAsFortran() const {
     return asFortran;
   }
 
   Fortran::common::IntrinsicTypeDefaultKinds &getDefaultKinds() {
public:
   /// \param [out] res - The resulting invocation.
   static bool createFromArgs(CompilerInvocation &res,
                              llvm::ArrayRef<const char *> commandLineArgs,
                              clang::DiagnosticsEngine &diags);
 
   // 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; }
 
   void setModuleFileSuffix(const char *suffix) {
     moduleFileSuffix = std::string(suffix);
   }
 
   void setDebugModuleDir(bool flag) { debugModuleDir = flag; }

flang/include/flang/Semantics/semantics.h

public:
   int GetDefaultKind(TypeCategory) const;
   int doublePrecisionKind() const {
     return defaultKinds_.doublePrecisionKind();
   }
   int quadPrecisionKind() const { return defaultKinds_.quadPrecisionKind(); }
   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 {
     return searchDirectories_;
   }
   const std::vector<std::string> &intrinsicModuleDirectories() const {
     return intrinsicModuleDirectories_;
   }
   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_; }
   const evaluate::TargetCharacteristics &targetCharacteristics() const {
     return targetCharacteristics_;
   }
   evaluate::TargetCharacteristics &targetCharacteristics() {
     return targetCharacteristics_;

flang/lib/Frontend/CompilerInvocation.cpp

if (args.hasArg(clang::driver::options::OPT_fopenmp_is_device)) {
           res.getLangOpts().OpenMPTargetDebug = 1;
       }
     }
   }
 
   // -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)) {
     auto standard = args.getLastArgValue(clang::driver::options::OPT_std_EQ);
     // We only allow f2018 as the given standard
     if (standard.equals("f2018")) {
       res.setEnableConformanceChecks();
     } else {
if (frontendOptions.instrumentedParse)
     fortranOptions.instrumentedParse = true;
 
   if (frontendOptions.showColors)
     fortranOptions.showColors = true;
 
   if (frontendOptions.needProvenanceRangeToCharBlockMappings)
     fortranOptions.needProvenanceRangeToCharBlockMappings = true;
 
-  if (getEnableConformanceChecks()) {
+  if (getEnableConformanceChecks())
     fortranOptions.features.WarnOnAllNonstandard();
-  }
+
+  if (getEnableUsageChecks())
+    fortranOptions.features.WarnOnAllUsage();
 }
 
 void CompilerInvocation::setSemanticsOpts(
     Fortran::parser::AllCookedSources &allCookedSources) {
   auto &fortranOptions = getFortranOpts();
 
   semanticsContext = std::make_unique<semantics::SemanticsContext>(
       getDefaultKinds(), fortranOptions.features, allCookedSources);
 
   semanticsContext->set_moduleDirectory(getModuleDir())
       .set_searchDirectories(fortranOptions.searchDirectories)
       .set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
-      .set_warnOnNonstandardUsage(getEnableConformanceChecks())
       .set_warningsAreErrors(getWarnAsErr())
       .set_moduleFileSuffix(getModuleFileSuffix());
 
   llvm::Triple targetTriple{llvm::Triple(this->targetOpts.triple)};
   // FIXME: Handle real(3) ?
   if (targetTriple.getArch() != llvm::Triple::ArchType::x86_64) {
     semanticsContext->targetCharacteristics().DisableType(
         Fortran::common::TypeCategory::Real, /*kind=*/10);

flang/lib/Semantics/assignment.cpp

void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
   }
 }
 
 void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
   CHECK(whereDepth_ == 0);
   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));
   }
 }
 
 static std::optional<std::string> GetPointerComponentDesignatorName(
     const SomeExpr &expr) {
   if (const auto *derived{
           evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) {
     PotentialAndPointerComponentIterator potentials{*derived};

flang/lib/Semantics/check-call.h

 struct Procedure;
 }
 namespace Fortran::evaluate {
 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
 // its characteristics are known because it is a subroutine or function
 // 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);
 
 bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
     const evaluate::ActualArguments &actuals,
     evaluate::FoldingContext &context);
 bool CheckArgumentIsConstantExprInRange(
     const evaluate::ActualArguments &actuals, int index, int lowerBound,
     int upperBound, parser::ContextualMessages &messages);
 
 // 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

flang/lib/Semantics/check-call.cpp

 }
 
 // When a CHARACTER actual argument is known to be short,
 // we extend it on the right with spaces and a warning if
 // possible.  When it is long, and not required to be equal,
 // 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) ||
             dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer) ||
             dummy.type.attrs().test(
                 characteristics::TypeAndShape::Attr::AssumedRank) ||
             dummy.type.attrs().test(
                 characteristics::TypeAndShape::Attr::AssumedShape)) {
           // See 15.5.2.4 paragraph 4., 15.5.2.5.
           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,
                 *actualLength, *dummyLength);
           } else {
             messages.Say(
                 "Actual argument expression length '%jd' is less than expected length '%jd'"_warn_en_US,
                 *actualLength, *dummyLength);
for (const auto &pair : actual.parameters()) {
     }
   }
   return true;
 }
 
 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)};
   bool dummyIsPointer{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
   bool dummyIsAllocatableOrPointer{dummyIsAllocatable || dummyIsPointer};
   allowActualArgumentConversions &= !dummyIsAllocatableOrPointer;
   if (allowActualArgumentConversions) {
     ConvertIntegerActual(actual, dummy.type, actualType, messages);
   }
   bool typesCompatible{
       (dummy.ignoreTKR.test(common::IgnoreTKR::Type) &&
           (dummy.type.type().category() == TypeCategory::Derived ||
               actualType.type().category() == TypeCategory::Derived ||
               dummy.type.type().category() != actualType.type().category())) ||
       (dummy.ignoreTKR.test(common::IgnoreTKR::Kind) &&
           dummy.type.type().category() == actualType.type().category()) ||
       dummy.type.type().IsTkCompatibleWith(actualType.type())};
   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;
       actualType.type() = dummy.type.type();
       typesCompatible = true;
     }
   }
   if (typesCompatible) {
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   const auto *actualLastSymbol{evaluate::GetLastSymbol(actual)};
   if (actualLastSymbol) {
     actualLastSymbol = &ResolveAssociations(*actualLastSymbol);
   }
   const ObjectEntityDetails *actualLastObject{actualLastSymbol
           ? 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(
           characteristics::TypeAndShape::Attr::AssumedShape)) {
     // 15.5.2.4(16)
     if (actualRank == 0) {
       messages.Say(
           "Scalar actual argument may not be associated with assumed-shape %s"_err_en_US,
if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
       }
     }
   }
 
   // technically legal but worth emitting a warning
   // 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{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
   if ((actualIsAsynchronous || actualIsVolatile) &&
       (dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
     if (actualIsCoindexed) { // C1538
       messages.Say(
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   bool actualIsNull{evaluate::IsNullPointer(actual)};
   if (!intrinsic && !dummyIsPointer && !dummyIsOptional && actualIsNull) {
     messages.Say(
         "Actual argument associated with %s may not be null pointer %s"_err_en_US,
         dummyName, actual.AsFortran());
   }
 
   // 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) {
       messages.Say(
           "Any pointer associated with TARGET %s during this call will not be associated with the value of '%s' afterwards"_warn_en_US,
           dummyName, actual.AsFortran());
     } else {
       auto actualSymbolVector{GetSymbolVector(actual)};
       if (!evaluate::GetLastTarget(actualSymbolVector)) {
         messages.Say(
             "Any pointer associated with TARGET %s during this call must not be used afterwards, as '%s' is not a target"_warn_en_US,
             dummyName, actual.AsFortran());
       }
     }
   }
 }
 
 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() };
   if (const auto *expr{arg.UnwrapExpr()}) {
     bool dummyIsPointer{
         dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
     const auto *argProcDesignator{
         std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
if (argProcSymbol) {
         }
       } else if (argProcSymbol->has<ProcBindingDetails>()) {
         evaluate::SayWithDeclaration(messages, *argProcSymbol,
             "Procedure binding '%s' passed as an actual argument"_port_en_US,
             argProcSymbol->name());
       }
     }
     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)}) {
           characteristics::Procedure &argInterface{argProc->procedure.value()};
           argInterface.attrs.reset(
               characteristics::Procedure::Attr::NullPointer);
           if (!argProcSymbol || argProcSymbol->attrs().test(Attr::INTRINSIC)) {
             // It's ok to pass ELEMENTAL unrestricted intrinsic functions.
if (auto argChars{characteristics::DummyArgument::FromActual(
                 messages.Say(
                     "Actual procedure argument has interface incompatible with %s: %s"_err_en_US,
                     dummyName, whyNot);
                 return;
               } else if (proc.IsPure()) {
                 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);
               }
             }
           } else { // 15.5.2.9(2,3)
             if (interface.IsSubroutine() && argInterface.IsFunction()) {
               messages.Say(
                   "Actual argument associated with procedure %s is a function but must be a subroutine"_err_en_US,
                   dummyName);
if (IsBOZLiteral(*expr)) {
         arg = std::move(*converted);
       }
     }
   }
 }
 
 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) + "='";
   }
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   auto checkActualArgForLabel = [&](evaluate::ActualArgument &arg) {
     if (arg.isAlternateReturn()) {
       messages.Say(
           "Alternate return label '%d' cannot be associated with %s"_err_en_US,
           arg.GetLabel(), dummyName);
       return true;
     } else {
       return false;
     }
   };
   common::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &object) {
             if (!checkActualArgForLabel(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)) {
                   // ok
                 } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                     evaluate::IsNullObjectPointer(*expr)) {
                   // ok, ASSOCIATED(NULL())
                 } else if ((object.attrs.test(characteristics::DummyDataObject::
static void CheckAssociated(evaluate::ActualArguments &arguments,
   }
   if (!ok) {
     context.messages().Say(
         "Arguments of ASSOCIATED() must be a POINTER and an optional valid target"_err_en_US);
   }
 }
 
 // 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());
     }
   }
 }
 
 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);
           }
         }
       }
     }
     if (arguments.size() > 2) { // SIZE=
       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);
         }
       }
     }
   }
 }
 
 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);
   }
 }
 
 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;
   }
   int index{0};
   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(
             "Dummy argument #%d is not OPTIONAL and is not associated with "
             "an actual argument in this procedure reference"_err_en_US,
             index);
       } else {
         messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
                      "associated with an actual argument in this procedure "
                      "reference"_err_en_US,
             dummy.name, index);
       }
     }
   }
   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,
           allowActualArgumentConversions)
            .AnyFatalError();
 }
 
 bool CheckArgumentIsConstantExprInRange(
bool CheckPPCIntrinsic(const Symbol &generic, const Symbol &specific,
   if (specific.name() == "__ppc_mtfsfi") {
     return CheckArgumentIsConstantExprInRange(actuals, 0, 0, 7, messages) &&
         CheckArgumentIsConstantExprInRange(actuals, 1, 0, 15, messages);
   }
   return false;
 }
 
 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);
         }
       }
     }
     if (!buffer.empty()) {
       if (auto *msgs{messages.messages()}) {
         msgs->Annex(std::move(buffer));
       }
       return false; // don't pile on

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
   if (IsPointer(symbol) && !context_.HasError(symbol) &&
       !scopeIsUninstantiatedPDT_) {
     if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
       if (object->init()) { // C764, C765; C808
         if (auto designator{evaluate::AsGenericExpr(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>()}) {
       if (proc->init() && *proc->init()) {
         // C1519 - must be nonelemental external or module procedure,
         // or an unrestricted specific intrinsic function.
         const Symbol &ultimate{(*proc->init())->GetUltimate()};
         if (ultimate.attrs().test(Attr::INTRINSIC)) {

flang/lib/Semantics/check-do-forall.cpp

public:
   }
 
 private:
   void SayBadDoControl(parser::CharBlock sourceLocation) {
     context_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
   }
 
   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);
     }
   }
 
   void CheckDoVariable(const parser::ScalarName &scalarName) {
     const parser::CharBlock &sourceLocation{scalarName.thing.source};
     if (const Symbol * symbol{scalarName.thing.symbol}) {

flang/lib/Semantics/check-io.cpp

 
 private:
   SemanticsContext &context_;
   const parser::CharBlock &formatCharBlock_;
   int errorAllowance_; // initialized to maximum number of errors to report
 };
 
 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{
       parser::MessageFixedText{msg.text, strlen(msg.text),
           msg.isError ? parser::Severity::Error : parser::Severity::Warning},
       msg.arg};
   if (formatCharBlock_.size()) {
     // The input format is a folded expression.  Error markers span the full
static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
           {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
       {IoSpecKind::Carriagecontrol, {"LIST", "FORTRAN", "NONE"}},
       {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
       {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
   };
   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);
       }
     } else {
       context_.Say(source, "Invalid %s value '%s'"_err_en_US,
           parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
     }

flang/lib/Semantics/data-to-inits.cpp

if (!expr) {
     if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) >
         symbol.size()) {
       OutOfRangeError();
     } else if (evaluate::IsNullPointer(*expr)) {
       // nothing to do; rely on zero initialization
       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;
           } else {
             evaluate::AttachDeclaration(
                 exprAnalyzer_.context().Say(
                     "DATA statement initialization of procedure pointer '%s' declared using a POINTER statement and an INTERFACE instead of a PROCEDURE statement"_todo_en_US,
                     DescribeElement()),
                 *lastSymbol);
           }
         }
       } else {
         exprAnalyzer_.Say(
             "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
             expr->AsFortran(), DescribeElement());
       }
     } else if (evaluate::IsProcedure(*expr)) {
       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;
     }
   } else if (evaluate::IsNullPointer(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
         DescribeElement());
   } else if (evaluate::IsProcedure(*expr)) {
     exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,

flang/lib/Semantics/expression.cpp

if (!type_) {
     type_ = std::move(xType);
     constantLength_ = ToInt64(type_->length);
     values_.Push(std::move(*x));
   } else if (!explicitType_) {
     if (type_->IsTkCompatibleWith(xType) && xType.IsTkCompatibleWith(*type_)) {
       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(
                   "Character literal in array constructor without explicit "
                   "type has different length than earlier elements"_port_en_US);
               messageDisplayedSet_ |= 1;
             }
           }
if (symbol) {
               symbol->name());
         }
         if (!(symbol->has<semantics::ProcEntityDetails>() ||
                 symbol->has<semantics::ObjectEntityDetails>())) {
           continue; // recovery
         }
         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;
         }
         if (IsNullPointer(*value)) {
           if (IsAllocatable(*symbol)) {
             if (IsBareNullPointer(&*value)) {
               // NULL() with no arguments allowed by 7.5.10 para 6 for
               // ALLOCATABLE.
for (const Symbol &specific : details->specificProcs()) {
                   ProcedureDesignator{specific}, context_.foldingContext())}) {
         ActualArguments localActuals{actuals};
         if (specific.has<semantics::ProcBindingDetails>()) {
           if (!adjustActuals.value()(specific, localActuals)) {
             continue;
           }
         }
         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)) {
             // 16.9.144(6): a bare NULL() is not allowed as an actual
             // argument to a generic procedure if the specific procedure
             // cannot be unambiguously distinguished
             // Underspecified external procedure actual arguments can
             // also lead to ambiguity.
if (chars) {
     const SpecificIntrinsic *specificIntrinsic{proc.GetSpecificIntrinsic()};
     bool procIsDummy{procSymbol && IsDummy(*procSymbol)};
     if (chars->functionResult &&
         chars->functionResult->IsAssumedLengthCharacter() &&
         !specificIntrinsic && !procIsDummy) {
       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)) {
       if (const semantics::Scope *
           pure{semantics::FindPureProcedureContaining(
               context_.FindScope(callSite))}) {
         Say(callSite,
             "Procedure '%s' referenced in pure subprogram '%s' must be pure too"_err_en_US,
             procSymbol->name(), DEREF(pure->symbol()).name());
       }
     }
   }
   if (ok && !treatExternalAsImplicit && procSymbol &&
       !(chars && chars->HasExplicitInterface())) {
     if (const Symbol *global{FindGlobal(*procSymbol)};
         global && global != procSymbol && IsProcedure(*global)) {
       // 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*/);
       }
     }
   }
   return chars;
 }
 
if (lhs == TypeCategory::Integer && rhs == TypeCategory::Logical) {
     // allow assignment to LOGICAL from INTEGER as a legacy extension
     msg = "assignment of LOGICAL to INTEGER"_port_en_US;
   } else if (lhs == TypeCategory::Logical && rhs == TypeCategory::Integer) {
     // ... and assignment to LOGICAL from INTEGER
     msg = "assignment of INTEGER to LOGICAL"_port_en_US;
   } else {
     return false;
   }
-  if (context_.context().languageFeatures().ShouldWarn(
+  if (context_.context().ShouldWarn(
           common::LanguageFeature::LogicalIntegerAssignment)) {
     context_.Say(std::move(*msg));
   }
   return true;
 }
 
 std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
   const Symbol *proc{nullptr};

flang/lib/Semantics/pointer-assignment.h

 #include "flang/Parser/char-block.h"
 #include "flang/Semantics/type.h"
 #include <string>
 
 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
 
 #endif // FORTRAN_SEMANTICS_POINTER_ASSIGNMENT_H_

flang/lib/Semantics/pointer-assignment.cpp

 using evaluate::characteristics::FunctionResult;
 using evaluate::characteristics::Procedure;
 using evaluate::characteristics::TypeAndShape;
 using parser::MessageFixedText;
 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));
   }
   PointerAssignmentChecker &set_lhsType(std::optional<TypeAndShape> &&);
   PointerAssignmentChecker &set_isContiguous(bool);
   PointerAssignmentChecker &set_isVolatile(bool);
   PointerAssignmentChecker &set_isBoundsRemapping(bool);
   PointerAssignmentChecker &set_pointerComponentLHS(const Symbol *);
private:
   bool Check(const evaluate::ProcedureRef &);
   // Target is a procedure
   bool Check(parser::CharBlock rhsName, bool isCall,
       const Procedure * = nullptr,
       const evaluate::SpecificIntrinsic *specific = nullptr);
   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_;
   const Symbol *lhs_{nullptr};
   std::optional<TypeAndShape> lhsType_;
   std::optional<Procedure> procedure_;
   bool characterizedProcedure_{false};
   bool isContiguous_{false};
PointerAssignmentChecker &PointerAssignmentChecker::set_pointerComponentLHS(
   pointerComponentLHS_ = symbol;
   return *this;
 }
 
 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)}) {
       msg->Attach(std::move(*whyNot));
     }
     return false;
   } else {
     return true;
if (pointerComponentLHS_) { // C1594(4) is a hard error
               .Attach(
                   pointerComponentLHS_->name(), "Pointer declaration"_en_US);
         }
         return false;
       }
     } 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;
       }
     }
   }
   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 (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 true;
 }
 
 bool PointerAssignmentChecker::Check(const evaluate::NullPointer &) {
   return true; // P => NULL() without MOLD=; always OK
 }
 
 template <typename T>
 bool PointerAssignmentChecker::Check(const evaluate::FunctionRef<T> &f) {
   std::string funcName;
   const auto *symbol{f.proc().GetSymbol()};
   if (symbol) {
     funcName = symbol->name().ToString();
   } 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;
   }
   std::optional<MessageFixedText> msg;
   const auto &funcResult{proc->functionResult}; // C1025
   if (!funcResult) {
     msg = "%s is associated with the non-existent result of reference to"
           " procedure"_err_en_US;
msg = "%s is associated with the result of a reference to function '%s'"
           " that is a not a pointer"_err_en_US;
   } else if (isContiguous_ &&
       !funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
     msg = "CONTIGUOUS %s is associated with the result of reference to"
           " function '%s' that is not contiguous"_err_en_US;
   } 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)) {
       return false; // IsCompatibleWith() emitted message
     }
   }
   if (msg) {
     auto restorer{common::ScopedSet(lhs_, symbol)};
bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
   std::optional<std::variant<MessageFixedText, MessageFormattedText>> msg;
   if (CharacterizeProcedure()) {
     // Shouldn't be here in this function unless lhs is an object pointer.
     msg = "In assignment to procedure %s, the target is not a procedure or"
           " procedure pointer"_err_en_US;
   } 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;
     } else if (rhsType->corank() > 0 &&
         (isVolatile_ != last->attrs().test(Attr::VOLATILE))) { // C1020
       // TODO: what if A is VOLATILE in A%B%C?  need a better test here
       if (isVolatile_) {
         msg = "Pointer may not be VOLATILE when target is a"
bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
   return true;
 }
 
 bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
   if (const Symbol * symbol{d.GetSymbol()}) {
     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);
   }
 }
 
 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);
       }
     }
     return Check(ref.proc().GetName(), true, &*chars);
   } else {
     return Check(ref.proc().GetName(), true, nullptr);
if (type.category() != TypeCategory::Derived || type.IsAssumedType()) {
     return true;
   } else {
     return !IsExtensibleType(&type.GetDerivedTypeSpec());
   }
 }
 
 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_);
     }
     if (!source_.empty()) {
       msg->Attach(source_, "Declaration of %s"_en_US, description_);
     }
   }
static bool CheckPointerBounds(
   if (isBoundsRemapping && rhs.Rank() != 1 &&
       !evaluate::IsSimplyContiguous(rhs, context)) {
     messages.Say("Pointer bounds remapping target must have rank 1 or be"
                  " simply contiguous"_err_en_US); // 10.2.2.3(9)
   }
   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
   }
   PointerAssignmentChecker checker{context, scope, *pointer};
   checker.set_isBoundsRemapping(isBoundsRemapping);
   bool lhsOk{checker.CheckLeftHandSide(lhs)};
   bool rhsOk{checker.Check(rhs)};
   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))
       .set_isVolatile(lhs.attrs.test(DummyDataObject::Attr::Volatile))
       .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);
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-labels.cpp

if (!HasScope(doTarget.proxyForScope)) {
           "Label '%u' doesn't lexically follow DO stmt"_err_en_US,
           SayLabel(label));
 
     } else if ((InInclusiveScope(scopes, scope, doTarget.proxyForScope) &&
                    doTarget.labeledStmtClassificationSet.test(
                        TargetStatementEnum::CompatibleDo)) ||
         (doTarget.isExecutableConstructEndStmt &&
             ParentScope(scopes, doTarget.proxyForScope) == scope)) {
-      if (context.warnOnNonstandardUsage() ||
-          context.ShouldWarn(
+      if (context.ShouldWarn(
               common::LanguageFeature::OldLabelDoEndStatements)) {
         context
             .Say(position,
                 "A DO loop should terminate with an END DO or CONTINUE"_port_en_US)
             .Attach(doTarget.parserCharBlock,
                 "DO loop currently ends at statement:"_en_US);
       }
     } else if (!InInclusiveScope(scopes, scope, doTarget.proxyForScope)) {

flang/lib/Semantics/resolve-names.cpp

bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
   auto kind{evaluate::ToInt64(type->numericTypeSpec().kind())};
   if (!kind || *kind != context().GetDefaultKind(TypeCategory::Integer)) {
     return false;
   }
   if (!ConvertToObjectEntity(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());
   }
   symbol.set(Symbol::Flag::Implicit);
   symbol.SetType(*type);
   return true;
 }
if (result) {
       result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
     }
     info.resultSymbol = result;
     details.set_result(*result);
   }
   // 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);
     // RESULT name was ignored above, the only side effect from doing so will be
     // the inability to make recursive calls. The related parser::Name is still
     // resolved to the created function result symbol because every parser::Name
     // should be resolved to avoid internal errors.
     Resolve(*info.resultName, info.resultSymbol);

 bool DeclarationVisitor::Pre(const parser::PrivateStmt &) {
   if (!currScope().parent().IsModule()) {
     Say("PRIVATE is only allowed in a derived type that is"
         " in a module"_err_en_US); // C766
   } else if (derivedTypeInfo_.sawContains) {
     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;
 }
 void DeclarationVisitor::Post(const parser::ComponentDecl &x) {
   const auto &name{std::get<parser::Name>(x.t)};
   auto attrs{GetAttrs()};
   if (derivedTypeInfo_.privateComps &&

flang/test/Semantics/assign09.f90

-! 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
     real function realToReal(a)
       real, intent(in) :: a
     end function
     real function intToReal(n)
       integer, intent(in) :: n

flang/test/Semantics/associate01.f90

-! 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
 ! POINTER attributes; it has the TARGET attribute if and only if the selector
 ! is a variable and has either the TARGET or POINTER attribute."
 module m1
   type t
    contains

flang/test/Semantics/bindings03.f90

-! 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
    contains
     procedure :: sub
   end type
  contains
   subroutine sub(x)

flang/test/Semantics/call03.f90

-! 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.
 
 module m01
   type :: t
   end type
   type :: pdt(n)
     integer, len :: n

flang/test/Semantics/call07.f90

-! 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
   real :: coarray(10)[*]
  contains
 
   subroutine s01(p)
     real, pointer, contiguous, intent(in) :: p(:)

flang/test/Semantics/call21.f90

-! 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.
 module m
  contains
   real function realfunc(x)
     real, intent(in) :: x
     realfunc = x

flang/test/Semantics/call30.f90

-! 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
 
 module m
   contains
   subroutine vol_dum_int(my_int)
     integer, volatile :: my_int
module m
 
   subroutine vol_dum_int_arr(my_int_arr)
     integer, dimension(2,2), volatile :: my_int_arr
   end subroutine vol_dum_int_arr
 
   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

flang/test/Semantics/call33.f90

-! 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)
     character(3) :: x
   end
   subroutine s2(x)
     character(3) :: x(1)
   end

flang/test/Semantics/call34.f90

-! 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)
     real, intent(in), target :: a(:)
   end subroutine
 end module
 
 program test

flang/test/Semantics/resolve31.f90

subroutine s2
   type, extends(t0) :: t1
   end type
 end subroutine
 
 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
   type :: t1a
   end type
   !ERROR: A sequence type may not have the EXTENDS attribute
   type, extends(t1a) :: t2
     sequence

flang/test/Semantics/resolve59.f90

function f5(x)
     procedure(rfunc), pointer :: f5
     f5 => rfunc
     ! OK call to f5 pointer
     x = acos(f5(x+1))
     !ERROR: Actual argument for 'x=' may not be a procedure
     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
     x = acos(f7())
     f7 = x
     x = acos(f7) !OK
   end function
 end module

flang/test/Semantics/structconst03.f90

-! 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
 ! parameters.
 
 module usefrom
   real, target :: usedfrom1
 end module usefrom

flang/test/Semantics/structconst04.f90

-! 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.
 
 module usefrom
   real, target :: usedfrom1
 end module usefrom
 

flang/test/Semantics/transfer01.f90

-! 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)
   integer, intent(in), optional :: o
   type empty
   end type
   type(empty) :: empty1(1)
   type hasdescriptor

flang/tools/f18-parse-demo/f18-parse-demo.cpp

 struct DriverOptions {
   DriverOptions() {}
   bool verbose{false}; // -v
   bool compileOnly{false}; // -c
   std::string outputPath; // -o path
   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
   bool syntaxOnly{false};
   bool dumpProvenance{false};
   bool noReformat{false}; // -E -fno-reformat
   bool dumpUnparse{false};
   bool dumpParseTree{false};
while (!args.empty()) {
     } else if (arg == "-Mbackslash") {
       options.features.Enable(
           Fortran::common::LanguageFeature::BackslashEscapes, false);
     } else if (arg == "-Mnobackslash") {
       options.features.Enable(
           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");
     } else if (arg == "-Werror") {
       driver.warningsAreErrors = true;
     } else if (arg == "-ed") {
       options.features.Enable(Fortran::common::LanguageFeature::OldDebugLines);
     } else if (arg == "-E") {
if (arg.empty() || arg == "-Xflang") {
         driver.searchDirectories.push_back(arg.substr(2));
       }
     }
   }
 
   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"
   }
 
   if (!anyFiles) {
     driver.dumpUnparse = true;
     CompileFortran("-", options, driver);