Skip to content
Snippets Groups Projects
Commit c625bc17 authored by Reinhard Furrer's avatar Reinhard Furrer
Browse files

Version 1.2

parent aec896e5
Branches master
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
+ 5
− 5
View file @ c625bc17
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
NEWS
+ 10
− 3
View file @ c625bc17
# 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.
dotCall64.Rproj 0 → 100644
+ 21
− 0
View file @ c625bc17
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
src/dotCall64.c
+ 14
− 10
View file @ c625bc17
#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);
}
}
......
tests/testthat/test-againstDotC.R
+ 4
− 4
View file @ c625bc17
......@@ -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)
})
tests/testthat/test-flow-center.R
+ 9
− 9
View file @ c625bc17
......@@ -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]",
......
tests/testthat/test-flow-left.R
+ 7
− 7
View file @ c625bc17
......@@ -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
......
tests/testthat/test-flow-right.R
+ 2
− 2
View file @ c625bc17
......@@ -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,
......
tests/testthat/test-long_int64.R
+ 8
− 2
View file @ c625bc17
......@@ -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)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment