xref: /llvm-project/flang/unittests/Evaluate/intrinsics.cpp (revision 181eab27d244b9a9eb32d6716f9c38f7f3723356) 
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("dexp") == "exp");
348   TEST(table.GetGenericIntrinsicName("dint") == "aint");
349   TEST(table.GetGenericIntrinsicName("dlog") == "log");
350   TEST(table.GetGenericIntrinsicName("dlog10") == "log10");
351   TEST(table.GetGenericIntrinsicName("dmod") == "mod");
352   TEST(table.GetGenericIntrinsicName("dnint") == "anint");
353   TEST(table.GetGenericIntrinsicName("dsign") == "sign");
354   TEST(table.GetGenericIntrinsicName("dsin") == "sin");
355   TEST(table.GetGenericIntrinsicName("dsinh") == "sinh");
356   TEST(table.GetGenericIntrinsicName("dsqrt") == "sqrt");
357   TEST(table.GetGenericIntrinsicName("dtan") == "tan");
358   TEST(table.GetGenericIntrinsicName("dtanh") == "tanh");
359   TEST(table.GetGenericIntrinsicName("iabs") == "abs");
360   TEST(table.GetGenericIntrinsicName("idim") == "dim");
361   TEST(table.GetGenericIntrinsicName("idnint") == "nint");
362   TEST(table.GetGenericIntrinsicName("isign") == "sign");
363   // Test a case where specific and generic name are the same.
364   TEST(table.GetGenericIntrinsicName("acos") == "acos");
365 }
366 } // namespace Fortran::evaluate
367 
368 int main() {
369   Fortran::evaluate::TestIntrinsics();
370   return testing::Complete();
371 }
372