373 lines · cpp
1#include "flang/Evaluate/intrinsics.h"2#include "flang/Evaluate/common.h"3#include "flang/Evaluate/expression.h"4#include "flang/Evaluate/target.h"5#include "flang/Evaluate/tools.h"6#include "flang/Parser/provenance.h"7#include "flang/Testing/testing.h"8#include "llvm/Support/raw_ostream.h"9#include <initializer_list>10#include <map>11#include <string>12 13namespace Fortran::evaluate {14 15class CookedStrings {16public: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 39private: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 46template <typename A> auto Const(A &&x) -> Constant<TypeOf<A>> {47 return Constant<TypeOf<A>>{std::move(x)};48}49 50template <typename A> struct NamedArg {51 std::string keyword;52 A value;53};54 55template <typename A> static NamedArg<A> Named(std::string kw, A &&x) {56 return {kw, std::move(x)};57}58 59struct 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 148void 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 name168 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 keyword177 TestCall{defaults, table, "abs"}.DoCall(); // insufficient args178 TestCall{defaults, table, "abs"}179 .Push(Const(Scalar<Int4>{}))180 .Push(Const(Scalar<Int4>{}))181 .DoCall(); // too many args182 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 extensions215 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 extensions259 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 args283 TestCall{defaults, table, "num_images"}284 .Push(Named("bad", Const(Scalar<Int4>{})))285 .DoCall(); // bad keyword286 TestCall{defaults, table, "num_images"}287 .Push(Const(Scalar<Char>{}))288 .DoCall(); // bad type289 TestCall{defaults, table, "num_images"}290 .Push(Const(Scalar<Log4>{}))291 .DoCall(); // bad type292 TestCall{defaults, table, "num_images"}293 .Push(Const(Scalar<Complex8>{}))294 .DoCall(); // bad type295 TestCall{defaults, table, "num_images"}296 .Push(Const(Scalar<Real4>{}))297 .DoCall(); // bad type298 299 // This test temporarily removed because it requires access to300 // the ISO_FORTRAN_ENV intrinsic module. This module should to301 // 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 args308 TestCall{defaults, table, "team_number"}309 .Push(Named("bad", Const(Scalar<Int4>{})))310 .DoCall(); // bad keyword311 TestCall{defaults, table, "team_number"}312 .Push(Const(Scalar<Int4>{}))313 .DoCall(); // bad type314 TestCall{defaults, table, "team_number"}315 .Push(Const(Scalar<Char>{}))316 .DoCall(); // bad type317 TestCall{defaults, table, "team_number"}318 .Push(Const(Scalar<Log4>{}))319 .DoCall(); // bad type320 TestCall{defaults, table, "team_number"}321 .Push(Const(Scalar<Complex8>{}))322 .DoCall(); // bad type323 TestCall{defaults, table, "team_number"}324 .Push(Const(Scalar<Real4>{}))325 .DoCall(); // bad type326 327 // TODO: test other intrinsics328 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::evaluate368 369int main() {370 Fortran::evaluate::TestIntrinsics();371 return testing::Complete();372}373