Unify OOB behavior rather than duplicating method

r-lib · Aug 9, 2024 · cba96c4 · cba96c4
1 parent 254277b
commit cba96c4
Show file tree

Hide file tree

Showing 4 changed files with 49 additions and 14 deletions.
diff --git a/cpp11test/src/test-integers.cpp b/cpp11test/src/test-integers.cpp
@@ -207,6 +207,20 @@ context("integers-C++") {
   }
 #endif
 
+  test_that("operator[] with names") {
+    using namespace cpp11::literals;
+    cpp11::writable::integers x({"a"_nm = 1, "b"_nm = 2});
+    cpp11::integers y(x);
+
+    expect_true(x["a"] == 1);
+    expect_true(x["b"] == 2);
+    expect_error(x["c"] == 2);
+
+    expect_true(y["a"] == 1);
+    expect_true(y["b"] == 2);
+    expect_error(y["c"] == 2);
+  }
+
   test_that("is_na(integer)") {
     int x = 0;
     expect_true(!cpp11::is_na(x));

diff --git a/cpp11test/src/test-list.cpp b/cpp11test/src/test-list.cpp
@@ -156,6 +156,28 @@ context("list-C++") {
     expect_true(x.size() == nms.size());
   }
 
+  test_that("list::operator[] by name") {
+    SEXP x = PROTECT(Rf_allocVector(VECSXP, 1));
+
+    SEXP elt = Rf_allocVector(INTSXP, 1);
+    SET_VECTOR_ELT(x, 0, elt);
+    SET_INTEGER_ELT(elt, 0, 1);
+
+    SEXP names = Rf_allocVector(STRSXP, 1);
+    Rf_setAttrib(x, R_NamesSymbol, names);
+    SET_STRING_ELT(names, 0, Rf_mkCharCE("name", CE_UTF8));
+
+    cpp11::list lst(x);
+
+    expect_true(lst.named());
+    expect_true(lst["name"] == elt);
+
+    // Lists are the only class where OOB accesses by name return `NULL`
+    expect_true(lst["oob"] == R_NilValue);
+
+    UNPROTECT(1);
+  }
+
   test_that("We don't return NULL for default constructed vectors") {
     cpp11::writable::list x;
     SEXP y(x);

diff --git a/inst/include/cpp11/list.hpp b/inst/include/cpp11/list.hpp
@@ -27,22 +27,14 @@ inline typename r_vector<SEXP>::underlying_type r_vector<SEXP>::get_elt(SEXP x,
 }
 
 template <>
-inline SEXP r_vector<SEXP>::operator[](const r_string& name) const {
-  SEXP names = this->names();
-  R_xlen_t size = Rf_xlength(names);
-
-  for (R_xlen_t pos = 0; pos < size; ++pos) {
-    auto cur = Rf_translateCharUTF8(STRING_ELT(names, pos));
-    if (name == cur) {
-      return operator[](pos);
-    }
-  }
-  return R_NilValue;
+inline typename r_vector<SEXP>::underlying_type* r_vector<SEXP>::get_p(bool, SEXP) {
+  return nullptr;
 }
 
+/// Specialization for lists, where `x["oob"]` returns `R_NilValue`, like at the R level
 template <>
-inline typename r_vector<SEXP>::underlying_type* r_vector<SEXP>::get_p(bool, SEXP) {
-  return nullptr;
+inline SEXP r_vector<SEXP>::get_oob() {
+  return R_NilValue;
 }
 
 template <>

diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp
@@ -150,6 +150,8 @@ class r_vector {
   static void get_region(SEXP x, R_xlen_t i, R_xlen_t n, underlying_type* buf);
   /// Implemented in specialization
   static SEXPTYPE get_sexptype();
+  /// Implemented in specialization (throws by default, specialization in list type)
+  static T get_oob();
   static SEXP valid_type(SEXP x);
 
   friend class writable::r_vector<T>;
@@ -467,7 +469,7 @@ inline T r_vector<T>::operator[](const r_string& name) const {
     }
   }
 
-  throw std::out_of_range("r_vector");
+  return get_oob();
 }
 
 #ifdef LONG_VECTOR_SUPPORT
@@ -558,6 +560,11 @@ inline r_vector<r_string> r_vector<T>::names() const {
   }
 }
 
+template <typename T>
+inline T r_vector<T>::get_oob() {
+  throw std::out_of_range("r_vector");
+}
+
 class type_error : public std::exception {
  public:
   type_error(int expected, int actual) : expected_(expected), actual_(actual) {}