llvm-project/flang/unittests/Evaluate/intrinsics.cpp

268 lines
8.7 KiB
C++

#include "flang/Evaluate/intrinsics.h"
#include "testing.h"
#include "flang/Evaluate/common.h"
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/provenance.h"
#include "llvm/Support/raw_ostream.h"
#include <initializer_list>
#include <map>
#include <string>
namespace Fortran::evaluate {
class CookedStrings {
public:
CookedStrings() {}
explicit CookedStrings(const std::initializer_list<std::string> &ss) {
for (const auto &s : ss) {
Save(s);
}
Marshal();
}
void Save(const std::string &s) {
offsets_[s] = cooked_.Put(s);
cooked_.PutProvenance(cooked_.allSources().AddCompilerInsertion(s));
}
void Marshal() { cooked_.Marshal(); }
parser::CharBlock operator()(const std::string &s) {
return {cooked_.data().data() + offsets_[s], s.size()};
}
parser::ContextualMessages Messages(parser::Messages &buffer) {
return parser::ContextualMessages{cooked_.data(), &buffer};
}
void Emit(llvm::raw_ostream &o, const parser::Messages &messages) {
messages.Emit(o, cooked_);
}
private:
parser::AllSources allSources_;
parser::CookedSource cooked_{allSources_};
std::map<std::string, std::size_t> offsets_;
};
template <typename A> auto Const(A &&x) -> Constant<TypeOf<A>> {
return Constant<TypeOf<A>>{std::move(x)};
}
template <typename A> struct NamedArg {
std::string keyword;
A value;
};
template <typename A> static NamedArg<A> Named(std::string kw, A &&x) {
return {kw, std::move(x)};
}
struct TestCall {
TestCall(const common::IntrinsicTypeDefaultKinds &d,
const IntrinsicProcTable &t, std::string n)
: defaults{d}, table{t}, name{n} {}
template <typename A> TestCall &Push(A &&x) {
args.emplace_back(AsGenericExpr(std::move(x)));
keywords.push_back("");
return *this;
}
template <typename A> TestCall &Push(NamedArg<A> &&x) {
args.emplace_back(AsGenericExpr(std::move(x.value)));
keywords.push_back(x.keyword);
strings.Save(x.keyword);
return *this;
}
template <typename A, typename... As> TestCall &Push(A &&x, As &&... xs) {
Push(std::move(x));
return Push(std::move(xs)...);
}
void Marshal() {
strings.Save(name);
strings.Marshal();
std::size_t j{0};
for (auto &kw : keywords) {
if (!kw.empty()) {
args[j]->set_keyword(strings(kw));
}
++j;
}
}
void DoCall(std::optional<DynamicType> resultType = std::nullopt,
int rank = 0, bool isElemental = false) {
Marshal();
parser::CharBlock fName{strings(name)};
llvm::outs() << "function: " << fName.ToString();
char sep{'('};
for (const auto &a : args) {
llvm::outs() << sep;
sep = ',';
a->AsFortran(llvm::outs());
}
if (sep == '(') {
llvm::outs() << '(';
}
llvm::outs() << ')' << '\n';
llvm::outs().flush();
CallCharacteristics call{fName.ToString()};
auto messages{strings.Messages(buffer)};
FoldingContext context{messages, defaults, table};
std::optional<SpecificCall> si{table.Probe(call, args, context)};
if (resultType.has_value()) {
TEST(si.has_value());
TEST(messages.messages() && !messages.messages()->AnyFatalError());
if (si) {
const auto &proc{si->specificIntrinsic.characteristics.value()};
const auto &fr{proc.functionResult};
TEST(fr.has_value());
if (fr) {
const auto *ts{fr->GetTypeAndShape()};
TEST(ts != nullptr);
if (ts) {
TEST(*resultType == ts->type());
MATCH(rank, ts->Rank());
}
}
MATCH(isElemental,
proc.attrs.test(characteristics::Procedure::Attr::Elemental));
}
} else {
TEST(!si.has_value());
TEST((messages.messages() && messages.messages()->AnyFatalError()) ||
name == "bad");
}
strings.Emit(llvm::outs(), buffer);
}
const common::IntrinsicTypeDefaultKinds &defaults;
const IntrinsicProcTable &table;
CookedStrings strings;
parser::Messages buffer;
ActualArguments args;
std::string name;
std::vector<std::string> keywords;
};
void TestIntrinsics() {
common::IntrinsicTypeDefaultKinds defaults;
MATCH(4, defaults.GetDefaultKind(TypeCategory::Integer));
MATCH(4, defaults.GetDefaultKind(TypeCategory::Real));
IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)};
table.Dump(llvm::outs());
using Int1 = Type<TypeCategory::Integer, 1>;
using Int4 = Type<TypeCategory::Integer, 4>;
using Int8 = Type<TypeCategory::Integer, 8>;
using Real4 = Type<TypeCategory::Real, 4>;
using Real8 = Type<TypeCategory::Real, 8>;
using Complex4 = Type<TypeCategory::Complex, 4>;
using Complex8 = Type<TypeCategory::Complex, 8>;
using Char = Type<TypeCategory::Character, 1>;
using Log4 = Type<TypeCategory::Logical, 4>;
TestCall{defaults, table, "bad"}
.Push(Const(Scalar<Int4>{}))
.DoCall(); // bad intrinsic name
TestCall{defaults, table, "abs"}
.Push(Named("a", Const(Scalar<Int4>{})))
.DoCall(Int4::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int4>{}))
.DoCall(Int4::GetType());
TestCall{defaults, table, "abs"}
.Push(Named("bad", Const(Scalar<Int4>{})))
.DoCall(); // bad keyword
TestCall{defaults, table, "abs"}.DoCall(); // insufficient args
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int4>{}))
.Push(Const(Scalar<Int4>{}))
.DoCall(); // too many args
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int4>{}))
.Push(Named("a", Const(Scalar<Int4>{})))
.DoCall();
TestCall{defaults, table, "abs"}
.Push(Named("a", Const(Scalar<Int4>{})))
.Push(Const(Scalar<Int4>{}))
.DoCall();
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int1>{}))
.DoCall(Int1::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int4>{}))
.DoCall(Int4::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Int8>{}))
.DoCall(Int8::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Real4>{}))
.DoCall(Real4::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Real8>{}))
.DoCall(Real8::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Complex4>{}))
.DoCall(Real4::GetType());
TestCall{defaults, table, "abs"}
.Push(Const(Scalar<Complex8>{}))
.DoCall(Real8::GetType());
TestCall{defaults, table, "abs"}.Push(Const(Scalar<Char>{})).DoCall();
TestCall{defaults, table, "abs"}.Push(Const(Scalar<Log4>{})).DoCall();
// "Ext" in names for calls allowed as extensions
TestCall maxCallR{defaults, table, "max"}, maxCallI{defaults, table, "min"},
max0Call{defaults, table, "max0"}, max1Call{defaults, table, "max1"},
amin0Call{defaults, table, "amin0"}, amin1Call{defaults, table, "amin1"},
max0ExtCall{defaults, table, "max0"},
amin1ExtCall{defaults, table, "amin1"};
for (int j{0}; j < 10; ++j) {
maxCallR.Push(Const(Scalar<Real4>{}));
maxCallI.Push(Const(Scalar<Int4>{}));
max0Call.Push(Const(Scalar<Int4>{}));
max0ExtCall.Push(Const(Scalar<Real4>{}));
max1Call.Push(Const(Scalar<Real4>{}));
amin0Call.Push(Const(Scalar<Int4>{}));
amin1ExtCall.Push(Const(Scalar<Int4>{}));
amin1Call.Push(Const(Scalar<Real4>{}));
}
maxCallR.DoCall(Real4::GetType());
maxCallI.DoCall(Int4::GetType());
max0Call.DoCall(Int4::GetType());
max0ExtCall.DoCall(Int4::GetType());
max1Call.DoCall(Int4::GetType());
amin0Call.DoCall(Real4::GetType());
amin1Call.DoCall(Real4::GetType());
amin1ExtCall.DoCall(Real4::GetType());
TestCall{defaults, table, "conjg"}
.Push(Const(Scalar<Complex4>{}))
.DoCall(Complex4::GetType());
TestCall{defaults, table, "conjg"}
.Push(Const(Scalar<Complex8>{}))
.DoCall(Complex8::GetType());
TestCall{defaults, table, "dconjg"}.Push(Const(Scalar<Complex4>{})).DoCall();
TestCall{defaults, table, "dconjg"}
.Push(Const(Scalar<Complex8>{}))
.DoCall(Complex8::GetType());
TestCall{defaults, table, "float"}.Push(Const(Scalar<Real4>{})).DoCall();
TestCall{defaults, table, "float"}
.Push(Const(Scalar<Int4>{}))
.DoCall(Real4::GetType());
TestCall{defaults, table, "idint"}.Push(Const(Scalar<Int4>{})).DoCall();
TestCall{defaults, table, "idint"}
.Push(Const(Scalar<Real8>{}))
.DoCall(Int4::GetType());
// Allowed as extensions
TestCall{defaults, table, "float"}
.Push(Const(Scalar<Int8>{}))
.DoCall(Real4::GetType());
TestCall{defaults, table, "idint"}
.Push(Const(Scalar<Real4>{}))
.DoCall(Int4::GetType());
// TODO: test other intrinsics
}
} // namespace Fortran::evaluate
int main() {
Fortran::evaluate::TestIntrinsics();
return testing::Complete();
}