[flang] unit testing, better error messages

Original-commit: flang-compiler/f18@f3876008d0
Reviewed-on: https://github.com/flang-compiler/f18/pull/212
Tree-same-pre-rewrite: false

flang/lib/common/constexpr-bitset.h

@@ -112,13 +112,13 @@ public:
     return *this;
   }
   constexpr BitSet set(std::size_t x, bool value = true) {
-    if (value) {
-      bits_ |= static_cast<Word>(1) << x;
+    if (!value) {
+      return reset(x);
     } else {
-      bits_ &= ~(static_cast<Word>(1) << x);
-    }
+      bits_ |= static_cast<Word>(1) << x;
       return *this;
     }
+  }
   constexpr BitSet &reset() {
     bits_ = 0;
     return *this;

flang/lib/evaluate/intrinsics.cc

@@ -19,6 +19,8 @@
 #include "../common/fortran.h"
 #include "../common/idioms.h"
 #include <map>
+#include <ostream>
+#include <sstream>
 #include <string>
 #include <utility>
 
@@ -62,13 +64,9 @@ static constexpr CategorySet IntrinsicType{
 static constexpr CategorySet AnyType{
     IntrinsicType | CategorySet{TypeCategory::Derived}};
 
-enum class KindCode {
-  none,
-  defaultIntegerKind,
+ENUM_CLASS(KindCode, none, defaultIntegerKind,
     defaultRealKind,  // is also the default COMPLEX kind
-  doublePrecision,
-  defaultCharKind,
-  defaultLogicalKind,
+    doublePrecision, defaultCharKind, defaultLogicalKind,
     any,  // matches any kind value; each instance is independent
     typeless,  // BOZ literals are INTEGER with this kind
     teamType,  // TEAM_TYPE from module ISO_FORTRAN_ENV (for coarrays)
@@ -77,11 +75,12 @@ enum class KindCode {
     dimArg,  // this argument is DIM=
     same,  // match any kind; all "same" kinds must be equal
     likeMultiply,  // for DOT_PRODUCT and MATMUL
-};
+)
 
 struct TypePattern {
   CategorySet categorySet;
   KindCode kindCode{KindCode::none};
+  std::ostream &Dump(std::ostream &) const;
 };
 
 // Abbreviations for argument and result patterns in the intrinsic prototypes:
@@ -138,11 +137,10 @@ static constexpr TypePattern KINDLogical{Logical, KindCode::effectiveKind};
 
 // The default rank pattern for dummy arguments and function results is
 // "elemental".
-enum class Rank {
+ENUM_CLASS(Rank,
     elemental,  // scalar, or array that conforms with other array arguments
     elementalOrBOZ,  // elemental, or typeless BOZ literal scalar
-  scalar,
-  vector,
+    scalar, vector,
     shape,  // INTEGER vector of known length and no negative element
     matrix,
     array,  // not scalar, rank is known and greater than zero
@@ -154,21 +152,20 @@ enum class Rank {
     dimRemoved,  // scalar, or rank(array)-1
     rankPlus1,  // rank(known)+1
     shaped,  // rank is length of SHAPE vector
-};
+)
 
-enum class Optionality {
-  required,
-  optional,
+ENUM_CLASS(Optionality, required, optional,
     defaultsToSameKind,  // for MatchingDefaultKIND
     defaultsToDefaultForResult,  // for DefaultingKIND
     repeats,  // for MAX/MIN and their several variants
-};
+)
 
 struct IntrinsicDummyArgument {
   const char *keyword{nullptr};
   TypePattern typePattern;
   Rank rank{Rank::elemental};
   Optionality optionality{Optionality::required};
+  std::ostream &Dump(std::ostream &) const;
 };
 
 // constexpr abbreviations for popular arguments:
@@ -196,6 +193,7 @@ struct IntrinsicInterface {
   std::optional<SpecificIntrinsic> Match(const CallCharacteristics &,
       const IntrinsicTypeDefaultKinds &,
       parser::ContextualMessages &messages) const;
+  std::ostream &Dump(std::ostream &) const;
 };
 
 static const IntrinsicInterface genericIntrinsicFunction[]{
@@ -742,7 +740,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
     if (arg.isAlternateReturn) {
       messages.Say(
           "alternate return specifier not acceptable on call to intrinsic '%s'"_err_en_US,
-          call.name.ToString().data());
+          name);
       return std::nullopt;
     }
     bool found{false};
@@ -755,18 +753,18 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
           break;
         }
       }
+    }
     if (!found) {
       if (arg.keyword.has_value()) {
         messages.Say(*arg.keyword,
-              "unknown keyword argument to intrinsic '%'"_err_en_US,
-              call.name.ToString().data());
+            "unknown keyword argument to intrinsic '%s'"_err_en_US, name);
       } else {
-          messages.Say("too many actual arguments"_err_en_US);
+        messages.Say(
+            "too many actual arguments for intrinsic '%s'"_err_en_US, name);
       }
       return std::nullopt;
     }
   }
