Protect the function wrapped by cpp11::function (#395)

* Don't use `cpp11::function` for `static` variable

When we switch to `sexp`, this would force a cell to always exist in our protection list (because it would never release the `sexp`). While that isn't really a bad thing, it messes up our count related protection list tests.

* Protect the function in `cpp11::function`

It is technically possibly to conceive of situations where we could be wrapping a function that is temporary on the R side, and the C++ side of things outlives that R temporary function.

* NEWS bullet

Author: DavisVaughan

NEWS.md

@@ -1,5 +1,8 @@
 # cpp11 (development version)
 
+* `cpp11::function` now protects its underlying function, for maximum safety
+  (#294).
+
 * `cpp11::writable::r_vector<T>::proxy` now implements copy assignment.
   Practically this means that `x[i] = y[i]` now works when both `x` and `y`
   are writable vectors (#300, #339).

inst/include/cpp11/function.hpp

@@ -31,7 +31,7 @@ class function {
   }
 
  private:
-  SEXP data_;
+  sexp data_;
 
   template <typename... Args>
   void construct_call(SEXP val, const named_arg& arg, Args&&... args) const {
@@ -71,36 +71,65 @@ class package {
     return safe[Rf_findVarInFrame](R_NamespaceRegistry, name_sexp);
   }
 
+  // Either base env or in namespace registry, so no protection needed
   SEXP data_;
 };
 
+namespace detail {
+
+// Special internal way to call `base::message()`
+//
+// - Pure C, so call with `safe[]`
+// - Holds a `static SEXP` for the `base::message` function protected with
+// `R_PreserveObject()`
+//
+// We don't use a `static cpp11::function` because that will infinitely retain a cell in
+// our preserve list, which can throw off our counts in the preserve list tests.
+inline void r_message(const char* x) {
+  static SEXP fn = NULL;
+
+  if (fn == NULL) {
+    fn = Rf_findFun(Rf_install("message"), R_BaseEnv);
+    R_PreserveObject(fn);
+  }
+
+  SEXP x_char = PROTECT(Rf_mkCharCE(x, CE_UTF8));
+  SEXP x_string = PROTECT(Rf_ScalarString(x_char));
+
+  SEXP call = PROTECT(Rf_lang2(fn, x_string));
+
+  Rf_eval(call, R_GlobalEnv);
+
+  UNPROTECT(3);
+}
+
+}  // namespace detail
+
 inline void message(const char* fmt_arg) {
-  static auto R_message = cpp11::package("base")["message"];
 #ifdef CPP11_USE_FMT
   std::string msg = fmt::format(fmt_arg);
-  R_message(msg.c_str());
+  safe[detail::r_message](msg.c_str());
 #else
   char buff[1024];
   int msg;
   msg = std::snprintf(buff, 1024, "%s", fmt_arg);
   if (msg >= 0 && msg < 1024) {
-    R_message(buff);
+    safe[detail::r_message](buff);
   }
 #endif
 }
 
 template <typename... Args>
 void message(const char* fmt_arg, Args... args) {
-  static auto R_message = cpp11::package("base")["message"];
 #ifdef CPP11_USE_FMT
   std::string msg = fmt::format(fmt_arg, args...);
-  R_message(msg.c_str());
+  safe[detail::r_message](msg.c_str());
 #else
   char buff[1024];
   int msg;
   msg = std::snprintf(buff, 1024, fmt_arg, args...);
   if (msg >= 0 && msg < 1024) {
-    R_message(buff);
+    safe[detail::r_message](buff);
   }
 #endif
 }