From c625bc17a071a3b10c48c130e8c6d102d26bd6b7 Mon Sep 17 00:00:00 2001
From: reinhardfurrer <reinhard.furrer@math.uzh.ch>
Date: Thu, 3 Oct 2024 19:26:40 +0200
Subject: [PATCH] Version 1.2
---
DESCRIPTION | 10 +++++-----
NEWS | 13 ++++++++++---
dotCall64.Rproj | 21 +++++++++++++++++++++
src/dotCall64.c | 24 ++++++++++++++----------
tests/testthat/test-againstDotC.R | 8 ++++----
tests/testthat/test-flow-center.R | 18 +++++++++---------
tests/testthat/test-flow-left.R | 14 +++++++-------
tests/testthat/test-flow-right.R | 4 ++--
tests/testthat/test-long_int64.R | 10 ++++++++--
9 files changed, 80 insertions(+), 42 deletions(-)
create mode 100644 dotCall64.Rproj
diff --git a/DESCRIPTION b/DESCRIPTION
index a36be37..16a9544 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,15 +1,15 @@
Package: dotCall64
Type: Package
Title: Enhanced Foreign Function Interface Supporting Long Vectors
-Version: 1.1-0
-Date: 2023-10-16
+Version: 1.2
+Date: 2024-10-03
Authors@R: c(person("Kaspar", "Moesinger", role = c("aut"),
email = "kaspar.moesinger@gmail.com"),
person("Florian", "Gerber", role = c("aut"),
email = "flora.fauna.gerber@gmail.com",
comment = c(ORCID = "0000-0001-8545-5263")),
person("Reinhard", "Furrer", role = c("cre", "ctb"),
- email = "reinhard.furrer@math.uzh.ch",
+ email = "reinhard.furrer@uzh.ch",
comment = c(ORCID = "0000-0002-6319-2332")))
Description: Provides .C64(), which is an enhanced version of .C()
and .Fortran() from the foreign function interface. .C64() supports long
@@ -20,7 +20,7 @@ License: GPL (>= 2)
URL: https://git.math.uzh.ch/reinhard.furrer/dotCall64
BugReports: https://git.math.uzh.ch/reinhard.furrer/dotCall64/-/issues
Depends:
- R (>= 3.1)
+ R (>= 4.0)
Suggests:
microbenchmark,
RhpcBLASctl,
@@ -32,4 +32,4 @@ Collate:
'vector_dc.R'
'dotCall64.R'
'zzz.R'
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.3
diff --git a/NEWS b/NEWS
index 4158a14..11fd7fc 100644
--- a/NEWS
+++ b/NEWS
@@ -1,8 +1,15 @@
# dotCall64
+# 1.2
+* Depends on R >= 4.0
+* Addressed non-API call to R (here `NAMED` within `MAYBE_SHARED`).
+
+# 1.1-1
+Date: 2023-11-28
+* Addressed `[-Wformat=]` issue resulting on variable type of `R_xlen_t`
# 1.1-0
-Date: 2022-10-16
-* Addressed issue from `_R_CHECK_FORTRAN_KIND_DETAILS_`
+Date: 2023-10-16
+* Addressed issue from `_R_CHECK_FORTRAN_KIND_DETAILS_`
* Switched from "OpenMPController" to "RhpcBLASctl"
* Minor changes in `CITATION`
@@ -37,4 +44,4 @@ Date: Tue Dec 5 21:37:52 2017 +0100
* register native routines
# 0.9-4
-* CRAN release.
\ No newline at end of file
+* CRAN release.
diff --git a/dotCall64.Rproj b/dotCall64.Rproj
new file mode 100644
index 0000000..30e02be
--- /dev/null
+++ b/dotCall64.Rproj
@@ -0,0 +1,21 @@
+Version: 1.0
+
+RestoreWorkspace: No
+SaveWorkspace: No
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: knitr
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace
diff --git a/src/dotCall64.c b/src/dotCall64.c
index 9549f5e..a3cd9ae 100644
--- a/src/dotCall64.c
+++ b/src/dotCall64.c
@@ -1,11 +1,11 @@
#include "dotCall64.h"
-// MAYBE_SHARED is not available in R 3.0.1
-#ifndef MAYBE_SHARED
-#define MAYBE_SHARED(x) (NAMED(x) > 1)
-#define NO_REFERENCES(x) (NAMED(x) == 0)
-#define MAYBE_REFERENCED(x) (! NO_REFERENCES(x))
-#endif
+// MAYBE_SHARED is not available in R 3.0.1, done in R >= 4.0
+// #ifndef MAYBE_SHARED
+// #define MAYBE_SHARED(x) (NAMED(x) > 1)
+// #define NO_REFERENCES(x) (NAMED(x) == 0)
+// #define MAYBE_REFERENCED(x) (! NO_REFERENCES(x))
+// #endif
/* See http://cran.r-project.org/doc/manuals/R-exts.html#C_002dlevel-messages */
#ifdef ENABLE_NLS
@@ -156,8 +156,11 @@ SEXP dC64(SEXP args_in) {
int type = dotCall64str2type(STRING_ELT(getListElement(s, "mode"), 0));
len = asReal(getListElement(s, "length"));
if(flag_verbose == 2)
- warning(_("[dotCall64|vector_dc] argument %d; allocate vector of type %s (%d); length %d"), na+1,
- CHAR(STRING_ELT(getListElement(s, "mode"), 0)), type, len);
+ // eliminated the %d-len printing due to issues on CRAN. See emails 27 November, 2023 08:58
+ // warning(_("[dotCall64|vector_dc] argument %d; allocate vector of type %s (%d); length %d"), na+1,
+ // CHAR(STRING_ELT(getListElement(s, "mode"), 0)), type, len);
+ warning(_("[dotCall64|vector_dc] argument %d; allocate vector of type %s (%d)"), na+1,
+ CHAR(STRING_ELT(getListElement(s, "mode"), 0)), type);
args[na] = PROTECT(allocInitializedVector(type, len));
n_protect++;
}
@@ -375,10 +378,11 @@ void dotCall64(DL_FUNC fun, int nargs, SEXP *args, int *args_type, int *args_int
}
if(flag_verbose == 2){
- warning(_("[dotCall64|flags] arg %d: type %s (%d); alloc %d; coerce %d; dup %d;\ncast.in %d; cast.back %d; named: %d, mb-ref %d; mb-shared %d\n"),
+ warning(_("[dotCall64|flags] arg %d: type %s (%d); alloc %d; coerce %d; dup %d;\ncast.in %d; cast.back %d; mb-ref %d; mb-shared %d\n"),
na+1, type2char(do_type[na]), do_type[na], do_alloc[na],
do_coerce[na], do_duplicate[na], do_cast_in[na], do_cast_back[na],
- NAMED(s), maybe_referenced, maybe_shared);
+ // NAMED(s),
+ maybe_referenced, maybe_shared);
}
}
diff --git a/tests/testthat/test-againstDotC.R b/tests/testthat/test-againstDotC.R
index f26a817..4a8d20d 100644
--- a/tests/testthat/test-againstDotC.R
+++ b/tests/testthat/test-againstDotC.R
@@ -8,7 +8,7 @@ test_that("int", {
PACKAGE = "dotCall64")
expect_equal(cc, dc, label = "[values]")
expect_equal(lapply(cc, typeof), lapply(dc, typeof),
- label = "[types]")
+ label = "[types]")
})
@@ -21,7 +21,7 @@ test_that("double", {
PACKAGE = "dotCall64")
expect_equal(cc, dc, label = "[values]")
expect_equal(lapply(cc, typeof), lapply(dc, typeof),
- label = "[types]")
+ label = "[types]")
})
## --------------------
@@ -35,7 +35,7 @@ test_that("referenced-integer", {
PACKAGE = "dotCall64")
expect_equal(cc, dc, label = "[values]")
expect_equal(lapply(cc, typeof), lapply(dc, typeof),
- label = "[types]")
+ label = "[types]")
expect_identical(input, 2L)
})
@@ -49,6 +49,6 @@ test_that("referenced-double", {
PACKAGE = "dotCall64")
expect_equal(cc, dc, label = "[values]")
expect_equal(lapply(cc, typeof), lapply(dc, typeof),
- label = "[types]")
+ label = "[types]")
expect_identical(input, 2.2)
})
diff --git a/tests/testthat/test-flow-center.R b/tests/testthat/test-flow-center.R
index 91f4bae..91e39f3 100644
--- a/tests/testthat/test-flow-center.R
+++ b/tests/testthat/test-flow-center.R
@@ -7,7 +7,7 @@ test_that("double-double", {
PACKAGE = "dotCall64",
VERBOSE = 1)
dc_e <- list(a = 6.6, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3.3, label = "[modified R object]")
@@ -27,7 +27,7 @@ test_that("double-double-modifiedRead", {
a = a, b = 2, INTENT = c("r", "rw"),
PACKAGE = "dotCall64", VERBOSE = 1)
dc_e <- list(a = NULL, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 6.6, label = "[modified R object]")
@@ -50,7 +50,7 @@ test_that("int-int", {
a = a, b = 2L,
PACKAGE = "dotCall64", VERBOSE = 1)
dc_e <- list(a = 6L, b = 2L)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3L, label = "[modified R object]")
@@ -65,12 +65,12 @@ test_that("int-int", {
test_that("int-int-modifiedRead", {
- a <- 3L
+ a <- 3L
dc <- .C64("TEST_prod_int", c("int", "int"),
a = a, b = 2L, INTENT = c("r", "rw"),
PACKAGE = "dotCall64", VERBOSE = 1)
dc_e <- list(a = NULL, b = 2L)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 6L, label = "[modified R object]")
@@ -94,7 +94,7 @@ test_that("int-double-rw", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = 6L, b = 2L)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
@@ -117,7 +117,7 @@ test_that("int-double-r", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = NULL, b = 2L)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
@@ -141,7 +141,7 @@ test_that("double-int-rw", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = 6, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3L, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
@@ -164,7 +164,7 @@ test_that("double-int-r", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = NULL, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 3L, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
diff --git a/tests/testthat/test-flow-left.R b/tests/testthat/test-flow-left.R
index 5d0b038..b3a6336 100644
--- a/tests/testthat/test-flow-left.R
+++ b/tests/testthat/test-flow-left.R
@@ -6,7 +6,7 @@ test_that("int64-double-rw", {
a = a, b = 2,
PACKAGE = "dotCall64", VERBOSE = 1)
dc_e <- list(a = 2**33, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 2**32, label = "[modified R object]")
@@ -23,7 +23,7 @@ test_that("int64-double-r", {
a = a, b = 2, INTENT = c("r", "rw"),
PACKAGE = "dotCall64", VERBOSE = 1)
dc_e <- list(a = NULL, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 2**32, label = "[modified R object]")
## a not modified, because not in place double -> long int transition
@@ -46,7 +46,7 @@ test_that("int64-integer-rw", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = 10, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 5L, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
@@ -67,7 +67,7 @@ test_that("int64-integer-r", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = NULL, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 5L, label = "[modified R object]")
## a not modified, because not in place double -> long int transition
@@ -92,7 +92,7 @@ test_that("int64-complex-rw", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = 10, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 5+5i, label = "[modified R object]")
expect_warning(eval(expr), "[dotCall64|wrong R object type]",
@@ -101,7 +101,7 @@ test_that("int64-complex-rw", {
expr <- expression(.C64("TEST_prod_int64", c("int64", "int64"),
a = a, b = 2+2i,
PACKAGE = "dotCall64", VERBOSE = 2))
-
+
expect_warning(eval(expr),
"alloc 0; coerce 1; dup 0;\ncast.in 1; cast.back 1")
@@ -114,7 +114,7 @@ test_that("int64-complex-r", {
PACKAGE = "dotCall64", VERBOSE = 1))
dc <- suppressWarnings(eval(expr))
dc_e <- list(a = NULL, b = 2)
- expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
+ expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))
expect_equal(dc, dc_e)
expect_identical(a, 5+5i, label = "[modified R object]")
## a not modified, because not in place double -> long int transition
diff --git a/tests/testthat/test-flow-right.R b/tests/testthat/test-flow-right.R
index 3715ae3..611340f 100644
--- a/tests/testthat/test-flow-right.R
+++ b/tests/testthat/test-flow-right.R
@@ -31,7 +31,7 @@ test_that(paste0("right-", paste0(tg[i,], collapse = "-")), {
int = integer_dc(1),
double = numeric_dc(1),
int64 = numeric_dc(1))
-
+
expr <- expression(
.C64(paste0("TEST_times2_", signature),
c(signature, signature),
@@ -59,7 +59,7 @@ test_that(paste0("right-", paste0(tg[i,], collapse = "-")), {
int64 = 2^32),
label = "[corrupt R object]",
info = info)
-
+
if(referenced)
expect_identical(b, switch(type,
int = 1L,
diff --git a/tests/testthat/test-long_int64.R b/tests/testthat/test-long_int64.R
index 4fe0bbb..f229bec 100644
--- a/tests/testthat/test-long_int64.R
+++ b/tests/testthat/test-long_int64.R
@@ -3,12 +3,18 @@ context("test-local-tests")
test_that("pass-long-int64_t", {
skip_on_cran()
- a <- numeric(2^31)
+
+ # Ideally, the following should be tested with N <- 31. Blows my laptop...
+ N <- 31
+ N <- 21
+
+ a <- numeric(2^N)
+
expect_identical(.C64("BENCHMARK",
SIGNATURE = "int64",
a = a,
INTENT = "rw",
- NAOK = TRUE,
+ NAOK = TRUE,
VERBOSE = 1,
PACKAGE = "dotCall64")$a,
a)
--
GitLab