-  }
 
   // Check types and kinds of the actual arguments against the intrinsic's
   // interface.  Ensure that two or more arguments that have to have the same
@@ -784,7 +782,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
     const ActualArgument *arg{actualForDummy[dummyArgIndex]};
     if (!arg) {
       if (d.optionality == Optionality::required) {
-        messages.Say("missing '%s' argument"_err_en_US, d.keyword);
+        messages.Say("missing mandatory '%s=' argument"_err_en_US, d.keyword);
         return std::nullopt;  // missing non-OPTIONAL argument
       } else {
         continue;
@@ -797,10 +795,11 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
           d.rank == Rank::elementalOrBOZ) {
         continue;
       }
-      messages.Say("typeless (BOZ) not allowed for '%s'"_err_en_US, d.keyword);
+      messages.Say(
+          "typeless (BOZ) not allowed for '%s=' argument"_err_en_US, d.keyword);
       return std::nullopt;
     } else if (!d.typePattern.categorySet.test(type->category)) {
-      messages.Say("actual argument for '%s' has bad type '%s'"_err_en_US,
+      messages.Say("actual argument for '%s=' has bad type '%s'"_err_en_US,
           d.keyword, type->Dump().data());
       return std::nullopt;  // argument has invalid type category
     }
@@ -853,7 +852,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
     }
     if (!argOk) {
       messages.Say(
-          "actual argument for '%s' has bad type or kind '%s'"_err_en_US,
+          "actual argument for '%s=' has bad type or kind '%s'"_err_en_US,
           d.keyword, type->Dump().data());
       return std::nullopt;
     }
@@ -869,7 +868,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
     if (const ActualArgument * arg{actualForDummy[dummyArgIndex]}) {
       if (arg->isAssumedRank && d.rank != Rank::anyOrAssumedRank) {
         messages.Say(
-            "assumed-rank array cannot be used for '%s' argument"_err_en_US,
+            "assumed-rank array cannot be used for '%s=' argument"_err_en_US,
             d.keyword);
         return std::nullopt;
       }
@@ -932,7 +931,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
       default: CRASH_NO_CASE;
       }
       if (!argOk) {
-        messages.Say("'%s' argument has unacceptable rank %d"_err_en_US,
+        messages.Say("'%s=' argument has unacceptable rank %d"_err_en_US,
             d.keyword, rank);
         return std::nullopt;
       }
@@ -992,7 +991,7 @@ std::optional<SpecificIntrinsic> IntrinsicInterface::Match(
           }
         }
       }
