Split monolithic r2f tests into focused files

DESCRIPTION

@@ -27,6 +27,8 @@ Suggests:
     rlang,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
+Config/testthat/parallel: true
+Config/testthat/start-first: unary-intrinsics, loops
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2

scripts/setup_codex.sh

@@ -112,8 +112,16 @@ apt-get install -y --no-install-recommends r-cran-devtools  # not strictly neces
 
 
 
+# Interactively asked codex how many cores are available
+# it ran nproc and got back 5
+echo >> ~/.Renviron <<'EOF'
+NOT_CRAN=true
+TESTTHAT_CPUS=5
+EOF
+
 echo >> ~/.Rprofile <<'EOF'
 options(
+  Ncpus = 4L,
   testthat.use_colours = FALSE,
   # testthat.summary.max_reports: The maximum number of detailed test reports printed for the summary reporter (default: 10).
   testthat.summary.omit_dots = TRUE

tests/testthat/_snaps/add.md

@@ -0,0 +1,139 @@
+# add1
+
+    Code
+      slow_add1
+    Output
+      function(x) {
+          declare(type(x = double(NA)))
+          x <- x + 1
+          x
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine slow_add1(x, x__len_) bind(c)
+        use iso_c_binding, only: c_double, c_ptrdiff_t
+        implicit none
+
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: x__len_
+
+        ! args
+        real(c_double), intent(in out) :: x(x__len_)
+        ! manifest end
+
+
+        x = (x + 1.0_c_double)
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+
+
+      extern void slow_add1(double* const x__, const R_xlen_t x__len_);
+
+      SEXP slow_add1_(SEXP _args) {
+        // x
+        _args = CDR(_args);
+        SEXP x = CAR(_args);
+        if (TYPEOF(x) != REALSXP) {
+          Rf_error("typeof(x) must be 'double', not '%s'", R_typeToChar(x));
+        }
+        x = Rf_duplicate(x);
+        SETCAR(_args, x);
+        double* const x__ = REAL(x);
+        const R_xlen_t x__len_ = Rf_xlength(x);
+
+
+        slow_add1(x__, x__len_);
+
+        return x;
+      }
+
+# add2
+
+    Code
+      slow_add2
+    Output
+      function(x, y) {
+          declare(type(x = integer(n)), type(y = integer(n)))
+          out <- x + y
+          out
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine slow_add2(x, y, out, x__len_) bind(c)
+        use iso_c_binding, only: c_int, c_ptrdiff_t
+        implicit none
+
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: x__len_
+
+        ! args
+        integer(c_int), intent(in) :: x(x__len_)
+        integer(c_int), intent(in) :: y(x__len_)
+        integer(c_int), intent(out) :: out(x__len_)
+        ! manifest end
+
+
+        out = (x + y)
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+
+
+      extern void slow_add2(
+        const int* const x__, 
+        const int* const y__, 
+        int* const out__, 
+        const R_xlen_t x__len_);
+
+      SEXP slow_add2_(SEXP _args) {
+        // x
+        _args = CDR(_args);
+        SEXP x = CAR(_args);
+        if (TYPEOF(x) != INTSXP) {
+          Rf_error("typeof(x) must be 'integer', not '%s'", R_typeToChar(x));
+        }
+        const int* const x__ = INTEGER(x);
+        const R_xlen_t x__len_ = Rf_xlength(x);
+
+        // y
+        _args = CDR(_args);
+        SEXP y = CAR(_args);
+        if (TYPEOF(y) != INTSXP) {
+          Rf_error("typeof(y) must be 'integer', not '%s'", R_typeToChar(y));
+        }
+        const int* const y__ = INTEGER(y);
+        const R_xlen_t y__len_ = Rf_xlength(y);
+
+        if (x__len_ != y__len_)
+          Rf_error("length(y) must equal length(x),"
+                   " but are %0.f and %0.f",
+                    (double)y__len_, (double)x__len_);
+        const R_xlen_t out__len_ = x__len_;
+        SEXP out = PROTECT(Rf_allocVector(INTSXP, out__len_));
+        int* out__ = INTEGER(out);
+
+        slow_add2(
+          x__,
+          y__,
+          out__,
+          x__len_);
+
+        UNPROTECT(1);
+        return out;
+      }
+

tests/testthat/_snaps/div-mod.md

@@ -0,0 +1,162 @@
+# %% and %/%
+
+    Code
+      fn
+    Output
+      function(a, b) {
+          declare(type(a = double(n)), type(b = double(n)))
+          a %% b
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(a, b, out_, a__len_) bind(c)
+        use iso_c_binding, only: c_double, c_ptrdiff_t
+        implicit none
+
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: a__len_
+
+        ! args
+        real(c_double), intent(in) :: a(a__len_)
+        real(c_double), intent(in) :: b(a__len_)
+        real(c_double), intent(out) :: out_(a__len_)
+        ! manifest end
+
+
+        out_ = modulo(a, b)
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+
+
+      extern void fn(
+        const double* const a__, 
+        const double* const b__, 
+        double* const out___, 
+        const R_xlen_t a__len_);
+
+      SEXP fn_(SEXP _args) {
+        // a
+        _args = CDR(_args);
+        SEXP a = CAR(_args);
+        if (TYPEOF(a) != REALSXP) {
+          Rf_error("typeof(a) must be 'double', not '%s'", R_typeToChar(a));
+        }
+        const double* const a__ = REAL(a);
+        const R_xlen_t a__len_ = Rf_xlength(a);
+
+        // b
+        _args = CDR(_args);
+        SEXP b = CAR(_args);
+        if (TYPEOF(b) != REALSXP) {
+          Rf_error("typeof(b) must be 'double', not '%s'", R_typeToChar(b));
+        }
+        const double* const b__ = REAL(b);
+        const R_xlen_t b__len_ = Rf_xlength(b);
+
+        if (a__len_ != b__len_)
+          Rf_error("length(b) must equal length(a),"
+                   " but are %0.f and %0.f",
+                    (double)b__len_, (double)a__len_);
+        const R_xlen_t out___len_ = a__len_;
+        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
+        double* out___ = REAL(out_);
+
+        fn(
+          a__,
+          b__,
+          out___,
+          a__len_);
+
+        UNPROTECT(1);
+        return out_;
+      }
+
+---
+
+    Code
+      fn
+    Output
+      function(a, b) {
+          declare(type(a = double(n)), type(b = double(n)))
+          a %/% b
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(a, b, out_, a__len_) bind(c)
+        use iso_c_binding, only: c_double, c_ptrdiff_t
+        implicit none
+
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: a__len_
+
+        ! args
+        real(c_double), intent(in) :: a(a__len_)
+        real(c_double), intent(in) :: b(a__len_)
+        real(c_double), intent(out) :: out_(a__len_)
+        ! manifest end
+
+
+        out_ = floor(a / b)
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+
+
+      extern void fn(
+        const double* const a__, 
+        const double* const b__, 
+        double* const out___, 
+        const R_xlen_t a__len_);
+
+      SEXP fn_(SEXP _args) {
+        // a
+        _args = CDR(_args);
+        SEXP a = CAR(_args);
+        if (TYPEOF(a) != REALSXP) {
+          Rf_error("typeof(a) must be 'double', not '%s'", R_typeToChar(a));
+        }
+        const double* const a__ = REAL(a);
+        const R_xlen_t a__len_ = Rf_xlength(a);
+
+        // b
+        _args = CDR(_args);
+        SEXP b = CAR(_args);
+        if (TYPEOF(b) != REALSXP) {
+          Rf_error("typeof(b) must be 'double', not '%s'", R_typeToChar(b));
+        }
+        const double* const b__ = REAL(b);
+        const R_xlen_t b__len_ = Rf_xlength(b);
+
+        if (a__len_ != b__len_)
+          Rf_error("length(b) must equal length(a),"
+                   " but are %0.f and %0.f",
+                    (double)b__len_, (double)a__len_);
+        const R_xlen_t out___len_ = a__len_;
+        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
+        double* out___ = REAL(out_);
+
+        fn(
+          a__,
+          b__,
+          out___,
+          a__len_);
+
+        UNPROTECT(1);
+        return out_;
+      }
+