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