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