flang/unittests/Evaluate/intrinsics.cpp

   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/target.h"
   6 #include "flang/Evaluate/tools.h"
   7 #include "flang/Parser/provenance.h"
   8 #include "llvm/Support/raw_ostream.h"
   9 #include <initializer_list>
  10 #include <map>
  11 #include <string>
  12
  13 namespace Fortran::evaluate {
  14
  15 class CookedStrings {
  16 public:
  17   CookedStrings() {}
  18   explicit CookedStrings(const std::initializer_list<std::string> &ss) {
  19     for (const auto &s : ss) {
  20       Save(s);
  21     }
  22     Marshal();
  23   }
  24   void Save(const std::string &s) {
  25     offsets_[s] = cooked_.Put(s);
  26     cooked_.PutProvenance(allSources_.AddCompilerInsertion(s));
  27   }
  28   void Marshal() { cooked_.Marshal(allCookedSources_); }
  29   parser::CharBlock operator()(const std::string &s) {
  30     return {cooked_.AsCharBlock().begin() + offsets_[s], s.size()};
  31   }
  32   parser::ContextualMessages Messages(parser::Messages &buffer) {
  33     return parser::ContextualMessages{cooked_.AsCharBlock(), &buffer};
  34   }
  35   void Emit(llvm::raw_ostream &o, const parser::Messages &messages) {
  36     messages.Emit(o, allCookedSources_);
  37   }
  38
  39 private:
  40   parser::AllSources allSources_;
  41   parser::AllCookedSources allCookedSources_{allSources_};
  42   parser::CookedSource &cooked_{allCookedSources_.NewCookedSource()};
  43   std::map<std::string, std::size_t> offsets_;
  44 };
  45
  46 template <typename A> auto Const(A &&x) -> Constant<TypeOf<A>> {
  47   return Constant<TypeOf<A>>{std::move(x)};
  48 }
  49
  50 template <typename A> struct NamedArg {
  51   std::string keyword;
  52   A value;
  53 };
  54
  55 template <typename A> static NamedArg<A> Named(std::string kw, A &&x) {
  56   return {kw, std::move(x)};
  57 }
  58
  59 struct TestCall {
  60   TestCall(const common::IntrinsicTypeDefaultKinds &d,
  61       const IntrinsicProcTable &t, std::string n)
  62       : defaults{d}, table{t}, name{n} {}
  63   template <typename A> TestCall &Push(A &&x) {
  64     args.emplace_back(AsGenericExpr(std::move(x)));
  65     keywords.push_back("");
  66     return *this;
  67   }
  68   template <typename A> TestCall &Push(NamedArg<A> &&x) {
  69     args.emplace_back(AsGenericExpr(std::move(x.value)));
  70     keywords.push_back(x.keyword);
  71     strings.Save(x.keyword);
  72     return *this;
  73   }
  74   template <typename A, typename... As> TestCall &Push(A &&x, As &&...xs) {
  75     Push(std::move(x));
  76     return Push(std::move(xs)...);
  77   }
  78   void Marshal() {
  79     strings.Save(name);
  80     strings.Marshal();
  81     std::size_t j{0};
  82     for (auto &kw : keywords) {
  83       if (!kw.empty()) {
  84         args[j]->set_keyword(strings(kw));
  85       }
  86       ++j;
  87     }
  88   }
  89   void DoCall(std::optional<DynamicType> resultType = std::nullopt,
  90       int rank = 0, bool isElemental = false) {
  91     Marshal();
  92     parser::CharBlock fName{strings(name)};
  93     llvm::outs() << "function: " << fName.ToString();
  94     char sep{'('};
  95     for (const auto &a : args) {
  96       llvm::outs() << sep;
  97       sep = ',';
  98       a->AsFortran(llvm::outs());
  99     }
 100     if (sep == '(') {
 101       llvm::outs() << '(';
 102     }
 103     llvm::outs() << ')' << '\n';
 104     llvm::outs().flush();
 105     CallCharacteristics call{fName.ToString()};
 106     auto messages{strings.Messages(buffer)};
 107     TargetCharacteristics targetCharacteristics;
 108     common::LanguageFeatureControl languageFeatures;
 109     FoldingContext context{messages, defaults, table, targetCharacteristics,
 110         languageFeatures, tempNames};
 111     std::optional<SpecificCall> si{table.Probe(call, args, context)};
 112     if (resultType.has_value()) {
 113       TEST(si.has_value());
 114       TEST(messages.messages() && !messages.messages()->AnyFatalError());
 115       if (si) {
 116         const auto &proc{si->specificIntrinsic.characteristics.value()};
 117         const auto &fr{proc.functionResult};
 118         TEST(fr.has_value());
 119         if (fr) {
 120           const auto *ts{fr->GetTypeAndShape()};
 121           TEST(ts != nullptr);
 122           if (ts) {
 123             TEST(*resultType == ts->type());
 124             MATCH(rank, ts->Rank());
 125           }
 126         }
 127         MATCH(isElemental,
 128             proc.attrs.test(characteristics::Procedure::Attr::Elemental));
 129       }
 130     } else {
 131       TEST(!si.has_value());
 132       TEST((messages.messages() && messages.messages()->AnyFatalError()) ||
 133           name == "bad");
 134     }
 135     strings.Emit(llvm::outs(), buffer);
 136   }
 137
 138   const common::IntrinsicTypeDefaultKinds &defaults;
 139   const IntrinsicProcTable &table;
 140   CookedStrings strings;
 141   parser::Messages buffer;
 142   ActualArguments args;
 143   std::string name;
 144   std::vector<std::string> keywords;
 145   std::set<std::string> tempNames;
 146 };
 147
 148 void TestIntrinsics() {
 149   common::IntrinsicTypeDefaultKinds defaults;
 150   MATCH(4, defaults.GetDefaultKind(TypeCategory::Integer));
 151   MATCH(4, defaults.GetDefaultKind(TypeCategory::Real));
 152   IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)};
 153   table.Dump(llvm::outs());
 154
 155   using Int1 = Type<TypeCategory::Integer, 1>;
 156   using Int4 = Type<TypeCategory::Integer, 4>;
 157   using Int8 = Type<TypeCategory::Integer, 8>;
 158   using Real4 = Type<TypeCategory::Real, 4>;
 159   using Real8 = Type<TypeCategory::Real, 8>;
 160   using Complex4 = Type<TypeCategory::Complex, 4>;
 161   using Complex8 = Type<TypeCategory::Complex, 8>;
 162   using Char = Type<TypeCategory::Character, 1>;
 163   using Log4 = Type<TypeCategory::Logical, 4>;
 164
 165   TestCall{defaults, table, "bad"}
 166       .Push(Const(Scalar<Int4>{}))
 167       .DoCall(); // bad intrinsic name
 168   TestCall{defaults, table, "abs"}
 169       .Push(Named("a", Const(Scalar<Int4>{})))
 170       .DoCall(Int4::GetType());
 171   TestCall{defaults, table, "abs"}
 172       .Push(Const(Scalar<Int4>{}))
 173       .DoCall(Int4::GetType());
 174   TestCall{defaults, table, "abs"}
 175       .Push(Named("bad", Const(Scalar<Int4>{})))
 176       .DoCall(); // bad keyword
 177   TestCall{defaults, table, "abs"}.DoCall(); // insufficient args
 178   TestCall{defaults, table, "abs"}
 179       .Push(Const(Scalar<Int4>{}))
 180       .Push(Const(Scalar<Int4>{}))
 181       .DoCall(); // too many args
 182   TestCall{defaults, table, "abs"}
 183       .Push(Const(Scalar<Int4>{}))
 184       .Push(Named("a", Const(Scalar<Int4>{})))
 185       .DoCall();
 186   TestCall{defaults, table, "abs"}
 187       .Push(Named("a", Const(Scalar<Int4>{})))
 188       .Push(Const(Scalar<Int4>{}))
 189       .DoCall();
 190   TestCall{defaults, table, "abs"}
 191       .Push(Const(Scalar<Int1>{}))
 192       .DoCall(Int1::GetType());
 193   TestCall{defaults, table, "abs"}
 194       .Push(Const(Scalar<Int4>{}))
 195       .DoCall(Int4::GetType());
 196   TestCall{defaults, table, "abs"}
 197       .Push(Const(Scalar<Int8>{}))
 198       .DoCall(Int8::GetType());
 199   TestCall{defaults, table, "abs"}
 200       .Push(Const(Scalar<Real4>{}))
 201       .DoCall(Real4::GetType());
 202   TestCall{defaults, table, "abs"}
 203       .Push(Const(Scalar<Real8>{}))
 204       .DoCall(Real8::GetType());
 205   TestCall{defaults, table, "abs"}
 206       .Push(Const(Scalar<Complex4>{}))
 207       .DoCall(Real4::GetType());
 208   TestCall{defaults, table, "abs"}
 209       .Push(Const(Scalar<Complex8>{}))
 210       .DoCall(Real8::GetType());
 211   TestCall{defaults, table, "abs"}.Push(Const(Scalar<Char>{})).DoCall();
 212   TestCall{defaults, table, "abs"}.Push(Const(Scalar<Log4>{})).DoCall();
 213
 214   // "Ext" in names for calls allowed as extensions
 215   TestCall maxCallR{defaults, table, "max"}, maxCallI{defaults, table, "min"},
 216       max0Call{defaults, table, "max0"}, max1Call{defaults, table, "max1"},
 217       amin0Call{defaults, table, "amin0"}, amin1Call{defaults, table, "amin1"},
 218       max0ExtCall{defaults, table, "max0"},
 219       amin1ExtCall{defaults, table, "amin1"};
 220   for (int j{0}; j < 10; ++j) {
 221     maxCallR.Push(Const(Scalar<Real4>{}));
 222     maxCallI.Push(Const(Scalar<Int4>{}));
 223     max0Call.Push(Const(Scalar<Int4>{}));
 224     max0ExtCall.Push(Const(Scalar<Real4>{}));
 225     max1Call.Push(Const(Scalar<Real4>{}));
 226     amin0Call.Push(Const(Scalar<Int4>{}));
 227     amin1ExtCall.Push(Const(Scalar<Int4>{}));
 228     amin1Call.Push(Const(Scalar<Real4>{}));
 229   }
 230   maxCallR.DoCall(Real4::GetType());
 231   maxCallI.DoCall(Int4::GetType());
 232   max0Call.DoCall(Int4::GetType());
 233   max0ExtCall.DoCall(Int4::GetType());
 234   max1Call.DoCall(Int4::GetType());
 235   amin0Call.DoCall(Real4::GetType());
 236   amin1Call.DoCall(Real4::GetType());
 237   amin1ExtCall.DoCall(Real4::GetType());
 238
 239   TestCall{defaults, table, "conjg"}
 240       .Push(Const(Scalar<Complex4>{}))
 241       .DoCall(Complex4::GetType());
 242   TestCall{defaults, table, "conjg"}
 243       .Push(Const(Scalar<Complex8>{}))
 244       .DoCall(Complex8::GetType());
 245   TestCall{defaults, table, "dconjg"}
 246       .Push(Const(Scalar<Complex8>{}))
 247       .DoCall(Complex8::GetType());
 248
 249   TestCall{defaults, table, "float"}.Push(Const(Scalar<Real4>{})).DoCall();
 250   TestCall{defaults, table, "float"}
 251       .Push(Const(Scalar<Int4>{}))
 252       .DoCall(Real4::GetType());
 253   TestCall{defaults, table, "idint"}.Push(Const(Scalar<Int4>{})).DoCall();
 254   TestCall{defaults, table, "idint"}
 255       .Push(Const(Scalar<Real8>{}))
 256       .DoCall(Int4::GetType());
 257
 258   // Allowed as extensions
 259   TestCall{defaults, table, "float"}
 260       .Push(Const(Scalar<Int8>{}))
 261       .DoCall(Real4::GetType());
 262   TestCall{defaults, table, "idint"}
 263       .Push(Const(Scalar<Real4>{}))
 264       .DoCall(Int4::GetType());
 265
 266   TestCall{defaults, table, "num_images"}.DoCall(Int4::GetType());
 267   TestCall{defaults, table, "num_images"}
 268       .Push(Const(Scalar<Int1>{}))
 269       .DoCall(Int4::GetType());
 270   TestCall{defaults, table, "num_images"}
 271       .Push(Const(Scalar<Int4>{}))
 272       .DoCall(Int4::GetType());
 273   TestCall{defaults, table, "num_images"}
 274       .Push(Const(Scalar<Int8>{}))
 275       .DoCall(Int4::GetType());
 276   TestCall{defaults, table, "num_images"}
 277       .Push(Named("team_number", Const(Scalar<Int4>{})))
 278       .DoCall(Int4::GetType());
 279   TestCall{defaults, table, "num_images"}
 280       .Push(Const(Scalar<Int4>{}))
 281       .Push(Const(Scalar<Int4>{}))
 282       .DoCall(); // too many args
 283   TestCall{defaults, table, "num_images"}
 284       .Push(Named("bad", Const(Scalar<Int4>{})))
 285       .DoCall(); // bad keyword
 286   TestCall{defaults, table, "num_images"}
 287       .Push(Const(Scalar<Char>{}))
 288       .DoCall(); // bad type
 289   TestCall{defaults, table, "num_images"}
 290       .Push(Const(Scalar<Log4>{}))
 291       .DoCall(); // bad type
 292   TestCall{defaults, table, "num_images"}
 293       .Push(Const(Scalar<Complex8>{}))
 294       .DoCall(); // bad type
 295   TestCall{defaults, table, "num_images"}
 296       .Push(Const(Scalar<Real4>{}))
 297       .DoCall(); // bad type
 298
 299   // This test temporarily removed because it requires access to
 300   // the ISO_FORTRAN_ENV intrinsic module. This module should to
 301   // be loaded (somehow) and the following test reinstated.
 302   // TestCall{defaults, table, "team_number"}.DoCall(Int4::GetType());
 303
 304   TestCall{defaults, table, "team_number"}
 305       .Push(Const(Scalar<Int4>{}))
 306       .Push(Const(Scalar<Int4>{}))
 307       .DoCall(); // too many args
 308   TestCall{defaults, table, "team_number"}
 309       .Push(Named("bad", Const(Scalar<Int4>{})))
 310       .DoCall(); // bad keyword
 311   TestCall{defaults, table, "team_number"}
 312       .Push(Const(Scalar<Int4>{}))
 313       .DoCall(); // bad type
 314   TestCall{defaults, table, "team_number"}
 315       .Push(Const(Scalar<Char>{}))
 316       .DoCall(); // bad type
 317   TestCall{defaults, table, "team_number"}
 318       .Push(Const(Scalar<Log4>{}))
 319       .DoCall(); // bad type
 320   TestCall{defaults, table, "team_number"}
 321       .Push(Const(Scalar<Complex8>{}))
 322       .DoCall(); // bad type
 323   TestCall{defaults, table, "team_number"}
 324       .Push(Const(Scalar<Real4>{}))
 325       .DoCall(); // bad type
 326
 327   // TODO: test other intrinsics
 328
 329   // Test unrestricted specific to generic name mapping (table 16.2).
 330   TEST(table.GetGenericIntrinsicName("alog") == "log");
 331   TEST(table.GetGenericIntrinsicName("alog10") == "log10");
 332   TEST(table.GetGenericIntrinsicName("amod") == "mod");
 333   TEST(table.GetGenericIntrinsicName("cabs") == "abs");
 334   TEST(table.GetGenericIntrinsicName("ccos") == "cos");
 335   TEST(table.GetGenericIntrinsicName("cexp") == "exp");
 336   TEST(table.GetGenericIntrinsicName("clog") == "log");
 337   TEST(table.GetGenericIntrinsicName("csin") == "sin");
 338   TEST(table.GetGenericIntrinsicName("csqrt") == "sqrt");
 339   TEST(table.GetGenericIntrinsicName("dabs") == "abs");
 340   TEST(table.GetGenericIntrinsicName("dacos") == "acos");
 341   TEST(table.GetGenericIntrinsicName("dasin") == "asin");
 342   TEST(table.GetGenericIntrinsicName("datan") == "atan");
 343   TEST(table.GetGenericIntrinsicName("datan2") == "atan2");
 344   TEST(table.GetGenericIntrinsicName("dcos") == "cos");
 345   TEST(table.GetGenericIntrinsicName("dcosh") == "cosh");
 346   TEST(table.GetGenericIntrinsicName("ddim") == "dim");
 347   TEST(table.GetGenericIntrinsicName("derf") == "erf");
 348   TEST(table.GetGenericIntrinsicName("dexp") == "exp");
 349   TEST(table.GetGenericIntrinsicName("dint") == "aint");
 350   TEST(table.GetGenericIntrinsicName("dlog") == "log");
 351   TEST(table.GetGenericIntrinsicName("dlog10") == "log10");
 352   TEST(table.GetGenericIntrinsicName("dmod") == "mod");
 353   TEST(table.GetGenericIntrinsicName("dnint") == "anint");
 354   TEST(table.GetGenericIntrinsicName("dsign") == "sign");
 355   TEST(table.GetGenericIntrinsicName("dsin") == "sin");
 356   TEST(table.GetGenericIntrinsicName("dsinh") == "sinh");
 357   TEST(table.GetGenericIntrinsicName("dsqrt") == "sqrt");
 358   TEST(table.GetGenericIntrinsicName("dtan") == "tan");
 359   TEST(table.GetGenericIntrinsicName("dtanh") == "tanh");
 360   TEST(table.GetGenericIntrinsicName("iabs") == "abs");
 361   TEST(table.GetGenericIntrinsicName("idim") == "dim");
 362   TEST(table.GetGenericIntrinsicName("idnint") == "nint");
 363   TEST(table.GetGenericIntrinsicName("isign") == "sign");
 364   // Test a case where specific and generic name are the same.
 365   TEST(table.GetGenericIntrinsicName("acos") == "acos");
 366 }
 367 } // namespace Fortran::evaluate
 368
 369 int main() {
 370   Fortran::evaluate::TestIntrinsics();
 371   return testing::Complete();
 372 }