Redefine kas_bug_assert() and tsk_trace_error() that use stderr #5

Author: gregorgorjanc

tskitr/R/RcppExports.R

@@ -9,6 +9,14 @@ test_tsk_bug_assert_cpp <- function() {
     invisible(.Call(`_tskitr_test_tsk_bug_assert_cpp`))
 }
 
+test_tsk_trace_error_c <- function() {
+    invisible(.Call(`_tskitr_test_tsk_trace_error_c`))
+}
+
+test_tsk_trace_error_cpp <- function() {
+    invisible(.Call(`_tskitr_test_tsk_trace_error_cpp`))
+}
+
 #' Report the version of installed kastore C API
 #'
 #' @details The version is stored in the installed header \code{kastore.h}.

tskitr/inst/include/tskit/core.h

@@ -1,3 +1,6 @@
+#ifndef TSKITR_TSKIT_CORE_H
+#define TSKITR_TSKIT_CORE_H
+
 // Shim header to use tskit C API in Rcpp code in an R session or an R package
 #include <tskit/tskit/core.h>
 
@@ -27,3 +30,31 @@
     }                                                                          \
   } while (0)
 #endif
+
+// Redefinition of tsk_trace_error to avoid writing to stderr from tskit C API
+// (following R extensions manual recommendations).
+// While tsk_trace_error is called only in C API (atm) we provide both C and C++
+// macros for completeness.
+#undef tsk_trace_error
+#ifdef TSK_TRACE_ERRORS
+#ifdef __cplusplus
+static inline int _tskitr_trace_error_cpp(int err, int line, const char *file) {
+  Rcpp::warning("tskit-trace-error: %d='%s' at line %d in %s\n", err,
+                tsk_strerror(err), line, file);
+  return err;
+}
+#define tsk_trace_error(err)                                                   \
+  (_tskitr_trace_error_cpp((err), __LINE__, __FILE__))
+#else
+static inline int _tskitr_trace_error_c(int err, int line, const char *file) {
+  Rf_warning("tskit-trace-error: %d='%s' at line %d in %s\n", err,
+             tsk_strerror(err), line, file);
+  return err;
+}
+#define tsk_trace_error(err) (_tskitr_trace_error_c((err), __LINE__, __FILE__))
+#endif
+#else
+#define tsk_trace_error(err) (err)
+#endif
+
+#endif

tskitr/inst/include/tskit/kastore.h

@@ -1,2 +1,18 @@
 // Shim header to use tskit C API in Rcpp code in an R session or an R package
 #include <tskit/tskit/kastore.h>
+
+// Redefinition of kas_bug_assert to avoid aborting R sessions with tskit C API
+// (following R extensions manual recommendations).
+// Since kastore is only used by tskit C API we provide only C macros.
+#ifndef __cplusplus
+// Override kas_bug_assert to use R-style error handling in C code.
+#undef kas_bug_assert
+#include <R_ext/Error.h>
+#define kas_bug_assert(condition)                                              \
+  do {                                                                         \
+    if (!(condition)) {                                                        \
+      Rf_error("Bug detected in %s at line %d. %s", __FILE__, __LINE__,        \
+               KAS_BUG_ASSERT_MESSAGE);                                        \
+    }                                                                          \
+  } while (0)
+#endif

tskitr/src/Makevars.in

@@ -17,11 +17,11 @@ TSKIT_OBJECTS = $(TSKIT_SOURCES:.c=.o)
 # TSKITR_CPP_SOURCES = $(wildcard *.cpp) # wildcard is a GNU extension and not desired on CRAN
 TSKITR_CPP_SOURCES = \
 	tskitr.cpp \
-	test_tsk_bug_assert.cpp \
+	test_tsk_abort_stderr.cpp \
 	RcppExports.cpp
 # $(info TSKITR_CPP_SOURCES = $(TSKITR_CPP_SOURCES)) # for debugging, info is also a GNU extension
 TSKITR_C_SOURCES = \
-	test_tsk_bug_assert_c.c
+	test_tsk_abort_stderr_c.c
 # $(info TSKITR_C_SOURCES = $(TSKITR_C_SOURCES)) # for debugging, info is also a GNU extension
 TSKITR_OBJECTS = $(TSKITR_CPP_SOURCES:.cpp=.o) $(TSKITR_C_SOURCES:.c=.o)
 # $(info TSKITR_OBJECTS = $(TSKITR_OBJECTS)) # for debugging, info is also a GNU extension
@@ -41,12 +41,14 @@ PKG_CPPFLAGS = \
 
 # Compiler flags
 PKG_CFLAGS = -DNDEBUG # to remove calls to assert() as per the R extensions manual
