context("C interface")
test_that("check package", {
skip_on_cran()
## This one needs a local installation of ring to work for the
## LinkingTo: interface to work (skip_if_not_installed does not work
## for this as despite the name it doesn't check installation, it
## checks if it can be loaded).
if (!("ring" %in% .packages(TRUE))) {
skip("ring not installed")
}
Sys.setenv("R_TESTS" = "")
R <- file.path(R.home(), "bin", "R")
res <- system2(R, c("CMD", "build", "testing"),
stdout = FALSE, stderr = FALSE)
path <- sprintf("testing_%s.tar.gz", "0.0.1")
res <- system2(R, c("CMD", "check", "--no-manual", path),
stdout = TRUE, stderr = TRUE)
expect_null(attr(res, "status"))
file.remove(path)
unlink("testing.Rcheck", recursive = TRUE)
})
test_that("standalone", {
skip_on_cran()
gcc <- Sys.which("gcc")
if (!nzchar(gcc)) {
skip("No gcc")
}
path <- system.file("include", package = "ring")
args <- c(include_flags(FALSE), "-std=c99",
"-o", "ring_standalone", "ring_standalone.c", "-lm")
code <- system2(gcc, args)
expect_equal(code, 0)
if (file.exists("ring_standalone")) {
code <- system2(normalizePath("ring_standalone"))
expect_equal(code, 0)
file.remove("ring_standalone")
}
})
test_that("standalone (c++)", {
skip_on_cran()
gpp <- Sys.which("g++")
if (!nzchar(gpp)) {
skip("No g++")
}
path <- system.file("include", package = "ring")
args <- c("-I", path, "-o", "ring_standalone", "ring_standalone.cpp")
code <- system2(gpp, args)
expect_equal(code, 0)
if (file.exists("ring_standalone")) {
code <- system2(normalizePath("ring_standalone"))
expect_equal(code, 0)
file.remove("ring_standalone")
}
})
test_that("example", {
skip_on_cran()
Sys.setenv("R_TESTS" = "")
## Here is the R implementation from the vignette:
example <- function(n) {
step <- function(x) {
if (length(x) > 1) {
p <- mean(diff(x)) / 2 + 0.5
} else {
p <- 0.5
}
if (runif(1) < p) x[length(x)] - 1L else x[length(x)] + 1L
}
x <- 0L
buf <- ring_buffer_env(5)
h <- integer(n)
buf$push(x)
h[1L] <- x
for (i in seq_len(length(h) - 1L)) {
x <- step(unlist(buf$read(buf$used())))
buf$push(x)
h[i + 1L] <- x
}
h
}
R <- file.path(R.home(), "bin", "R")
writeLines(paste0("PKG_CPPFLAGS = ", include_flags(FALSE)),
"Makevars")
file.copy(system.file("examples/example.c", package = "ring"), ".",
overwrite = TRUE)
on.exit(file.remove(c("example.c", "Makevars")))
res <- system2(R, c("CMD", "SHLIB", "example.c"),
stdout = FALSE, stderr = FALSE)
expect_equal(res, 0)
dll <- paste0("example", .Platform$dynlib.ext)
dyn.load(dll)
on.exit({
dyn.unload(dll)
file.remove(dll)
file.remove("example.o")
}, add = TRUE)
set.seed(1)
res_r <- example(20)
set.seed(1)
res_c <- .Call("r_example", 20L, PACKAGE = "example")
expect_equal(res_r, res_c)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.