Properly divert quickjs IO/error calling for CRAN

R/qjs.R

@@ -17,7 +17,11 @@
 #'
 #' @export
 qjs_eval <- function(eval_string) {
-  .Call(`qjs_eval_`, eval_string)
+  res <- .Call(`qjs_eval_`, eval_string)
+  if (is.null(res)) {
+    return(invisible(NULL))
+  }
+  res
 }
 
 qjs_context <- function(stack_size) {

inst/tinytest/test_JSContext.R

@@ -36,6 +36,16 @@ jsc$call("env_update", env)
 expect_equal(env$a, 10)
 expect_equal(env$b, 20)
 
+expect_equal(
+  tryCatch({jsc$source(code = "non_exist_fun(1)")}, error = function(e) {as.character(e)}),
+  "Error: JavaScript Exception: \nReferenceError: non_exist_fun is not defined\n    at <eval> (<input>:1:1)\n\n"
+)
+
+expect_equal(
+  capture.output(jsc$source(code = "console.log('Testing value')")),
+  "Testing value"
+)
+
 
 # Fails on 3.6 CI, but can't be replicated locally
 exit_if_not(R.version$major  > "3")

inst/tinytest/test_qjs_eval.R

@@ -6,3 +6,12 @@ expect_equal("Hello World!", qjs_eval("'Hello' + ' ' + 'World!'"))
 expect_equal(list(a = 1, b = "2"),
               qjs_eval("var t = {'a' : 1, 'b' : '2'}; t"))
 
+expect_equal(
+  tryCatch({qjs_eval("non_exist_fun(1)")}, error = function(e) {as.character(e)}),
+  "Error: JavaScript Exception: \nReferenceError: non_exist_fun is not defined\n    at <eval> (<input>:1:1)\n\n"
+)
+
+expect_equal(
+  capture.output(qjs_eval("console.log('Testing value')")),
+  "Testing value"
+)

src/Makevars

@@ -1,5 +1,4 @@
 PKG_CPPFLAGS = -I"include" -I"quickjs" -D_GNU_SOURCE
-PKG_LIBS = libquickjs.o
 
 ifeq ($(OS),Windows_NT)
 	DLL := .dll
@@ -32,18 +31,10 @@ else
 	endif
 endif
 
-SOURCES = quickjsr.cpp init.cpp
-OBJECTS = $(SOURCES:.cpp=.o)
+SOURCES = quickjsr.cpp init.cpp libquickjs.c
+OBJECTS = quickjsr.o init.o libquickjs.o
 
 $(SHLIB): $(OBJECTS)
-$(OBJECTS): build-static
-
-build-static:
-#	@mkdir -p ../inst/include/quickjs
-#	@cp $(wildcard quickjs/*.h) ../inst/include/quickjs
-	$(R_CC) $(ALL_CPPFLAGS) $(ALL_CFLAGS) -funsigned-char -std=gnu11 -c libquickjs.c
-#	@mkdir -p ../inst/lib/$(R_ARCH)
-#	$(AR) -rs ../inst/lib/$(R_ARCH)/libquickjs.a libquickjs.o
 
 clean:
 	$(RM) libquickjs.o $(OBJECTS)

src/include/quickjs_helpers.hpp

@@ -38,12 +38,27 @@ namespace quickjsr {
       val = JS_Eval(ctx, buf, buf_len, filename, eval_flags);
     }
     if (JS_IsException(val)) {
-      js_std_dump_error(ctx);
+      JSValue exc = JS_GetException(ctx);
+      const char* res_str = JS_ToCString(ctx, exc);
+      std::string msg = res_str;
+      JS_FreeCString(ctx, res_str);
+      std::string stack = "";
+      if (JS_IsError(exc)) {
+        JSValue stack_val = JS_GetPropertyStr(ctx, exc, "stack");
+        const char* stack_str = JS_ToCString(ctx, stack_val);
+        stack = stack_str;
+        stack = "\n" + stack;
+        JS_FreeCString(ctx, stack_str);
+        JS_FreeValue(ctx, stack_val);
+      }
+      JS_FreeValue(ctx, exc);
+      JS_FreeValue(ctx, val);
+      cpp11::stop("JavaScript Exception: \n" + msg + stack);
       ret = -1;
     } else {
+      JS_FreeValue(ctx, val);
       ret = 0;
     }
-    JS_FreeValue(ctx, val);
     return ret;
   }
 

src/include/quickjsr/JSValue_to_SEXP.hpp

@@ -2,6 +2,7 @@
 #define QUICKJSR_JSVALUE_TO_SEXP_HPP
 
 #include "cpp11/protect.hpp"
+#include "quickjs.h"
 #include <cpp11.hpp>
 #include <quickjs-libc.h>
 
