From: Peter Klausler Date: Tue, 9 May 2023 21:01:18 +0000 (-0700) Subject: [flang] Finer control over warnings X-Git-Tag: upstream/17.0.6~8268 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=191d48723f8b853a6ad65532c173c67155cbe606;p=platform%2Fupstream%2Fllvm.git [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 --- diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index 390a971..987e562 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; +using UsageWarnings = EnumSet; 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 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 58479c8..b3ea098 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 1c4654f..569147c 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 bool ShouldWarn(A x) const { + return languageFeatures_.ShouldWarn(x); } const std::optional &location() const { return location_; } const std::vector &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 6672777..84478f2 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 26d539a..ef53e25 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 2d1c167..4d6eb30 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 &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 &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 &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() : 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(&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 1d03f81..4275606 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 be9f498..3162af3 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()}) { diff --git a/flang/lib/Semantics/check-do-forall.cpp b/flang/lib/Semantics/check-do-forall.cpp index b90bfd3..7f61d2f 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 1c1b07c..ba3b41a 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 959c74b..4fa8adb 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -384,7 +384,8 @@ bool DataInitializationCompiler::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()) { GetImage().AddPointer(offsetSymbol.offset(), *expr); return true; @@ -405,7 +406,8 @@ bool DataInitializationCompiler::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 d30465e..b946409 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 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 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 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 de6e7838..ba63159 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 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 &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 &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 &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()}) { 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()) { - evaluate::SayWithDeclaration(context_.messages(), *symbol, + } else if (symbol->has() && + 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 parser::Message *PointerAssignmentChecker::Say(A &&...x) { - auto *msg{context_.messages().Say(std::forward(x)...)}; + auto *msg{foldingContext_.messages().Say(std::forward(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 95ed67d..c6f89c4 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 3a2dd61..f849b22 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 321f819..be9c130 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 d8104b1..d3c72f3 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 8916a3b..6f8e520 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 8422734..baa8432 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 7a86006..c31f2cc 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 08465a9..7122987 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 4877551..64b7332 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 f6725cd..3653c29 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 92051af..2fc017f 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 4f939f2..325a267 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 5f41cbf..0c604c0 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 a79c4a4..7458710 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 f2e659f..7940ada 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 728d277..f19852b 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 6cd8288..26f4f1b 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 ae0a3c4..afaa18b 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 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"