-      messages.Say("'kind' argument must be a constant scalar integer "
+      messages.Say("'kind=' argument must be a constant scalar integer "
                    "whose value is a supported kind for the "
                    "intrinsic result type"_err_en_US);
       return std::nullopt;
@@ -1085,6 +1084,7 @@ struct IntrinsicProcTable::Implementation {
   IntrinsicTypeDefaultKinds defaults;
   std::multimap<std::string, const IntrinsicInterface *> genericFuncs;
   std::multimap<std::string, const SpecificIntrinsicInterface *> specificFuncs;
+  std::ostream &Dump(std::ostream &) const;
 };
 
 // Probe the configured intrinsic procedure pattern tables in search of a
@@ -1095,12 +1095,12 @@ std::optional<SpecificIntrinsic> IntrinsicProcTable::Implementation::Probe(
   if (call.isSubroutineCall) {
     return std::nullopt;  // TODO
   }
-  bool wantMessages{messages != nullptr && messages->messages() != nullptr};
+  parser::Messages *finalBuffer{messages ? messages->messages() : nullptr};
   // Probe the specific intrinsic function table first.
   parser::Messages specificBuffer;
   parser::ContextualMessages specificErrors{
       messages ? messages->at() : call.name,
-      wantMessages ? &specificBuffer : nullptr};
+      finalBuffer ? &specificBuffer : nullptr};
   std::string name{call.name.ToString()};
   auto specificRange{specificFuncs.equal_range(name)};
   for (auto iter{specificRange.first}; iter != specificRange.second; ++iter) {
@@ -1116,7 +1116,7 @@ std::optional<SpecificIntrinsic> IntrinsicProcTable::Implementation::Probe(
   parser::Messages genericBuffer;
   parser::ContextualMessages genericErrors{
       messages ? messages->at() : call.name,
-      wantMessages ? &genericBuffer : nullptr};
+      finalBuffer ? &genericBuffer : nullptr};
   auto genericRange{genericFuncs.equal_range(name)};
   for (auto iter{genericRange.first}; iter != genericRange.second; ++iter) {
     if (auto specific{iter->second->Match(call, defaults, genericErrors)}) {
@@ -1142,12 +1142,11 @@ std::optional<SpecificIntrinsic> IntrinsicProcTable::Implementation::Probe(
     }
   }
   // No match
-  if (wantMessages) {
+  if (finalBuffer) {
     if (genericBuffer.empty()) {
-      CHECK(!specificBuffer.empty());
-      messages->messages()->Annex(std::move(specificBuffer));
+      finalBuffer->Annex(std::move(specificBuffer));
     } else {
-      messages->messages()->Annex(std::move(genericBuffer));
+      finalBuffer->Annex(std::move(genericBuffer));
     }
   }
   return std::nullopt;
@@ -1176,4 +1175,65 @@ std::optional<SpecificIntrinsic> IntrinsicProcTable::Probe(
 std::ostream &SpecificIntrinsic::Dump(std::ostream &o) const {
   return o << name;
 }
+
+std::ostream &TypePattern::Dump(std::ostream &o) const {
+  if (categorySet == AnyType) {
+    o << "any type";
+  } else {
+    const char *sep = "";
+    auto set{categorySet};
+    while (auto least{set.LeastElement()}) {
+      o << sep << EnumToString(*least);
+      sep = " or ";
+      set.reset(*least);
+    }
+  }
+  o << '(' << EnumToString(kindCode) << ')';
+  return o;
+}
+
+std::ostream &IntrinsicDummyArgument::Dump(std::ostream &o) const {
+  if (keyword) {
+    o << keyword << '=';
+  }
+  return typePattern.Dump(o)
+      << ' ' << EnumToString(rank) << ' ' << EnumToString(optionality);
+}
+
+std::ostream &IntrinsicInterface::Dump(std::ostream &o) const {
+  o << name;
+  char sep{'('};
+  for (const auto &d : dummy) {
+    if (d.typePattern.kindCode == KindCode::none) {
+      break;
+    }
+    d.Dump(o << sep);
+    sep = ',';
+  }
+  if (sep == '(') {
+    o << "()";
+  }
+  return result.Dump(o << " -> ") << ' ' << EnumToString(rank);
+}
+
+std::ostream &IntrinsicProcTable::Implementation::Dump(std::ostream &o) const {
+  o << "generic intrinsic functions:\n";
+  for (const auto &iter : genericFuncs) {
+    iter.second->Dump(o << iter.first << ": ") << '\n';
+  }
+  o << "specific intrinsic functions:\n";
+  for (const auto &iter : specificFuncs) {
+    iter.second->Dump(o << iter.first << ": ");
+    if (const char *g{iter.second->generic}) {
+      o << " -> " << g;
+    }
+    o << '\n';
+  }
+  return o;
+}
+
+std::ostream &IntrinsicProcTable::Dump(std::ostream &o) const {
+  return impl_->Dump(o);
+}
+
 }  // namespace Fortran::evaluate

flang/lib/evaluate/intrinsics.h

@@ -43,6 +43,7 @@ struct SpecificIntrinsic {
   SpecificIntrinsic(IntrinsicProcedure n, bool isElem, DynamicType dt, int r)
     : name{n}, isElemental{isElem}, type{dt}, rank{r} {}
   std::ostream &Dump(std::ostream &) const;
+
   IntrinsicProcedure name;
   bool isElemental{false};  // TODO: consider using Attrs instead
   bool isPointer{false};  // NULL()
@@ -60,6 +61,7 @@ public:
   static IntrinsicProcTable Configure(const IntrinsicTypeDefaultKinds &);
   std::optional<SpecificIntrinsic> Probe(const CallCharacteristics &,
       parser::ContextualMessages *messages = nullptr) const;
+  std::ostream &Dump(std::ostream &) const;
 
 private:
   Implementation *impl_{nullptr};  // owning pointer

flang/lib/parser/char-buffer.cc

@@ -41,7 +41,7 @@ void CharBuffer::Claim(std::size_t n) {
   }
 }
 
-void CharBuffer::Put(const char *data, std::size_t n) {
+std::size_t CharBuffer::Put(const char *data, std::size_t n) {
   std::size_t chunk;
   for (std::size_t at{0}; at < n; at += chunk) {
     char *to{FreeSpace(&chunk)};
@@ -49,9 +49,12 @@ void CharBuffer::Put(const char *data, std::size_t n) {
     Claim(chunk);
     std::memcpy(to, data + at, chunk);
   }
+  return bytes_ - n;
 }
 
-void CharBuffer::Put(const std::string &str) { Put(str.data(), str.size()); }
+std::size_t CharBuffer::Put(const std::string &str) {
+  return Put(str.data(), str.size());
+}
 
 std::string CharBuffer::Marshal() const {
   std::string result;

flang/lib/parser/char-buffer.h

@@ -55,9 +55,12 @@ public:
 
   char *FreeSpace(std::size_t *);
   void Claim(std::size_t);
-  void Put(const char *data, std::size_t n);
-  void Put(const std::string &);
-  void Put(char x) { Put(&x, 1); }
+
+  // The return value is the byte offset of the new data,
+  // i.e. the value of size() before the call.
+  std::size_t Put(const char *data, std::size_t n);
+  std::size_t Put(const std::string &);
+  std::size_t Put(char x) { return Put(&x, 1); }
 
   std::string Marshal() const;
 

flang/lib/parser/provenance.h

@@ -204,17 +204,24 @@ public:
 
   std::optional<ProvenanceRange> GetProvenanceRange(CharBlock) const;
 
-  void Put(const char *data, std::size_t bytes) { buffer_.Put(data, bytes); }
-  void Put(char ch) { buffer_.Put(&ch, 1); }
-  void Put(char ch, Provenance p) {
-    buffer_.Put(&ch, 1);
-    provenanceMap_.Put(ProvenanceRange{p, 1});
+  // The result of a Put() is the offset that the new data
+  // will have in the eventually marshaled contiguous buffer.
+  std::size_t Put(const char *data, std::size_t bytes) {
+    return buffer_.Put(data, bytes);
   }
+  std::size_t Put(const std::string &s) { return buffer_.Put(s); }
+  std::size_t Put(char ch) { return buffer_.Put(&ch, 1); }
+  std::size_t Put(char ch, Provenance p) {
+    provenanceMap_.Put(ProvenanceRange{p, 1});
+    return buffer_.Put(&ch, 1);
+  }
+
   void PutProvenance(Provenance p) { provenanceMap_.Put(ProvenanceRange{p}); }
   void PutProvenance(ProvenanceRange pr) { provenanceMap_.Put(pr); }
   void PutProvenanceMappings(const OffsetToProvenanceMappings &pm) {
     provenanceMap_.Put(pm);
   }
+
   void Marshal();  // marshals text into one contiguous block
   std::string AcquireData() { return std::move(data_); }
   std::ostream &Dump(std::ostream &) const;

flang/test/evaluate/intrinsics.cc

@@ -17,15 +17,122 @@
 #include "../../lib/evaluate/expression.h"
 #include "../../lib/evaluate/tools.h"
 #include "../../lib/parser/provenance.h"
+#include <initializer_list>
 #include <iostream>
+#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(std::ostream &o, const parser::Messages &messages) {
+    messages.Emit(o, cooked_);
+  }
+
+private:
+  parser::CookedSource cooked_;
+  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 IntrinsicProcTable &t, std::string n) : 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].keyword = strings(kw);
+      }
+      ++j;
+    }
+  }
+  void DoCall(std::optional<DynamicType> resultType = std::nullopt,
+      int rank = 0, bool isElemental = false) {
+    Marshal();
+    parser::CharBlock fName{strings(name)};
+    std::cout << "function: " << fName.ToString();
+    char sep{'('};
+    for (const auto &a : args) {
+      std::cout << sep;
+      sep = ',';
+      a.Dump(std::cout);
+    }
+    if (sep == '(') {
+      std::cout << '(';
+    }
+    std::cout << ")\n";
+    CallCharacteristics call{fName, args};
+    auto messages{strings.Messages(buffer)};
+    std::optional<SpecificIntrinsic> si{table.Probe(call, &messages)};
+    if (resultType.has_value()) {
+      TEST(si.has_value());
+      TEST(buffer.empty());
+      TEST(*resultType == si->type);
+      MATCH(rank, si->rank);
+      MATCH(isElemental, si->isElemental);
+    } else {
+      TEST(!si.has_value());
+      TEST(!buffer.empty() || name == "bad");
+    }
+    strings.Emit(std::cout, buffer);
+  }
+
+  const IntrinsicProcTable &table;
+  CookedStrings strings;
+  parser::Messages buffer;
+  Arguments args;
+  std::string name;
+  std::vector<std::string> keywords;
+};
+
 template<typename A> void Push(Arguments &args, A &&x) {
   args.emplace_back(AsGenericExpr(std::move(x)));
 }
@@ -45,21 +152,33 @@ void TestIntrinsics() {
   MATCH(4, defaults.defaultIntegerKind);
   MATCH(4, defaults.defaultRealKind);
   IntrinsicProcTable table{IntrinsicProcTable::Configure(defaults)};
+  table.Dump(std::cout);
 
-  parser::CookedSource cooked;
-  std::string name{"abs"};
-  cooked.Put(name.data(), name.size());
-  cooked.PutProvenance(cooked.allSources().AddCompilerInsertion(name));
-  cooked.Marshal();
-  TEST(cooked.data() == name);
-  parser::CharBlock nameCharBlock{cooked.data().data(), name.size()};
-  CallCharacteristics call{nameCharBlock, Args(Const(value::Integer<32>{1}))};
-  parser::Messages buffer;
-  parser::ContextualMessages messages{cooked.data(), &buffer};
-  std::optional<SpecificIntrinsic> si{table.Probe(call, &messages)};
-  TEST(si.has_value());
-  TEST(buffer.empty());
-  buffer.Emit(std::cout, cooked);
+  using Int4 = Type<TypeCategory::Integer, 4>;
+
+  TestCall{table, "bad"}
+      .Push(Const(Scalar<Int4>{1}))
+      .DoCall();  // bad intrinsic name
+  TestCall{table, "abs"}
+      .Push(Named("a", Const(Scalar<Int4>{1})))
+      .DoCall(Int4::dynamicType);
+  TestCall{table, "abs"}.Push(Const(Scalar<Int4>{1})).DoCall(Int4::dynamicType);
+  TestCall{table, "abs"}
+      .Push(Named("bad", Const(Scalar<Int4>{1})))
+      .DoCall();  // bad keyword
+  TestCall{table, "abs"}.DoCall();  // insufficient args
+  TestCall{table, "abs"}
+      .Push(Const(Scalar<Int4>{1}))
+      .Push(Const(Scalar<Int4>{2}))
+      .DoCall();  // too many args
+  TestCall{table, "abs"}
+      .Push(Const(Scalar<Int4>{1}))
+      .Push(Named("a", Const(Scalar<Int4>{2})))
+      .DoCall();
+  TestCall{table, "abs"}
+      .Push(Named("a", Const(Scalar<Int4>{1})))
+      .Push(Const(Scalar<Int4>{2}))
+      .DoCall();
 }
 }  // namespace Fortran::evaluate