@@ -252,11 +253,20 @@ inline SEXP JSValue_to_SEXP(JSContext* ctx, const JSValue& val) {
   switch (JS_VALUE_GET_NORM_TAG(val)) {
     case JS_TAG_EXCEPTION: {
       JSValue exc = JS_GetException(ctx);
-      const char* res_str = JS_ToCString(ctx, val);
+      const char* res_str = JS_ToCString(ctx, exc);
       std::string msg = res_str;
       JS_FreeCString(ctx, res_str);
+      std::string stack = "";
+      if (JS_IsError(exc)) {
+        JSValue stack_val = JS_GetPropertyStr(ctx, exc, "stack");
+        const char* stack_str = JS_ToCString(ctx, stack_val);
+        stack = stack_str;
+        stack = "\n" + stack;
+        JS_FreeCString(ctx, stack_str);
+        JS_FreeValue(ctx, stack_val);
+      }
       JS_FreeValue(ctx, exc);
-      cpp11::stop("JavaScript Exception: " + msg);
+      cpp11::stop("JavaScript Exception: \n" + msg + stack);
     }
     case JS_TAG_NULL: {
       return R_NilValue;

src/libquickjs.c

@@ -1,3 +1,119 @@
+#include <stdio.h>
+#include <stdarg.h>
+
+void Rprintf(const char *, ...);
+void REprintf(const char *, ...);
+void Rvprintf(const char *, va_list);
+void REvprintf(const char *, va_list);
+void Rf_error(const char *, ...);
+
+FILE* stdout_dummy = (FILE*)1;
+FILE* stderr_dummy = (FILE*)2;
+
+unsigned long fwrite_wrapper(const void * __ptr, size_t __size, size_t __nitems,
+                     FILE * __stream) {
+  if (__stream == stdout_dummy) {
+    Rprintf("%.*s", (int)(__size * __nitems), (const char*)__ptr);
+    return __nitems;
+  } else if (__stream == stderr_dummy) {
+    REprintf("%.*s", (int)(__size * __nitems), (const char*)__ptr);
+    return __nitems;
+  } else {
+    return fwrite(__ptr, __size, __nitems, __stream);
+  }
+}
+
+int fputs_wrapper(const char *s, FILE *stream) {
+  if (stream == stdout_dummy) {
+    Rprintf("%s", s);
+    return 0;
+  } else if (stream == stderr_dummy) {
+    REprintf("%s", s);
+    return 0;
+  } else {
+    return fputs(s, stream);
+  }
+}
+
+int putchar_wrapper(int c) {
+  char buf[2] = { (char)c, '\0' };
+  Rprintf("%s", buf);
+  return c;
+}
+
+int fputc_wrapper(int c, FILE *stream) {
+  if (stream == stdout_dummy) {
+    char buf[2] = { (char)c, '\0' };
+    Rprintf("%s", buf);
+    return c;
+  } else if (stream == stderr_dummy) {
+    char buf[2] = { (char)c, '\0' };
+    REprintf("%s", buf);
+    return c;
+  } else {
+    return fputc(c, stream);
+  }
+}
+
+int fprintf_wrapper(FILE *stream, const char *format, ...) {
+  va_list args;
+  va_start(args, format);
+  int rtn = 0;
+
+  if (stream == stdout_dummy) {
+    Rvprintf(format, args);
+  } else if (stream == stderr_dummy) {
+    REvprintf(format, args);
+  } else {
+    rtn = vfprintf(stream, format, args);
+  }
+  va_end(args);
+  return rtn;
+}
+
+int fflush_wrapper(FILE *stream) {
+  if (stream == stdout_dummy || stream == stderr_dummy) {
+    return 0;
+  } else {
+    return fflush(stream);
+  }
+}
+
+int puts_wrapper(const char *s) {
+  Rprintf("%s\n", s);
+  return 0;
+}
+
+int printf_wrapper(const char *format, ...) {
+  va_list args;
+  va_start(args, format);
+  Rvprintf(format, args);
+  va_end(args);
+  return 0;
+}
+
+void exit_wrapper(int status) {
+  Rf_error("exit(%d) called from QuickJS", status);
+}
+
+void abort_wrapper() {
+  Rf_error("abort() called from QuickJS");
+}
+
+#define stdout stdout_dummy
+#define stderr stderr_dummy
+#define fwrite fwrite_wrapper
+#define fputs fputs_wrapper
+#define putchar putchar_wrapper
+#define fputc fputc_wrapper
+#define fprintf fprintf_wrapper
+#define fflush fflush_wrapper
+#define puts puts_wrapper
+#define printf printf_wrapper
+#define _exit exit_wrapper
+#define exit exit_wrapper
+#define abort abort_wrapper
+
 #include "quickjs/dtoa.c"
 #include "quickjs/libregexp.c"
 #include "quickjs/libunicode.c"