1 #include "flang/Evaluate/intrinsics.h" 2 #include "testing.h" 3 #include "flang/Evaluate/common.h" 4 #include "flang/Evaluate/expression.h" 5 #include "flang/Evaluate/tools.h" 6 #include "flang/Parser/provenance.h" 7 #include "llvm/Support/raw_ostream.h" 8 #include <initializer_list> 9 #include <map> 10 #include <string> 11 12 namespace Fortran::evaluate { 13 14 class CookedStrings { 15 public: 16 CookedStrings() {} 17 explicit CookedStrings(const std::initializer_list<std::string> &ss) { 18 for (const auto &s : ss) { 19 Save(s); 20 } 21 Marshal(); 22 } 23 void Save(const std::string &s) { 24 offsets_[s] = cooked_.Put(s); 25 cooked_.PutProvenance(cooked_.allSources().AddCompilerInsertion(s)); 26 } 27 void Marshal() { cooked_.Marshal(); } 28 parser::CharBlock operator()(const std::string &s) { 29 return {cooked_.data().data() + offsets_[s], s.size()}; 30 } 31 parser::ContextualMessages Messages(parser::Messages &buffer) { 32 return parser::ContextualMessages{cooked_.data(), &buffer}; 33 } 34 void Emit(llvm::raw_ostream &o, const parser::Messages &messages) { 35 messages.Emit(o, cooked_); 36 } 37 38 private: 39 parser::AllSources allSources_; 40 parser::CookedSource cooked_{allSources_}; 41 std::map<std::string, std::size_t> offsets_; 42 }; 43 44 template <typename A> auto Const(A &&x) -> Constant<TypeOf<A>> { 45 return Constant<TypeOf<A>>{std::move(x)}; 46 } 47 48 template <typename A> struct NamedArg { 49 std::string keyword; 50 A value; 51 }; 52 53 template <typename A> static NamedArg<A> Named(std::string kw, A &&x) { 54 return {kw, std::move(x)}; 55 } 56 57 struct TestCall { 58 TestCall(const common::IntrinsicTypeDefaultKinds &d, 59 const IntrinsicProcTable &t, std::string n) 60 : defaults{d}, table{t}, name{n} {} 61 template <typename A> TestCall &Push(A &&x) { 62 args.emplace_back(AsGenericExpr(std::move(x))); 63 keywords.push_back(""); 64 return *this; 65 } 66 template <typename A> TestCall &Push(NamedArg<A> &&x) { 67 args.emplace_back(AsGenericExpr(std::move(x.value))); 68 keywords.push_back(x.keyword); 69 strings.Save(x.keyword); 70 return *this; 71 } 72 template <typename A, typename... As> TestCall &Push(A &&x, As &&... xs) { 73 Push(std::move(x)); 74 return Push(std::move(xs)...); 75 } 76 void Marshal() { 77 strings.Save(name); 78 strings.Marshal(); 79 std::size_t j{0}; 80 for (auto &kw : keywords) { 81 if (!kw.empty()) { 82 args[j]->set_keyword(strings(kw)); 83 } 84 ++j; 85 } 86 } 87 void DoCall(std::optional<DynamicType> resultType = std::nullopt, 88 int rank = 0, bool isElemental = false) { 89 Marshal(); 90 parser::CharBlock fName{strings(name)}; 91 llvm::outs() << "function: " << fName.ToString(); 92 char sep{'('}; 93 for (const auto &a : args) { 94 llvm::outs() << sep; 95 sep = ','; 96 a->AsFortran(llvm::outs()); 97 } 98 if (sep == '(') { 99 llvm::outs() << '('; 100 } 101 llvm::outs() << ')' << '\n'; 102 llvm::outs().flush(); 103 CallCharacteristics call{fName.ToString()}; 104 auto messages{strings.Messages(buffer)}; 105 FoldingContext context{messages, defaults, table}; 106 std::optional<SpecificCall> si{table.Probe(call, args, context)}; 107 if (resultType.has_value()) { 108 TEST(si.has_value()); 109 TEST(messages.messages() && !messages.messages()->AnyFatalError()); 110 if (si) { 111 const auto &proc{si->specificIntrinsic.characteristics.value()}; 112 const auto &fr{proc.functionResult}; 113 TEST(fr.has_value()); 114 if (fr) { 115 const auto *ts{fr->GetTypeAndShape()}; 116 TEST(ts != nullptr); 117 if (ts) { 118 TEST(*resultType == ts->type()); 119 MATCH(rank, ts->Rank()); 120 } 121 } 122 MATCH(isElemental, 123 proc.attrs.test(characteristics::Procedure::Attr::Elemental)); 124 } 125 } else { 126 TEST(!si.has_value()); 127 TEST((messages.messages() && messages.messages()->AnyFatalError()) || 128 name == "bad"); 129 } 130 strings.Emit(llvm::outs(), buffer); 131 } 132 133 const common::IntrinsicTypeDefaultKinds &defaults; 134 const IntrinsicProcTable &table; 135 CookedStrings strings; 136 parser::Messages buffer; 137 ActualArguments args; 138 std::string name; 139 std::vector<std::string> keywords; 140 }; 141 142 void TestIntrinsics() { 143 common::IntrinsicTypeDefaultKinds defaults; 144 MATCH(4, defaults.GetDefaultKind(TypeCategory::Integer)); 145 MATCH(4, defaults.GetDefaultKind(TypeCategory::Real)); 146 IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)}; 147 table.Dump(llvm::outs()); 148 149 using Int1 = Type<TypeCategory::Integer, 1>; 150 using Int4 = Type<TypeCategory::Integer, 4>; 151 using Int8 = Type<TypeCategory::Integer, 8>; 152 using Real4 = Type<TypeCategory::Real, 4>; 153 using Real8 = Type<TypeCategory::Real, 8>; 154 using Complex4 = Type<TypeCategory::Complex, 4>; 155 using Complex8 = Type<TypeCategory::Complex, 8>; 156 using Char = Type<TypeCategory::Character, 1>; 157 using Log4 = Type<TypeCategory::Logical, 4>; 158 159 TestCall{defaults, table, "bad"} 160 .Push(Const(Scalar<Int4>{})) 161 .DoCall(); // bad intrinsic name 162 TestCall{defaults, table, "abs"} 163 .Push(Named("a", Const(Scalar<Int4>{}))) 164 .DoCall(Int4::GetType()); 165 TestCall{defaults, table, "abs"} 166 .Push(Const(Scalar<Int4>{})) 167 .DoCall(Int4::GetType()); 168 TestCall{defaults, table, "abs"} 169 .Push(Named("bad", Const(Scalar<Int4>{}))) 170 .DoCall(); // bad keyword 171 TestCall{defaults, table, "abs"}.DoCall(); // insufficient args 172 TestCall{defaults, table, "abs"} 173 .Push(Const(Scalar<Int4>{})) 174 .Push(Const(Scalar<Int4>{})) 175 .DoCall(); // too many args 176 TestCall{defaults, table, "abs"} 177 .Push(Const(Scalar<Int4>{})) 178 .Push(Named("a", Const(Scalar<Int4>{}))) 179 .DoCall(); 180 TestCall{defaults, table, "abs"} 181 .Push(Named("a", Const(Scalar<Int4>{}))) 182 .Push(Const(Scalar<Int4>{})) 183 .DoCall(); 184 TestCall{defaults, table, "abs"} 185 .Push(Const(Scalar<Int1>{})) 186 .DoCall(Int1::GetType()); 187 TestCall{defaults, table, "abs"} 188 .Push(Const(Scalar<Int4>{})) 189 .DoCall(Int4::GetType()); 190 TestCall{defaults, table, "abs"} 191 .Push(Const(Scalar<Int8>{})) 192 .DoCall(Int8::GetType()); 193 TestCall{defaults, table, "abs"} 194 .Push(Const(Scalar<Real4>{})) 195 .DoCall(Real4::GetType()); 196 TestCall{defaults, table, "abs"} 197 .Push(Const(Scalar<Real8>{})) 198 .DoCall(Real8::GetType()); 199 TestCall{defaults, table, "abs"} 200 .Push(Const(Scalar<Complex4>{})) 201 .DoCall(Real4::GetType()); 202 TestCall{defaults, table, "abs"} 203 .Push(Const(Scalar<Complex8>{})) 204 .DoCall(Real8::GetType()); 205 TestCall{defaults, table, "abs"}.Push(Const(Scalar<Char>{})).DoCall(); 206 TestCall{defaults, table, "abs"}.Push(Const(Scalar<Log4>{})).DoCall(); 207 208 // "Ext" in names for calls allowed as extensions 209 TestCall maxCallR{defaults, table, "max"}, maxCallI{defaults, table, "min"}, 210 max0Call{defaults, table, "max0"}, max1Call{defaults, table, "max1"}, 211 amin0Call{defaults, table, "amin0"}, amin1Call{defaults, table, "amin1"}, 212 max0ExtCall{defaults, table, "max0"}, 213 amin1ExtCall{defaults, table, "amin1"}; 214 for (int j{0}; j < 10; ++j) { 215 maxCallR.Push(Const(Scalar<Real4>{})); 216 maxCallI.Push(Const(Scalar<Int4>{})); 217 max0Call.Push(Const(Scalar<Int4>{})); 218 max0ExtCall.Push(Const(Scalar<Real4>{})); 219 max1Call.Push(Const(Scalar<Real4>{})); 220 amin0Call.Push(Const(Scalar<Int4>{})); 221 amin1ExtCall.Push(Const(Scalar<Int4>{})); 222 amin1Call.Push(Const(Scalar<Real4>{})); 223 } 224 maxCallR.DoCall(Real4::GetType()); 225 maxCallI.DoCall(Int4::GetType()); 226 max0Call.DoCall(Int4::GetType()); 227 max0ExtCall.DoCall(Int4::GetType()); 228 max1Call.DoCall(Int4::GetType()); 229 amin0Call.DoCall(Real4::GetType()); 230 amin1Call.DoCall(Real4::GetType()); 231 amin1ExtCall.DoCall(Real4::GetType()); 232 233 TestCall{defaults, table, "conjg"} 234 .Push(Const(Scalar<Complex4>{})) 235 .DoCall(Complex4::GetType()); 236 TestCall{defaults, table, "conjg"} 237 .Push(Const(Scalar<Complex8>{})) 238 .DoCall(Complex8::GetType()); 239 TestCall{defaults, table, "dconjg"}.Push(Const(Scalar<Complex4>{})).DoCall(); 240 TestCall{defaults, table, "dconjg"} 241 .Push(Const(Scalar<Complex8>{})) 242 .DoCall(Complex8::GetType()); 243 244 TestCall{defaults, table, "float"}.Push(Const(Scalar<Real4>{})).DoCall(); 245 TestCall{defaults, table, "float"} 246 .Push(Const(Scalar<Int4>{})) 247 .DoCall(Real4::GetType()); 248 TestCall{defaults, table, "idint"}.Push(Const(Scalar<Int4>{})).DoCall(); 249 TestCall{defaults, table, "idint"} 250 .Push(Const(Scalar<Real8>{})) 251 .DoCall(Int4::GetType()); 252 253 // Allowed as extensions 254 TestCall{defaults, table, "float"} 255 .Push(Const(Scalar<Int8>{})) 256 .DoCall(Real4::GetType()); 257 TestCall{defaults, table, "idint"} 258 .Push(Const(Scalar<Real4>{})) 259 .DoCall(Int4::GetType()); 260 261 TestCall{defaults, table, "num_images"}.DoCall(Int4::GetType()); 262 TestCall{defaults, table, "num_images"} 263 .Push(Const(Scalar<Int1>{})) 264 .DoCall(Int4::GetType()); 265 TestCall{defaults, table, "num_images"} 266 .Push(Const(Scalar<Int4>{})) 267 .DoCall(Int4::GetType()); 268 TestCall{defaults, table, "num_images"} 269 .Push(Const(Scalar<Int8>{})) 270 .DoCall(Int4::GetType()); 271 TestCall{defaults, table, "num_images"} 272 .Push(Named("team_number", Const(Scalar<Int4>{}))) 273 .DoCall(Int4::GetType()); 274 TestCall{defaults, table, "num_images"} 275 .Push(Const(Scalar<Int4>{})) 276 .Push(Const(Scalar<Int4>{})) 277 .DoCall(); // too many args 278 TestCall{defaults, table, "num_images"} 279 .Push(Named("bad", Const(Scalar<Int4>{}))) 280 .DoCall(); // bad keyword 281 TestCall{defaults, table, "num_images"} 282 .Push(Const(Scalar<Char>{})) 283 .DoCall(); // bad type 284 TestCall{defaults, table, "num_images"} 285 .Push(Const(Scalar<Log4>{})) 286 .DoCall(); // bad type 287 TestCall{defaults, table, "num_images"} 288 .Push(Const(Scalar<Complex8>{})) 289 .DoCall(); // bad type 290 TestCall{defaults, table, "num_images"} 291 .Push(Const(Scalar<Real4>{})) 292 .DoCall(); // bad type 293 294 // TODO: test other intrinsics 295 } 296 } // namespace Fortran::evaluate 297 298 int main() { 299 Fortran::evaluate::TestIntrinsics(); 300 return testing::Complete(); 301 } 302