llvm-project/flang/lib/Support/Fortran-features.cpp
Peter Klausler c5aefc7753
[flang] Downgrade an overly strict error to a warning (#187524)
Fortran allows a PURE subroutine to have dummy argument with INTENT(IN
OUT). An actual argument that is associated with an INTENT(IN OUT) dummy
argument must be definable. Consequently, there's a hole in the language
that allows a PURE subroutine to modify arbitrary global state: the
argument could have a derived type with an impure FINAL subroutine, and
that FINAL subroutine could be invoked by an assignment to the dummy
argument. I consider this to be a mistake in the language design.

So the compiler was reporting this case as an error, although it is
indeed conforming usage, and not flagged by any other compiler.
Unfortunately, somebody has a code that needs this usage to be accepted,
because (I presume) they can't modify the dummy argument to be
INTENT(IN).

Consequently, we'll need to allow this usage. But it will elicit a
warning, and the warning is on by default.
2026-03-19 15:27:01 -05:00

280 lines
11 KiB
C++

//===-- lib/Support/Fortran-features.cpp ------------------------*- C++ -*-===//
//
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
// See https://llvm.org/LICENSE.txt for license information.
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
//
//===----------------------------------------------------------------------===//
#include "flang/Support/Fortran-features.h"
#include "flang/Common/idioms.h"
#include "flang/Parser/characters.h"
#include "flang/Support/Fortran.h"
#include <string>
#include <string_view>
namespace Fortran::common {
static std::vector<std::string_view> SplitCamelCase(std::string_view x) {
std::vector<std::string_view> result;
// NB, we start at 1 because the first character is never a word boundary.
size_t xSize{x.size()}, wordStart{0}, wordEnd{1};
for (; wordEnd < xSize; ++wordEnd) {
// Identify when wordEnd is at the start of a new word.
if ((!parser::IsUpperCaseLetter(x[wordEnd - 1]) &&
parser::IsUpperCaseLetter(x[wordEnd])) ||
// ACCUsage => ACC-Usage, CComment => C-Comment, etc.
(parser::IsUpperCaseLetter(x[wordEnd]) && wordEnd + 1 < xSize &&
parser::IsLowerCaseLetter(x[wordEnd + 1]))) {
result.push_back(x.substr(wordStart, wordEnd - wordStart));
wordStart = wordEnd;
}
}
// We went one past the end of the last word.
result.push_back(x.substr(wordStart, wordEnd - wordStart));
return result;
}
// Namespace for helper functions for parsing Cli options used instead of static
// so that there can be unit tests for this function.
namespace details {
std::string CamelCaseToLowerCaseHyphenated(std::string_view x) {
std::vector<std::string_view> words{SplitCamelCase(x)};
std::string result{};
result.reserve(x.size() + words.size() + 1);
for (size_t i{0}; i < words.size(); ++i) {
std::string word{parser::ToLowerCaseLetters(words[i])};
result += i == 0 ? "" : "-";
result += word;
}
return result;
}
} // namespace details
LanguageFeatureControl::LanguageFeatureControl() {
// Initialize the bidirectional maps with the default spellings.
cliOptions_.reserve(LanguageFeature_enumSize + UsageWarning_enumSize);
ForEachLanguageFeature([&](auto feature) {
std::string_view name{Fortran::common::EnumToString(feature)};
std::string cliOption{details::CamelCaseToLowerCaseHyphenated(name)};
cliOptions_.insert({cliOption, {feature}});
languageFeatureCliCanonicalSpelling_[EnumToInt(feature)] =
std::move(cliOption);
});
ForEachUsageWarning([&](auto warning) {
std::string_view name{Fortran::common::EnumToString(warning)};
std::string cliOption{details::CamelCaseToLowerCaseHyphenated(name)};
cliOptions_.insert({cliOption, {warning}});
usageWarningCliCanonicalSpelling_[EnumToInt(warning)] =
std::move(cliOption);
});
// Fix CLI spellings where the auto-generated hyphenation is wrong.
// TODO: -Wopen-mp-* should be fixed in a central place. See
// see Discourse at
// https://discourse.llvm.org/t/openmp-misspelling-of-wopen-mp/90196.
ReplaceCliCanonicalSpelling(LanguageFeature::OpenMPThreadprivateEquivalence,
"openmp-threadprivate-equivalence");
// These features must be explicitly enabled by command line options.
disable_.set(LanguageFeature::OldDebugLines);
disable_.set(LanguageFeature::OpenACC);
disable_.set(LanguageFeature::OpenMP);
disable_.set(LanguageFeature::CUDA); // !@cuf
disable_.set(LanguageFeature::CudaManaged);
disable_.set(LanguageFeature::CudaUnified);
disable_.set(LanguageFeature::ImplicitNoneTypeNever);
disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
disable_.set(LanguageFeature::ImplicitNoneExternal);
disable_.set(LanguageFeature::DefaultSave);
disable_.set(LanguageFeature::SaveMainProgram);
// These features, if enabled, conflict with valid standard usage,
// so there are disabled here by default.
disable_.set(LanguageFeature::BackslashEscapes);
disable_.set(LanguageFeature::LogicalAbbreviations);
disable_.set(LanguageFeature::XOROperator);
disable_.set(LanguageFeature::OldStyleParameter);
// Possibly an accidental "feature" of nvfortran.
disable_.set(LanguageFeature::AssumedRankPassedToNonAssumedRank);
disable_.set(LanguageFeature::Coarray);
// These warnings are enabled by default, but only because they used
// to be unconditional. TODO: prune this list
warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);
warnLanguage_.set(LanguageFeature::RedundantAttribute);
warnLanguage_.set(LanguageFeature::SubroutineAndFunctionSpecifics);
warnLanguage_.set(LanguageFeature::EmptySequenceType);
warnLanguage_.set(LanguageFeature::NonSequenceCrayPointee);
warnLanguage_.set(LanguageFeature::BranchIntoConstruct);
warnLanguage_.set(LanguageFeature::BadBranchTarget);
warnLanguage_.set(LanguageFeature::HollerithPolymorphic);
warnLanguage_.set(LanguageFeature::ListDirectedSize);
warnLanguage_.set(LanguageFeature::IgnoreIrrelevantAttributes);
warnLanguage_.set(LanguageFeature::TransferBOZ);
warnLanguage_.set(LanguageFeature::AllocatedForAssociated);
warnUsage_.set(UsageWarning::ShortArrayActual);
warnUsage_.set(UsageWarning::FoldingException);
warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
warnUsage_.set(UsageWarning::FoldingValueChecks);
warnUsage_.set(UsageWarning::FoldingFailure);
warnUsage_.set(UsageWarning::FoldingLimit);
warnUsage_.set(UsageWarning::Interoperability);
// CharacterInteroperability warnings about length are off by default
warnUsage_.set(UsageWarning::Bounds);
warnUsage_.set(UsageWarning::Preprocessing);
warnUsage_.set(UsageWarning::Scanning);
warnUsage_.set(UsageWarning::OpenAccUsage);
warnUsage_.set(UsageWarning::ProcPointerCompatibility);
warnUsage_.set(UsageWarning::VoidMold);
warnUsage_.set(UsageWarning::KnownBadImplicitInterface);
warnUsage_.set(UsageWarning::EmptyCase);
warnUsage_.set(UsageWarning::CaseOverflow);
warnUsage_.set(UsageWarning::CUDAUsage);
warnUsage_.set(UsageWarning::IgnoreTKRUsage);
warnUsage_.set(UsageWarning::ExternalInterfaceMismatch);
warnUsage_.set(UsageWarning::DefinedOperatorArgs);
warnUsage_.set(UsageWarning::Final);
warnUsage_.set(UsageWarning::ZeroDoStep);
warnUsage_.set(UsageWarning::UnusedForallIndex);
warnUsage_.set(UsageWarning::OpenMPUsage);
warnUsage_.set(UsageWarning::DataLength);
warnUsage_.set(UsageWarning::IgnoredDirective);
warnUsage_.set(UsageWarning::HomonymousSpecific);
warnUsage_.set(UsageWarning::HomonymousResult);
warnUsage_.set(UsageWarning::IgnoredIntrinsicFunctionType);
warnUsage_.set(UsageWarning::PreviousScalarUse);
warnUsage_.set(UsageWarning::RedeclaredInaccessibleComponent);
warnUsage_.set(UsageWarning::ImplicitShared);
warnUsage_.set(UsageWarning::IndexVarRedefinition);
warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
warnUsage_.set(UsageWarning::UndefinedFunctionResult);
warnUsage_.set(UsageWarning::UselessIomsg);
warnUsage_.set(UsageWarning::UnsignedLiteralTruncation);
warnUsage_.set(UsageWarning::NullActualForDefaultIntentAllocatable);
warnUsage_.set(UsageWarning::UseAssociationIntoSameNameSubprogram);
warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr);
warnUsage_.set(UsageWarning::NonVolatilePointerToVolatile);
warnUsage_.set(UsageWarning::RealConstantWidening);
// New warnings, on by default
warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
warnLanguage_.set(LanguageFeature::NullActualForAllocatable);
warnUsage_.set(UsageWarning::BadValueInDeadCode);
warnUsage_.set(UsageWarning::MisplacedIgnoreTKR);
warnUsage_.set(UsageWarning::ImpureFinalInPure);
warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
}
std::optional<LanguageControlFlag> LanguageFeatureControl::FindWarning(
std::string_view input) {
bool negated{false};
if (input.size() > 3 && input.substr(0, 3) == "no-") {
negated = true;
input = input.substr(3);
}
if (auto it{cliOptions_.find(std::string{input})}; it != cliOptions_.end()) {
return std::make_pair(it->second, !negated);
}
return std::nullopt;
}
bool LanguageFeatureControl::EnableWarning(std::string_view input) {
if (auto warningAndEnabled{FindWarning(input)}) {
EnableWarning(warningAndEnabled->first, warningAndEnabled->second);
return true;
}
return false;
}
void LanguageFeatureControl::ReplaceCliCanonicalSpelling(
LanguageFeature f, std::string input) {
cliOptions_.erase(languageFeatureCliCanonicalSpelling_[EnumToInt(f)]);
cliOptions_.insert({input, {f}});
languageFeatureCliCanonicalSpelling_[EnumToInt(f)] = std::move(input);
}
void LanguageFeatureControl::ReplaceCliCanonicalSpelling(
UsageWarning w, std::string input) {
cliOptions_.erase(usageWarningCliCanonicalSpelling_[EnumToInt(w)]);
cliOptions_.insert({input, {w}});
usageWarningCliCanonicalSpelling_[EnumToInt(w)] = std::move(input);
}
std::vector<const char *> LanguageFeatureControl::GetNames(
LogicalOperator opr) const {
std::vector<const char *> result;
result.push_back(AsFortran(opr));
if (opr == LogicalOperator::Neqv && IsEnabled(LanguageFeature::XOROperator)) {
result.push_back(".xor.");
}
if (IsEnabled(LanguageFeature::LogicalAbbreviations)) {
switch (opr) {
SWITCH_COVERS_ALL_CASES
case LogicalOperator::And:
result.push_back(".a.");
break;
case LogicalOperator::Or:
result.push_back(".o.");
break;
case LogicalOperator::Not:
result.push_back(".n.");
break;
case LogicalOperator::Neqv:
if (IsEnabled(LanguageFeature::XOROperator)) {
result.push_back(".x.");
}
break;
case LogicalOperator::Eqv:
break;
}
}
return result;
}
std::vector<const char *> LanguageFeatureControl::GetNames(
RelationalOperator opr) const {
switch (opr) {
SWITCH_COVERS_ALL_CASES
case RelationalOperator::LT:
return {".lt.", "<"};
case RelationalOperator::LE:
return {".le.", "<="};
case RelationalOperator::EQ:
return {".eq.", "=="};
case RelationalOperator::GE:
return {".ge.", ">="};
case RelationalOperator::GT:
return {".gt.", ">"};
case RelationalOperator::NE:
if (IsEnabled(LanguageFeature::AlternativeNE)) {
return {".ne.", "/=", "<>"};
} else {
return {".ne.", "/="};
}
}
}
void LanguageFeatureControl::WarnOnAllNonstandard(bool yes) {
warnAllLanguage_ = yes;
warnLanguage_.reset();
if (yes) {
disableAllWarnings_ = false;
warnLanguage_.flip();
// These three features do not need to be warned about,
// but we do want their feature flags.
warnLanguage_.set(LanguageFeature::OpenMP, false);
warnLanguage_.set(LanguageFeature::OpenACC, false);
warnLanguage_.set(LanguageFeature::CUDA, false);
}
}
void LanguageFeatureControl::WarnOnAllUsage(bool yes) {
warnAllUsage_ = yes;
warnUsage_.reset();
if (yes) {
disableAllWarnings_ = false;
warnUsage_.flip();
}
}
} // namespace Fortran::common