namespace Fortran::common {
+// Non-conforming extensions & legacies
ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations,
XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions,
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
- SaveMainProgram, SaveBigMainProgramVariables)
+ SaveMainProgram, SaveBigMainProgramVariables,
+ DistinctArrayConstructorLengths)
+
+// Portability and suspicious usage warnings for conforming code
+ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
+ NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
+ ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
+ PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
+using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
class LanguageFeatureControl {
public:
}
LanguageFeatureControl(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;
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_
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.
return enableConformanceChecks;
}
+ bool &getEnableUsageChecks() { return enableUsageChecks; }
+ const bool &getEnableUsageChecks() const { return enableUsageChecks; }
+
Fortran::parser::AnalyzedObjectsAsFortran &getAsFortran() {
return asFortran;
}
// 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; }
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 {
}
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_; }
// -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)) {
if (frontendOptions.needProvenanceRangeToCharBlockMappings)
fortranOptions.needProvenanceRangeToCharBlockMappings = true;
- if (getEnableConformanceChecks()) {
+ if (getEnableConformanceChecks())
fortranOptions.features.WarnOnAllNonstandard();
- }
+
+ if (getEnableUsageChecks())
+ fortranOptions.features.WarnOnAllUsage();
}
void CompilerInvocation::setSemanticsOpts(
semanticsContext->set_moduleDirectory(getModuleDir())
.set_searchDirectories(fortranOptions.searchDirectories)
.set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
- .set_warnOnNonstandardUsage(getEnableConformanceChecks())
.set_warningsAreErrors(getWarnAsErr())
.set_moduleFileSuffix(getModuleFileSuffix());
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));
}
}
// 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) ||
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,
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)};
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;
? 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(
// 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{
}
// 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) {
static void CheckProcedureArg(evaluate::ActualArgument &arg,
const characteristics::Procedure &proc,
const characteristics::DummyProcedure &dummy, const std::string &dummyName,
- evaluate::FoldingContext &context) {
- parser::ContextualMessages &messages{context.messages()};
+ SemanticsContext &context) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
auto restorer{
messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
const characteristics::Procedure &interface { dummy.procedure.value() };
}
}
if (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)}) {
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);
}
}
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) + "='";
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)) {
}
// TRANSFER (16.9.193)
-static void CheckTransferOperandType(parser::ContextualMessages &messages,
+static void CheckTransferOperandType(SemanticsContext &context,
const evaluate::DynamicType &type, const char *which) {
- if (type.IsPolymorphic()) {
- messages.Say("%s of TRANSFER is polymorphic"_warn_en_US, which);
+ if (type.IsPolymorphic() &&
+ context.ShouldWarn(common::UsageWarning::PolymorphicTransferArg)) {
+ context.foldingContext().messages().Say(
+ "%s of TRANSFER is polymorphic"_warn_en_US, which);
} else if (!type.IsUnlimitedPolymorphic() &&
- type.category() == TypeCategory::Derived) {
+ type.category() == TypeCategory::Derived &&
+ context.ShouldWarn(common::UsageWarning::PointerComponentTransferArg)) {
DirectComponentIterator directs{type.GetDerivedTypeSpec()};
if (auto bad{std::find_if(directs.begin(), directs.end(), IsDescriptor)};
bad != directs.end()) {
- evaluate::SayWithDeclaration(messages, *bad,
+ evaluate::SayWithDeclaration(context.foldingContext().messages(), *bad,
"%s of TRANSFER contains allocatable or pointer component %s"_warn_en_US,
which, bad.BuildResultDesignatorName());
}
}
static void CheckTransfer(evaluate::ActualArguments &arguments,
- evaluate::FoldingContext &context, const Scope *scope) {
+ SemanticsContext &context, const Scope *scope) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
if (arguments.size() >= 2) {
if (auto source{characteristics::TypeAndShape::Characterize(
- arguments[0], context)}) {
- CheckTransferOperandType(context.messages(), source->type(), "Source");
+ arguments[0], foldingContext)}) {
+ CheckTransferOperandType(context, source->type(), "Source");
if (auto mold{characteristics::TypeAndShape::Characterize(
- arguments[1], context)}) {
- CheckTransferOperandType(context.messages(), mold->type(), "Mold");
+ arguments[1], foldingContext)}) {
+ CheckTransferOperandType(context, mold->type(), "Mold");
if (mold->Rank() > 0 &&
evaluate::ToInt64(
- evaluate::Fold(
- context, mold->MeasureElementSizeInBytes(context, false)))
+ evaluate::Fold(foldingContext,
+ mold->MeasureElementSizeInBytes(foldingContext, false)))
.value_or(1) == 0) {
- if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(
- context, source->MeasureSizeInBytes(context)))}) {
+ if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(foldingContext,
+ source->MeasureSizeInBytes(foldingContext)))}) {
if (*sourceSize > 0) {
- context.messages().Say(
+ messages.Say(
"Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
}
} else {
- context.messages().Say(
+ messages.Say(
"Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
}
}
if (const Symbol *
whole{UnwrapWholeSymbolOrComponentDataRef(arguments[2])}) {
if (IsOptional(*whole)) {
- context.messages().Say(
+ messages.Say(
"SIZE= argument may not be the optional dummy argument '%s'"_err_en_US,
whole->name());
- } else if (IsAllocatableOrPointer(*whole)) {
- context.messages().Say(
+ } else if (context.ShouldWarn(
+ common::UsageWarning::TransferSizePresence) &&
+ IsAllocatableOrPointer(*whole)) {
+ messages.Say(
"SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
}
}
}
static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
- evaluate::FoldingContext &context, const Scope *scope,
+ SemanticsContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic &intrinsic) {
if (intrinsic.name == "associated") {
- CheckAssociated(arguments, context, scope);
+ CheckAssociated(arguments, context.foldingContext(), scope);
} else if (intrinsic.name == "transfer") {
CheckTransfer(arguments, context, scope);
}
static parser::Messages CheckExplicitInterface(
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
- const evaluate::FoldingContext &context, const Scope *scope,
+ SemanticsContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic *intrinsic,
bool allowActualArgumentConversions) {
+ evaluate::FoldingContext &foldingContext{context.foldingContext()};
+ parser::ContextualMessages &messages{foldingContext.messages()};
parser::Messages buffer;
- parser::ContextualMessages messages{context.messages().at(), &buffer};
+ auto restorer{messages.SetMessages(buffer)};
RearrangeArguments(proc, actuals, messages);
- evaluate::FoldingContext localContext{context, messages};
if (!buffer.empty()) {
return buffer;
}
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(
}
}
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,
}
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);
}
}
}
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
// 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);
// 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
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>()}) {
}
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);
}
};
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{
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);
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;
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;
}
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(
}
if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
semantics::CheckStructConstructorPointerComponent(
- GetFoldingContext(), *symbol, *value, innermost);
+ context_, *symbol, *value, innermost);
result.Add(*symbol, Fold(std::move(*value)));
continue;
}
}
}
if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
- GetFoldingContext(), false /* no integer conversions */) &&
+ context_, false /* no integer conversions */) &&
CheckCompatibleArguments(*procedure, localActuals)) {
if ((procedure->IsElemental() && elemental) ||
(!procedure->IsElemental() && nonElemental)) {
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)) {
// 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*/);
}
} else {
return false;
}
- if (context_.context().languageFeatures().ShouldWarn(
+ if (context_.context().ShouldWarn(
common::LanguageFeature::LogicalIntegerAssignment)) {
context_.Say(std::move(*msg));
}
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));
}
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_;
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)}) {
} else if (const Symbol * base{GetFirstSymbol(rhs)}) {
if (const char *why{WhyBaseObjectIsSuspicious(
base->GetUltimate(), scope_)}) { // C1594(3)
- evaluate::SayWithDeclaration(context_.messages(), *base,
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *base,
"A pure subprogram may not use '%s' as the target of pointer assignment because it is %s"_err_en_US,
base->name(), why);
return false;
}
}
if (isContiguous_) {
- if (auto contiguous{evaluate::IsContiguous(rhs, context_)}) {
+ if (auto contiguous{evaluate::IsContiguous(rhs, foldingContext_)}) {
if (!*contiguous) {
Say("CONTIGUOUS pointer may not be associated with a discontiguous target"_err_en_US);
return false;
}
- } else {
+ } else if (context_.ShouldWarn(
+ common::UsageWarning::PointerToPossibleNoncontiguous)) {
Say("Target of CONTIGUOUS pointer association is not known to be contiguous"_warn_en_US);
}
}
// Warn about undefinable data targets
- if (auto because{
- WhyNotDefinable(context_.messages().at(), scope_, {}, rhs)}) {
- if (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;
}
} 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;
}
} 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)) {
} 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;
if (const auto *subp{
symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
if (subp->stmtFunction()) {
- evaluate::SayWithDeclaration(context_.messages(), *symbol,
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
"Statement function '%s' may not be the target of a pointer assignment"_err_en_US,
symbol->name());
return false;
}
- } else if (symbol->has<ProcBindingDetails>()) {
- evaluate::SayWithDeclaration(context_.messages(), *symbol,
+ } else if (symbol->has<ProcBindingDetails>() &&
+ context_.ShouldWarn(common::UsageWarning::Portability)) {
+ evaluate::SayWithDeclaration(foldingContext_.messages(), *symbol,
"Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
symbol->name());
}
}
- if (auto chars{Procedure::Characterize(d, context_)}) {
+ if (auto chars{Procedure::Characterize(d, foldingContext_)}) {
return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
} else {
return Check(d.GetName(), false);
}
bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
- if (auto chars{Procedure::Characterize(ref, context_)}) {
+ if (auto chars{Procedure::Characterize(ref, foldingContext_)}) {
if (chars->functionResult) {
if (const auto *proc{chars->functionResult->IsProcedurePointer()}) {
return Check(ref.proc().GetName(), true, proc);
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_);
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
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))
.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);
}
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
TargetStatementEnum::CompatibleDo)) ||
(doTarget.isExecutableConstructEndStmt &&
ParentScope(scopes, doTarget.proxyForScope) == scope)) {
- if (context.warnOnNonstandardUsage() ||
- context.ShouldWarn(
+ if (context.ShouldWarn(
common::LanguageFeature::OldLabelDoEndStatements)) {
context
.Say(position,
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());
// 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);
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;
-! 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
-! 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
-! 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
-! 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.
-! 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
-! 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.
-! 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
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
-! 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)
-! 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)
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
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
-! 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
-! 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.
-! 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)
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
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");
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"
projects / platform / upstream / llvm.git / commitdiff