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 warnLanguage_.set(LanguageFeature::IgnoreIrrelevantAttributes); 47 warnUsage_.set(UsageWarning::ShortArrayActual); 48 warnUsage_.set(UsageWarning::FoldingException); 49 warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash); 50 warnUsage_.set(UsageWarning::FoldingValueChecks); 51 warnUsage_.set(UsageWarning::FoldingFailure); 52 warnUsage_.set(UsageWarning::FoldingLimit); 53 warnUsage_.set(UsageWarning::Interoperability); 54 // CharacterInteroperability warnings about length are off by default 55 warnUsage_.set(UsageWarning::Bounds); 56 warnUsage_.set(UsageWarning::Preprocessing); 57 warnUsage_.set(UsageWarning::Scanning); 58 warnUsage_.set(UsageWarning::OpenAccUsage); 59 warnUsage_.set(UsageWarning::ProcPointerCompatibility); 60 warnUsage_.set(UsageWarning::VoidMold); 61 warnUsage_.set(UsageWarning::KnownBadImplicitInterface); 62 warnUsage_.set(UsageWarning::EmptyCase); 63 warnUsage_.set(UsageWarning::CaseOverflow); 64 warnUsage_.set(UsageWarning::CUDAUsage); 65 warnUsage_.set(UsageWarning::IgnoreTKRUsage); 66 warnUsage_.set(UsageWarning::ExternalInterfaceMismatch); 67 warnUsage_.set(UsageWarning::DefinedOperatorArgs); 68 warnUsage_.set(UsageWarning::Final); 69 warnUsage_.set(UsageWarning::ZeroDoStep); 70 warnUsage_.set(UsageWarning::UnusedForallIndex); 71 warnUsage_.set(UsageWarning::OpenMPUsage); 72 warnUsage_.set(UsageWarning::DataLength); 73 warnUsage_.set(UsageWarning::IgnoredDirective); 74 warnUsage_.set(UsageWarning::HomonymousSpecific); 75 warnUsage_.set(UsageWarning::HomonymousResult); 76 warnUsage_.set(UsageWarning::IgnoredIntrinsicFunctionType); 77 warnUsage_.set(UsageWarning::PreviousScalarUse); 78 warnUsage_.set(UsageWarning::RedeclaredInaccessibleComponent); 79 warnUsage_.set(UsageWarning::ImplicitShared); 80 warnUsage_.set(UsageWarning::IndexVarRedefinition); 81 warnUsage_.set(UsageWarning::IncompatibleImplicitInterfaces); 82 warnUsage_.set(UsageWarning::BadTypeForTarget); 83 warnUsage_.set(UsageWarning::VectorSubscriptFinalization); 84 warnUsage_.set(UsageWarning::UndefinedFunctionResult); 85 warnUsage_.set(UsageWarning::UselessIomsg); 86 warnUsage_.set(UsageWarning::UnsignedLiteralTruncation); 87 // New warnings, on by default 88 warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr); 89 } 90 91 // Ignore case and any inserted punctuation (like '-'/'_') 92 static std::optional<char> GetWarningChar(char ch) { 93 if (ch >= 'a' && ch <= 'z') { 94 return ch; 95 } else if (ch >= 'A' && ch <= 'Z') { 96 return ch - 'A' + 'a'; 97 } else if (ch >= '0' && ch <= '9') { 98 return ch; 99 } else { 100 return std::nullopt; 101 } 102 } 103 104 static bool WarningNameMatch(const char *a, const char *b) { 105 while (true) { 106 auto ach{GetWarningChar(*a)}; 107 while (!ach && *a) { 108 ach = GetWarningChar(*++a); 109 } 110 auto bch{GetWarningChar(*b)}; 111 while (!bch && *b) { 112 bch = GetWarningChar(*++b); 113 } 114 if (!ach && !bch) { 115 return true; 116 } else if (!ach || !bch || *ach != *bch) { 117 return false; 118 } 119 ++a, ++b; 120 } 121 } 122 123 template <typename ENUM, std::size_t N> 124 std::optional<ENUM> ScanEnum(const char *name) { 125 if (name) { 126 for (std::size_t j{0}; j < N; ++j) { 127 auto feature{static_cast<ENUM>(j)}; 128 if (WarningNameMatch(name, EnumToString(feature).data())) { 129 return feature; 130 } 131 } 132 } 133 return std::nullopt; 134 } 135 136 std::optional<LanguageFeature> FindLanguageFeature(const char *name) { 137 return ScanEnum<LanguageFeature, LanguageFeature_enumSize>(name); 138 } 139 140 std::optional<UsageWarning> FindUsageWarning(const char *name) { 141 return ScanEnum<UsageWarning, UsageWarning_enumSize>(name); 142 } 143 144 std::vector<const char *> LanguageFeatureControl::GetNames( 145 LogicalOperator opr) const { 146 std::vector<const char *> result; 147 result.push_back(AsFortran(opr)); 148 if (opr == LogicalOperator::Neqv && IsEnabled(LanguageFeature::XOROperator)) { 149 result.push_back(".xor."); 150 } 151 if (IsEnabled(LanguageFeature::LogicalAbbreviations)) { 152 switch (opr) { 153 SWITCH_COVERS_ALL_CASES 154 case LogicalOperator::And: 155 result.push_back(".a."); 156 break; 157 case LogicalOperator::Or: 158 result.push_back(".o."); 159 break; 160 case LogicalOperator::Not: 161 result.push_back(".n."); 162 break; 163 case LogicalOperator::Neqv: 164 if (IsEnabled(LanguageFeature::XOROperator)) { 165 result.push_back(".x."); 166 } 167 break; 168 case LogicalOperator::Eqv: 169 break; 170 } 171 } 172 return result; 173 } 174 175 std::vector<const char *> LanguageFeatureControl::GetNames( 176 RelationalOperator opr) const { 177 switch (opr) { 178 SWITCH_COVERS_ALL_CASES 179 case RelationalOperator::LT: 180 return {".lt.", "<"}; 181 case RelationalOperator::LE: 182 return {".le.", "<="}; 183 case RelationalOperator::EQ: 184 return {".eq.", "=="}; 185 case RelationalOperator::GE: 186 return {".ge.", ">="}; 187 case RelationalOperator::GT: 188 return {".gt.", ">"}; 189 case RelationalOperator::NE: 190 if (IsEnabled(LanguageFeature::AlternativeNE)) { 191 return {".ne.", "/=", "<>"}; 192 } else { 193 return {".ne.", "/="}; 194 } 195 } 196 } 197 198 } // namespace Fortran::common 199