flang/lib/Common/Fortran-features.cpp

   1 //===-- lib/Common/Fortran-features.cpp -----------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "flang/Common/Fortran-features.h"
  10 #include "flang/Common/Fortran.h"
  11 #include "flang/Common/idioms.h"
  12
  13 namespace Fortran::common {
  14
  15 LanguageFeatureControl::LanguageFeatureControl() {
  16   // These features must be explicitly enabled by command line options.
  17   disable_.set(LanguageFeature::OldDebugLines);
  18   disable_.set(LanguageFeature::OpenACC);
  19   disable_.set(LanguageFeature::OpenMP);
  20   disable_.set(LanguageFeature::CUDA); // !@cuf
  21   disable_.set(LanguageFeature::CudaManaged);
  22   disable_.set(LanguageFeature::CudaUnified);
  23   disable_.set(LanguageFeature::ImplicitNoneTypeNever);
  24   disable_.set(LanguageFeature::ImplicitNoneTypeAlways);
  25   disable_.set(LanguageFeature::DefaultSave);
  26   disable_.set(LanguageFeature::SaveMainProgram);
  27   // These features, if enabled, conflict with valid standard usage,
  28   // so there are disabled here by default.
  29   disable_.set(LanguageFeature::BackslashEscapes);
  30   disable_.set(LanguageFeature::LogicalAbbreviations);
  31   disable_.set(LanguageFeature::XOROperator);
  32   disable_.set(LanguageFeature::OldStyleParameter);
  33   // Possibly an accidental "feature" of nvfortran.
  34   disable_.set(LanguageFeature::AssumedRankPassedToNonAssumedRank);
  35   // These warnings are enabled by default, but only because they used
  36   // to be unconditional.  TODO: prune this list
  37   warnLanguage_.set(LanguageFeature::ExponentMatchingKindParam);
  38   warnLanguage_.set(LanguageFeature::RedundantAttribute);
  39   warnLanguage_.set(LanguageFeature::SubroutineAndFunctionSpecifics);
  40   warnLanguage_.set(LanguageFeature::EmptySequenceType);
  41   warnLanguage_.set(LanguageFeature::NonSequenceCrayPointee);
  42   warnLanguage_.set(LanguageFeature::BranchIntoConstruct);
  43   warnLanguage_.set(LanguageFeature::BadBranchTarget);
  44   warnLanguage_.set(LanguageFeature::HollerithPolymorphic);
  45   warnLanguage_.set(LanguageFeature::ListDirectedSize);
  46   warnUsage_.set(UsageWarning::ShortArrayActual);
  47   warnUsage_.set(UsageWarning::FoldingException);
  48   warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
  49   warnUsage_.set(UsageWarning::FoldingValueChecks);
  50   warnUsage_.set(UsageWarning::FoldingFailure);
  51   warnUsage_.set(UsageWarning::FoldingLimit);
  52   warnUsage_.set(UsageWarning::Interoperability);
  53   // CharacterInteroperability warnings about length are off by default
  54   warnUsage_.set(UsageWarning::Bounds);
  55   warnUsage_.set(UsageWarning::Preprocessing);
  56   warnUsage_.set(UsageWarning::Scanning);
  57   warnUsage_.set(UsageWarning::OpenAccUsage);
  58   warnUsage_.set(UsageWarning::ProcPointerCompatibility);
  59   warnUsage_.set(UsageWarning::VoidMold);
  60   warnUsage_.set(UsageWarning::KnownBadImplicitInterface);
  61   warnUsage_.set(UsageWarning::EmptyCase);
  62   warnUsage_.set(UsageWarning::CaseOverflow);
  63   warnUsage_.set(UsageWarning::CUDAUsage);
  64   warnUsage_.set(UsageWarning::IgnoreTKRUsage);
  65   warnUsage_.set(UsageWarning::ExternalInterfaceMismatch);
  66   warnUsage_.set(UsageWarning::DefinedOperatorArgs);
  67   warnUsage_.set(UsageWarning::Final);
  68   warnUsage_.set(UsageWarning::ZeroDoStep);
  69   warnUsage_.set(UsageWarning::UnusedForallIndex);
  70   warnUsage_.set(UsageWarning::OpenMPUsage);
  71   warnUsage_.set(UsageWarning::DataLength);
  72   warnUsage_.set(UsageWarning::IgnoredDirective);
  73   warnUsage_.set(UsageWarning::HomonymousSpecific);
  74   warnUsage_.set(UsageWarning::HomonymousResult);
  75   warnUsage_.set(UsageWarning::IgnoredIntrinsicFunctionType);
  76   warnUsage_.set(UsageWarning::PreviousScalarUse);
  77   warnUsage_.set(UsageWarning::RedeclaredInaccessibleComponent);
  78   warnUsage_.set(UsageWarning::ImplicitShared);
  79   warnUsage_.set(UsageWarning::IndexVarRedefinition);
  80   warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces);
  81   warnUsage_.set(UsageWarning::BadTypeForTarget);
  82   warnUsage_.set(UsageWarning::VectorSubscriptFinalization);
  83   warnUsage_.set(UsageWarning::UndefinedFunctionResult);
  84   warnUsage_.set(UsageWarning::UselessIomsg);
  85   // New warnings, on by default
  86   warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr);
  87 }
  88
  89 // Ignore case and any inserted punctuation (like '-'/'_')
  90 static std::optional<char> GetWarningChar(char ch) {
  91   if (ch >= 'a' && ch <= 'z') {
  92     return ch;
  93   } else if (ch >= 'A' && ch <= 'Z') {
  94     return ch - 'A' + 'a';
  95   } else if (ch >= '0' && ch <= '9') {
  96     return ch;
  97   } else {
  98     return std::nullopt;
  99   }
 100 }
 101
 102 static bool WarningNameMatch(const char *a, const char *b) {
 103   while (true) {
 104     auto ach{GetWarningChar(*a)};
 105     while (!ach && *a) {
 106       ach = GetWarningChar(*++a);
 107     }
 108     auto bch{GetWarningChar(*b)};
 109     while (!bch && *b) {
 110       bch = GetWarningChar(*++b);
 111     }
 112     if (!ach && !bch) {
 113       return true;
 114     } else if (!ach || !bch || *ach != *bch) {
 115       return false;
 116     }
 117     ++a, ++b;
 118   }
 119 }
 120
 121 template <typename ENUM, std::size_t N>
 122 std::optional<ENUM> ScanEnum(const char *name) {
 123   if (name) {
 124     for (std::size_t j{0}; j < N; ++j) {
 125       auto feature{static_cast<ENUM>(j)};
 126       if (WarningNameMatch(name, EnumToString(feature).data())) {
 127         return feature;
 128       }
 129     }
 130   }
 131   return std::nullopt;
 132 }
 133
 134 std::optional<LanguageFeature> FindLanguageFeature(const char *name) {
 135   return ScanEnum<LanguageFeature, LanguageFeature_enumSize>(name);
 136 }
 137
 138 std::optional<UsageWarning> FindUsageWarning(const char *name) {
 139   return ScanEnum<UsageWarning, UsageWarning_enumSize>(name);
 140 }
 141
 142 std::vector<const char *> LanguageFeatureControl::GetNames(
 143     LogicalOperator opr) const {
 144   std::vector<const char *> result;
 145   result.push_back(AsFortran(opr));
 146   if (opr == LogicalOperator::Neqv && IsEnabled(LanguageFeature::XOROperator)) {
 147     result.push_back(".xor.");
 148   }
 149   if (IsEnabled(LanguageFeature::LogicalAbbreviations)) {
 150     switch (opr) {
 151       SWITCH_COVERS_ALL_CASES
 152     case LogicalOperator::And:
 153       result.push_back(".a.");
 154       break;
 155     case LogicalOperator::Or:
 156       result.push_back(".o.");
 157       break;
 158     case LogicalOperator::Not:
 159       result.push_back(".n.");
 160       break;
 161     case LogicalOperator::Neqv:
 162       if (IsEnabled(LanguageFeature::XOROperator)) {
 163         result.push_back(".x.");
 164       }
 165       break;
 166     case LogicalOperator::Eqv:
 167       break;
 168     }
 169   }
 170   return result;
 171 }
 172
 173 std::vector<const char *> LanguageFeatureControl::GetNames(
 174     RelationalOperator opr) const {
 175   switch (opr) {
 176     SWITCH_COVERS_ALL_CASES
 177   case RelationalOperator::LT:
 178     return {".lt.", "<"};
 179   case RelationalOperator::LE:
 180     return {".le.", "<="};
 181   case RelationalOperator::EQ:
 182     return {".eq.", "=="};
 183   case RelationalOperator::GE:
 184     return {".ge.", ">="};
 185   case RelationalOperator::GT:
 186     return {".gt.", ">"};
 187   case RelationalOperator::NE:
 188     if (IsEnabled(LanguageFeature::AlternativeNE)) {
 189       return {".ne.", "/=", "<>"};
 190     } else {
 191       return {".ne.", "/="};
 192     }
 193   }
 194 }
 195
 196 } // namespace Fortran::common