+# PKG_CFLAGS = -DNDEBUG -DTSK_TRACE_ERRORS
 # TODO: Should we port any flags from extern/tskit/c/meson.build to R build system? #6
 #       https://github.com/HighlanderLab/tskitr/issues/6
 #       See default flags used by clang  (see below output from devtools::install())
 # clang -arch arm64 -I../inst/include -I../inst/include/tskit -I../inst/include/tskit/tskit -I/opt/homebrew/opt/gettext/include  -falign-functions=64 -Wall -g -O2  -c tskit/convert.c -o tskit/convert.o
 # PKG_CFLAGS   = -O2 -Wall
 # PKG_CXXFLAGS = -O2 -Wall
+# PKG_CXXFLAGS = -DTSK_TRACE_ERRORS
 
 # Explicit compile rule for tskit C files
 tskit/%.o: tskit/%.c

tskitr/src/RcppExports.cpp

@@ -28,6 +28,24 @@ BEGIN_RCPP
     return R_NilValue;
 END_RCPP
 }
+// test_tsk_trace_error_c
+void test_tsk_trace_error_c();
+RcppExport SEXP _tskitr_test_tsk_trace_error_c() {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    test_tsk_trace_error_c();
+    return R_NilValue;
+END_RCPP
+}
+// test_tsk_trace_error_cpp
+void test_tsk_trace_error_cpp();
+RcppExport SEXP _tskitr_test_tsk_trace_error_cpp() {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    test_tsk_trace_error_cpp();
+    return R_NilValue;
+END_RCPP
+}
 // kastore_version
 Rcpp::IntegerVector kastore_version();
 RcppExport SEXP _tskitr_kastore_version() {
@@ -230,6 +248,8 @@ END_RCPP
 static const R_CallMethodDef CallEntries[] = {
     {"_tskitr_test_tsk_bug_assert_c", (DL_FUNC) &_tskitr_test_tsk_bug_assert_c, 0},
     {"_tskitr_test_tsk_bug_assert_cpp", (DL_FUNC) &_tskitr_test_tsk_bug_assert_cpp, 0},
+    {"_tskitr_test_tsk_trace_error_c", (DL_FUNC) &_tskitr_test_tsk_trace_error_c, 0},
+    {"_tskitr_test_tsk_trace_error_cpp", (DL_FUNC) &_tskitr_test_tsk_trace_error_cpp, 0},
     {"_tskitr_kastore_version", (DL_FUNC) &_tskitr_kastore_version, 0},
     {"_tskitr_tskit_version", (DL_FUNC) &_tskitr_tskit_version, 0},
     {"_tskitr_ts_load", (DL_FUNC) &_tskitr_ts_load, 2},

tskitr/src/test_tsk_abort_stderr.cpp

@@ -0,0 +1,18 @@
+#include <Rcpp.h>
+#include <tskit/core.h>
+
+extern "C" void tskitr_bug_assert_c(void);
+
+// [[Rcpp::export]]
+void test_tsk_bug_assert_c() { tskitr_bug_assert_c(); }
+
+// [[Rcpp::export]]
+void test_tsk_bug_assert_cpp() { tsk_bug_assert(0); }
+
+extern "C" void tskitr_trace_error_c(void);
+
+// [[Rcpp::export]]
+void test_tsk_trace_error_c() { tskitr_trace_error_c(); }
+
+// [[Rcpp::export]]
+void test_tsk_trace_error_cpp() { tsk_trace_error(-1); }

tskitr/src/test_tsk_bug_assert_c.c tskitr/src/test_tsk_abort_stderr_c.ctskitr/src/test_tsk_bug_assert_c.c renamed to tskitr/src/test_tsk_abort_stderr_c.c

@@ -1,3 +1,5 @@
 #include <tskit/core.h>
 
 void tskitr_bug_assert_c(void) { tsk_bug_assert(0); }
+
+void tskitr_trace_error_c(void) { tsk_trace_error(-1); }

tskitr/src/test_tsk_bug_assert.cpp

@@ -16,3 +16,10 @@ test_that("tsk_bug_assert() works", {
   expect_error(test_tsk_bug_assert_c())
   expect_error(test_tsk_bug_assert_cpp())
 })
+
+test_that("tsk_trace_error() works", {
+  t <- "You have to compile with -DTSK_TRACE_ERRORS to test theses - see src/Makevars.in"
+  skip(t)
+  expect_warning(test_tsk_trace_error_c())
+  expect_warning(test_tsk_trace_error_cpp())
+})