From 21c19d1ce6aff71813315246d16882e65c35ba0a Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 7 Aug 2020 10:17:02 -0400 Subject: [PATCH 1/5] avoid anonymous lambdas in protect::function::operator() --- .gitignore | 1 + inst/include/cpp11/protect.hpp | 86 +++++++++++++++++----------------- 2 files changed, 45 insertions(+), 42 deletions(-) diff --git a/.gitignore b/.gitignore index ee4d3997..f2639ad9 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ cpp11test/src/*.so compile_flags.txt inst/doc vignettes/*_cache +compile_commands.json diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index fe5f8aa4..7227174a 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -129,8 +129,8 @@ inline SEXP init_unwind_continuation() { /// /// @param code The code to which needs to be protected, as a nullary callable template ()()), SEXP>::value>::type> -SEXP unwind_protect(Fun code) { + decltype(std::declval()()), SEXP>::value>::type> +SEXP unwind_protect(Fun&& code) { static SEXP token = init_unwind_continuation(); internal::unwind_data_t unwind_data; @@ -140,15 +140,15 @@ SEXP unwind_protect(Fun code) { return R_UnwindProtect( [](void* data) -> SEXP { - Fun* callback = (Fun*)data; - return (*callback)(); + auto callback = static_cast(data); + return static_cast(*callback)(); }, &code, internal::maybe_jump, &unwind_data, token); } template ()()), void>::value>::type> -void unwind_protect(Fun code) { + decltype(std::declval()()), void>::value>::type> +void unwind_protect(Fun&& code) { static SEXP token = init_unwind_continuation(); internal::unwind_data_t unwind_data; @@ -158,37 +158,31 @@ void unwind_protect(Fun code) { (void)R_UnwindProtect( [](void* data) -> SEXP { - Fun* callback = (Fun*)data; - (*callback)(); + auto callback = static_cast(data); + static_cast (*callback)(); return R_NilValue; }, &code, internal::maybe_jump, &unwind_data, token); } -#else -// Don't do anything if we don't have unwind protect. This will leak C++ resources, -// including those held by cpp11 objects, but the other alternatives are also not great. -template ()()), SEXP>::value>::type> -SEXP unwind_protect(Fun code) { - return code(); -} - -template ()()), void>::value>::type> -void unwind_protect(Fun code) { - code(); -} -#endif -template ()())> +template ()())> typename std::enable_if::value && !std::is_same::value, R>::type -unwind_protect(Fun code) { +unwind_protect(Fun&& code) { R out; - unwind_protect([&] { out = code(); }); + unwind_protect([&] { out = std::forward(code)(); }); return out; } +#else +// Don't do anything if we don't have unwind protect. This will leak C++ resources, +// including those held by cpp11 objects, but the other alternatives are also not great. +template +decltype(std::declval()()) unwind_protect(Fun&& code) { + return std::forward(code)(); +} +#endif + namespace detail { template @@ -209,37 +203,45 @@ struct make_index_sequence template <> struct make_index_sequence<0> : index_sequence<> {}; -template -auto apply(F&& f, std::tuple&& a, const index_sequence&) - -> decltype(f(std::get(std::move(a))...)) { - return f(std::get(std::move(a))...); +template +decltype(std::declval()(std::declval()...)) apply( + F&& f, std::tuple&& a, const index_sequence&) { + return std::forward(f)(std::get(std::move(a))...); } -template -auto apply(F&& f, std::tuple&& a) - -> decltype(apply(f, std::move(a), make_index_sequence{})) { - return apply(f, std::move(a), make_index_sequence{}); +template +decltype(std::declval()(std::declval()...)) apply(F&& f, + std::tuple&& a) { + return apply(std::forward(f), std::move(a), make_index_sequence{}); } -// overload to silence a compiler warning that the tuple parameter is set but unused +// overload to silence a compiler warning that the (empty) tuple parameter is set but +// unused template -auto apply(F&& f, std::tuple<> &&) -> decltype(f()) { - return f(); +decltype(std::declval()()) apply(F&& f, std::tuple<>&&) { + return std::forward(f)(); } +template +struct closure { + decltype(std::declval()(std::declval()...)) operator()() && { + return apply(ptr_, std::move(arefs_)); + } + F* ptr_; + std::tuple arefs_; +}; + } // namespace detail struct protect { template struct function { template - auto operator()(A&&... a) const - -> decltype(detail::apply(std::declval(), - std::forward_as_tuple(std::forward(a)...))) { + decltype(std::declval()(std::declval()...)) operator()(A&&... a) const { // workaround to support gcc4.8, which can't capture a parameter pack - auto a_packed_refs = std::forward_as_tuple(std::forward(a)...); + // also workaround to avoid an anonymous lambda here, which causes linker errors return unwind_protect( - [&] { return detail::apply(ptr_, std::move(a_packed_refs)); }); + detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); } F* ptr_; }; From ec11c4f44cfdec57180eb6158bdab17a132abbb6 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 7 Aug 2020 10:40:41 -0400 Subject: [PATCH 2/5] add tests for stop() with and without varargs --- cpp11test/src/test-protect.cpp | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cpp11test/src/test-protect.cpp b/cpp11test/src/test-protect.cpp index bc89242e..3e8ce261 100644 --- a/cpp11test/src/test-protect.cpp +++ b/cpp11test/src/test-protect.cpp @@ -37,6 +37,13 @@ context("unwind_protect-C++") { UNPROTECT(1); } + test_that("stop throws an unwind_exception") { + expect_error_as(cpp11::stop("error"), cpp11::unwind_exception); + expect_error_with(cpp11::stop("error"), "error"); + expect_error_as(cpp11::stop("error: %s", "message"), cpp11::unwind_exception); + expect_error_with(cpp11::stop("error: %s", "message"), "error: message"); + } + test_that("safe wraps R functions and works if there is an R error") { expect_error_as(cpp11::safe[Rf_allocVector](REALSXP, -1), cpp11::unwind_exception); } From 89f615a044388edc3feb676aa2269c6715c1da54 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 7 Aug 2020 11:11:08 -0400 Subject: [PATCH 3/5] remove expect_error_with --- cpp11test/src/test-protect.cpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/cpp11test/src/test-protect.cpp b/cpp11test/src/test-protect.cpp index 3e8ce261..e87436f4 100644 --- a/cpp11test/src/test-protect.cpp +++ b/cpp11test/src/test-protect.cpp @@ -39,9 +39,7 @@ context("unwind_protect-C++") { test_that("stop throws an unwind_exception") { expect_error_as(cpp11::stop("error"), cpp11::unwind_exception); - expect_error_with(cpp11::stop("error"), "error"); expect_error_as(cpp11::stop("error: %s", "message"), cpp11::unwind_exception); - expect_error_with(cpp11::stop("error: %s", "message"), "error: message"); } test_that("safe wraps R functions and works if there is an R error") { From 25014d84752fe5f237a43a7984b313f2647ba7ab Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Thu, 13 Aug 2020 14:03:01 -0400 Subject: [PATCH 4/5] provide a [[noreturn]] version of safe[] --- inst/include/cpp11/protect.hpp | 35 +++++++++++++++++++++++++--------- 1 file changed, 26 insertions(+), 9 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 7227174a..6259311a 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -239,17 +239,40 @@ struct protect { template decltype(std::declval()(std::declval()...)) operator()(A&&... a) const { // workaround to support gcc4.8, which can't capture a parameter pack - // also workaround to avoid an anonymous lambda here, which causes linker errors return unwind_protect( detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); } + F* ptr_; }; + /// May not be applied to a function bearing attributes, which interfere with linkage on + /// some compilers; use an appropriately attributed alternative. (For example, Rf_error + /// bears the [[noreturn]] attribute and must be protected with safe.noreturn rather + /// than safe.operator[]). template constexpr function operator[](F* raw) const { return {raw}; } + + template + struct noreturn_function { + template + void operator() [[noreturn]] (A&&... a) const { + // workaround to support gcc4.8, which can't capture a parameter pack + unwind_protect( + detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); + // Compiler hint to allow [[noreturn]] attribute; this is never executed since + // the above call will not return. + throw std::runtime_error("[[noreturn]]"); + } + F* ptr_; + }; + + template + constexpr noreturn_function noreturn(F* raw) const { + return {raw}; + } }; constexpr struct protect safe = {}; @@ -257,18 +280,12 @@ inline void check_user_interrupt() { safe[R_CheckUserInterrupt](); } template void stop [[noreturn]] (const char* fmt, Args... args) { - safe[Rf_error](fmt, args...); - // Compiler hint to allow [[noreturn]] attribute; this is never executed since Rf_error - // will longjmp - throw std::runtime_error("stop()"); + safe.noreturn(Rf_error)(fmt, args...); } template void stop [[noreturn]] (const std::string& fmt, Args... args) { - safe[Rf_error](fmt.c_str(), args...); - // Compiler hint to allow [[noreturn]] attribute; this is never executed since Rf_error - // will longjmp - throw std::runtime_error("stop()"); + safe.noreturn(Rf_error)(fmt.c_str(), args...); } template From 70a962c729d6556de693b5bd4c23b3dfbf4e11b6 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Sat, 15 Aug 2020 10:10:19 -0400 Subject: [PATCH 5/5] simplify unwind_protect further --- inst/include/cpp11/protect.hpp | 65 +++++++++++++--------------------- 1 file changed, 24 insertions(+), 41 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 6259311a..fcb3c4c1 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -103,38 +103,20 @@ inline void release_protect(SEXP protect) { #ifdef HAS_UNWIND_PROTECT -namespace internal { -struct unwind_data_t { - std::jmp_buf jmpbuf; -}; - -// We need to first jump back into the C++ stacks because you can't safely throw -// exceptions from C stack frames. -inline void maybe_jump(void* unwind_data, Rboolean jump) { - if (jump) { - unwind_data_t* data = static_cast(unwind_data); - longjmp(data->jmpbuf, 1); - } -} - -} // namespace internal - -inline SEXP init_unwind_continuation() { - SEXP res = R_MakeUnwindCont(); - R_PreserveObject(res); - return res; -} - /// Unwind Protection from C longjmp's, like those used in R error handling /// /// @param code The code to which needs to be protected, as a nullary callable template ()()), SEXP>::value>::type> SEXP unwind_protect(Fun&& code) { - static SEXP token = init_unwind_continuation(); - internal::unwind_data_t unwind_data; + static SEXP token = [] { + SEXP res = R_MakeUnwindCont(); + R_PreserveObject(res); + return res; + }(); - if (setjmp(unwind_data.jmpbuf)) { + std::jmp_buf jmpbuf; + if (setjmp(jmpbuf)) { throw unwind_exception(token); } @@ -143,26 +125,24 @@ SEXP unwind_protect(Fun&& code) { auto callback = static_cast(data); return static_cast(*callback)(); }, - &code, internal::maybe_jump, &unwind_data, token); + &code, + [](void* jmpbuf, Rboolean jump) { + if (jump) { + // We need to first jump back into the C++ stacks because you can't safely throw + // exceptions from C stack frames. + longjmp(*static_cast(jmpbuf), 1); + } + }, + &jmpbuf, token); } template ()()), void>::value>::type> void unwind_protect(Fun&& code) { - static SEXP token = init_unwind_continuation(); - internal::unwind_data_t unwind_data; - - if (setjmp(unwind_data.jmpbuf)) { - throw unwind_exception(token); - } - - (void)R_UnwindProtect( - [](void* data) -> SEXP { - auto callback = static_cast(data); - static_cast (*callback)(); - return R_NilValue; - }, - &code, internal::maybe_jump, &unwind_data, token); + (void)unwind_protect([&] { + std::forward(code)(); + return R_NilValue; + }); } template ()())> @@ -170,7 +150,10 @@ typename std::enable_if::value && !std::is_same: R>::type unwind_protect(Fun&& code) { R out; - unwind_protect([&] { out = std::forward(code)(); }); + (void)unwind_protect([&] { + out = std::forward(code)(); + return R_NilValue; + }); return out; }