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