From f074238d514ca5591586e4ffe530a2b469267d5c Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Wed, 3 Jan 2024 18:56:07 -0600 Subject: [PATCH 1/2] First batch of tests validated --- inst/tinytest/test_aggregates.R | 7 + inst/tinytest/test_arrayschema.R | 42 ++-- inst/tinytest/test_arrayschemaevolution.R | 8 +- inst/tinytest/test_arrowio.R | 15 +- inst/tinytest/test_attr.R | 11 +- inst/tinytest/test_ctx.R | 3 - inst/tinytest/test_dataframe.R | 36 +-- inst/tinytest/test_datetime.R | 10 +- inst/tinytest/test_tiledbarray.R | 274 +++++++++++----------- 9 files changed, 220 insertions(+), 186 deletions(-) diff --git a/inst/tinytest/test_aggregates.R b/inst/tinytest/test_aggregates.R index 691a1418fe..fbcdff0bba 100644 --- a/inst/tinytest/test_aggregates.R +++ b/inst/tinytest/test_aggregates.R @@ -6,6 +6,13 @@ if (!requireNamespace("palmerpenguins", quietly=TRUE)) exit_file("Remainder need tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + library(palmerpenguins) uri <- tempfile() expect_silent(fromDataFrame(penguins, uri, sparse=TRUE)) diff --git a/inst/tinytest/test_arrayschema.R b/inst/tinytest/test_arrayschema.R index 5e714cca1e..38e9636a14 100644 --- a/inst/tinytest/test_arrayschema.R +++ b/inst/tinytest/test_arrayschema.R @@ -1,10 +1,17 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) ctx <- tiledb_ctx(limitTileDBCores()) + +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (get_return_as_preference() != "asis") set_return_as_preference("asis") # baseline value #test_that("tiledb_array_schema default constructor works", { @@ -97,29 +104,28 @@ expect_error(tiledb:::libtiledb_array_schema_set_capacity(sch@ptr, -10)) #test_that("tiledb_array_schema created with encryption", { -if (!(isOldWindows)) { - dir.create(uri <- tempfile()) - key <- "0123456789abcdeF0123456789abcdeF" +if (!isRESTCI) { + uri <- tempfile() + key <- "0123456789abcdeF0123456789abcdeF" - dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 4L), 4L, "INT32"), - tiledb_dim("cols", c(1L, 4L), 4L, "INT32"))) - schema <- tiledb_array_schema(dom, attrs = c(tiledb_attr("a", type = "INT32"))) + dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 4L), 4L, "INT32"), + tiledb_dim("cols", c(1L, 4L), 4L, "INT32"))) + schema <- tiledb_array_schema(dom, attrs = c(tiledb_attr("a", type = "INT32"))) - ##tiledb_array_create_with_key(uri, schema, key) - ## for now calling into function - tiledb:::libtiledb_array_create_with_key(uri, schema@ptr, key) + ##tiledb_array_create_with_key(uri, schema, key) + ## for now calling into function + tiledb:::libtiledb_array_create_with_key(uri, schema@ptr, key) -# ctx <- tiledb_ctx() -# arrptr <- tiledb:::libtiledb_array_open_with_key(ctx@ptr, uri, "WRITE", key) -# A <- new("tiledb_dense", ctx=ctx, uri=uri, as.data.frame=FALSE, ptr=arrptr) + ## ctx <- tiledb_ctx() + ## arrptr <- tiledb:::libtiledb_array_open_with_key(ctx@ptr, uri, "WRITE", key) + ## A <- new("tiledb_dense", ctx=ctx, uri=uri, as.data.frame=FALSE, ptr=arrptr) -# expect_true(is(A, "tiledb_dense")) - ##expect_true(is(schema(A), "tiledb_dense")) - ## can't yet read / write as scheme getter not generalized for encryption + ## expect_true(is(A, "tiledb_dense")) + ##expect_true(is(schema(A), "tiledb_dense")) + ## can't yet read / write as scheme getter not generalized for encryption - unlink(uri, recursive=TRUE) + unlink(uri, recursive=TRUE) } -#}) #test_that("tiledb_array_schema dups setter/getter", { dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 4L), 4L, "INT32"), diff --git a/inst/tinytest/test_arrayschemaevolution.R b/inst/tinytest/test_arrayschemaevolution.R index 99adf3d6ca..5676ea49ff 100644 --- a/inst/tinytest/test_arrayschemaevolution.R +++ b/inst/tinytest/test_arrayschemaevolution.R @@ -1,11 +1,17 @@ library(tinytest) library(tiledb) -#isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) if (Sys.info()[["sysname"]] == "Windows") exit_file("Skip on Windows") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (tiledb_version(TRUE) < "2.11.0") exit_file("Needs TileDB 2.11.* or later") df <- data.frame(key=letters[1:10], diff --git a/inst/tinytest/test_arrowio.R b/inst/tinytest/test_arrowio.R index c115a8da3e..b601d5eaec 100644 --- a/inst/tinytest/test_arrowio.R +++ b/inst/tinytest/test_arrowio.R @@ -1,16 +1,19 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - if (Sys.getenv("CI", "") == "") exit_file("Skip unextended test run") ctx <- tiledb_ctx(limitTileDBCores()) - if (!requireNamespace("arrow", quietly=TRUE)) exit_file("No 'arrow' package.") suppressMessages(library(arrow)) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (get_return_as_preference() != "asis") set_return_as_preference("asis") # baseline value @@ -40,7 +43,7 @@ tiledb_arrow_array_del(aa) ## round-turn test 1: write tiledb first, create arrow object via zero-copy suppressMessages(library(bit64)) n <- 10L -dir.create(tmp <- tempfile()) +tmp <- tempfile() dim <- tiledb_dim("rows", domain=c(1L,n), type="INT32", tile=1L) dom <- tiledb_domain(dim) sch <- tiledb_array_schema(dom, @@ -111,7 +114,7 @@ for (col in c("int8", "uint8", "int16", "uint16", "int32", "uint32", "int64", "u ## n=15 ## round-turn test 2: create arrow object, write tiledb second via zero-copy -dir.create(tmp <- tempfile()) +tmp <- tempfile() n <- 10L ## create a schema but don't fill it yet diff --git a/inst/tinytest/test_attr.R b/inst/tinytest/test_attr.R index 7bfeadff68..17e80bc110 100644 --- a/inst/tinytest/test_attr.R +++ b/inst/tinytest/test_attr.R @@ -3,9 +3,15 @@ library(tiledb) ctx <- tiledb_ctx(limitTileDBCores()) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) isWindows <- Sys.info()[["sysname"]] == "Windows" +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("tiledb_attr constructor works", { a1 <- tiledb_attr(type = "FLOAT64") expect_true(is(a1, "tiledb_attr")) @@ -54,7 +60,6 @@ expect_true(is.na(tiledb::cell_val_num(attrs))) #}) #test_that("tiledb_attr set fill", { -if (isOldWindows) exit_file("skip remainder of this file on old Windows releases") ## test for default dom <- tiledb_domain(dims = tiledb_dim("rows", c(1L, 4L), 4L, "INT32")) @@ -238,7 +243,7 @@ expect_equal(D, res) ## lower-level testing tiledb_query_set_buffer -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() v <- D[, "val"] v[3] <- TRUE # without nullable for simplicity dim <- tiledb_dim(name = "dim", domain = c(0L, 3L), type = "INT32") diff --git a/inst/tinytest/test_ctx.R b/inst/tinytest/test_ctx.R index a3d6f682ee..12a58ee5fb 100644 --- a/inst/tinytest/test_ctx.R +++ b/inst/tinytest/test_ctx.R @@ -1,9 +1,6 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - tiledb_ctx(limitTileDBCores()) #test_that("tiledb_ctx default constructor", { diff --git a/inst/tinytest/test_dataframe.R b/inst/tinytest/test_dataframe.R index c3fc484525..a23bb9078d 100644 --- a/inst/tinytest/test_dataframe.R +++ b/inst/tinytest/test_dataframe.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("tiledb_fromdataframe", { uri <- tempfile() ## turn factor into character @@ -84,7 +88,7 @@ expect_equal(df, chk[,-1]) # omit first col which is added if (tiledb_version(TRUE) < "2.1.0") exit_file("Remaining tests require TileDB 2.1.0 or later") -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, col_index=1) arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -93,7 +97,7 @@ expect_equal(df[,2], na.omit(chk)[,2]) # compare column by column expect_equal(df[,3], na.omit(chk)[,3]) -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, col_index="index") arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -106,7 +110,7 @@ olddf <- df df <- data.frame(chars=olddf$chars, index=olddf$index, # index not in first column val=olddf$vals) -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri) arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -116,7 +120,7 @@ if (getRversion() < '4.0.0') { } expect_equal(df, chk[,-1]) # omit first col which is added -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, col_index=2) arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -124,7 +128,7 @@ if (getRversion() < '4.0.0') chk$chars <- as.character(chk$chars) expect_equal(df[,1], na.omit(chk)[,2]) # compare column by column expect_equal(df[,3], na.omit(chk)[,3]) -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, col_index="index") arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -154,14 +158,14 @@ df <- data.frame(time=round(Sys.time(), "secs") + trunc(cumsum(runif(nobs)*3600) nanotime=as.nanotime(Sys.time() + cumsum(runif(nobs)*3600)), stringsAsFactors=FALSE) -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE) chk <- tiledb_array(uri, return_as="data.frame", extended=FALSE) expect_equivalent(df, chk[]) # skip attribute for (i in seq_len(dim(df)[2])) { - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE, col_index=i) chk <- tiledb_array(uri, return_as="data.frame") expect_equal(df, chk[][,colnames(df)]) # index col comes first so need re-order @@ -181,7 +185,7 @@ df <- data.frame(time = round(Sys.time(), "secs") + trunc(cumsum(runif(nobs)*360 stringsAsFactors=FALSE) -if (dir.exists(uri)) unlink(uri, recursive=TRUE) +uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE) chk <- tiledb_array(uri, return_as="data.frame", extended=FALSE) @@ -189,9 +193,8 @@ newdf <- chk[] if (getRversion() < '4.0.0') newdf$txt <- as.character(newdf$txt) expect_equivalent(df, newdf) # skip attribute - for (i in seq_len(dim(df)[2])) { - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE, col_index=i) chk <- tiledb_array(uri, return_as="data.frame") newdf <- chk[] @@ -201,14 +204,14 @@ for (i in seq_len(dim(df)[2])) { combinations <- list(c(1,2), c(1,3), c(2,4), c(3,5), c(4,5), c(2,3,4)) for (comb in combinations) { - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE, col_index=comb) # by index chk <- tiledb_array(uri, return_as="data.frame") newdf <- chk[] if (getRversion() < '4.0.0') newdf$txt <- as.character(newdf$txt) expect_equal(df, newdf[][, colnames(df)]) - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() fromDataFrame(df, uri, sparse=TRUE, col_index=colnames(df)[comb]) # by name chk <- tiledb_array(uri, return_as="data.frame") newdf <- chk[] @@ -292,7 +295,6 @@ library(palmerpenguins) data <- penguins uri <- tempfile() - fromDataFrame(data, uri, col_index=1:2, mode="schema_only") arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] @@ -305,7 +307,7 @@ chk <- arr[] expect_equal(nrow(chk), nrow(data)) # all data expect_equal(ncol(chk), ncol(data)) # all columns -tiledb_vfs_remove_dir(uri) +uri <- tempfile() fromDataFrame(data, uri, col_index=1:2) # default mode arr <- tiledb_array(uri, return_as="data.frame") chk <- arr[] diff --git a/inst/tinytest/test_datetime.R b/inst/tinytest/test_datetime.R index 2e540e6a50..c7d7300e26 100644 --- a/inst/tinytest/test_datetime.R +++ b/inst/tinytest/test_datetime.R @@ -1,13 +1,17 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - isMacOS <- (Sys.info()['sysname'] == "Darwin") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("Can read / write a simple Date dense vector", { uri <- tempfile() diff --git a/inst/tinytest/test_tiledbarray.R b/inst/tinytest/test_tiledbarray.R index 89fca6dd60..e408352401 100644 --- a/inst/tinytest/test_tiledbarray.R +++ b/inst/tinytest/test_tiledbarray.R @@ -1,22 +1,28 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") -isMacOS <- (Sys.info()['sysname'] == "Darwin") - ctx <- tiledb_ctx(limitTileDBCores()) +isMacOS <- (Sys.info()['sysname'] == "Darwin") hasDataTable <- requireNamespace("data.table", quietly=TRUE) hasTibble <- requireNamespace("tibble", quietly=TRUE) +isCI <- Sys.getenv("CI") != "" +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" ## GitHub Actions had some jobs killed on the larger data portion so we dial mem use down -if (Sys.getenv("CI") != "") set_allocation_size_preference(1024*1024*5) +if (isCI) set_allocation_size_preference(1024*1024*5) + +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("test tiledb_array read/write sparse array with heterogenous date domains", { op <- options() options(stringsAsFactors=FALSE) # accomodate R 3.* -dir.create(tmp <- tempfile()) +tmp <- tempfile() d1 <- tiledb_dim("d1", domain = c(as.Date("2001-01-02"), as.Date("2099-12-31")), tile=1L, @@ -39,12 +45,12 @@ expect_equal(arr[]$val, df[,"val"]) unlink(tmp, recursive = TRUE) options(op) -#}) + #test_that("test tiledb_array read/write sparse array with heterogenous msec domains", { op <- options() options(stringsAsFactors=FALSE) # accomodate R 3.* -dir.create(tmp <- tempfile()) +tmp <- tempfile() d1 <- tiledb_dim("d1", domain = c(0, 1e18), tile=1000L, type="DATETIME_MS") d2 <- tiledb_dim("d2", domain = NULL, tile = NULL, type="ASCII") @@ -65,7 +71,6 @@ expect_equal(arr[]$val, df[,"val"]) unlink(tmp, recursive = TRUE) options(op) -#}) #test_that("test full write-read cycle on sample data using fromDataFrame", { @@ -82,7 +87,7 @@ options(stringsAsFactors=FALSE) # accomodate R 3.* dat <- readRDS(system.file("sampledata", "bankSample.rds", package="tiledb")) -dir.create(tmpuri <- tempfile()) +tmpuri <- tempfile() fromDataFrame(dat[,-1], tmpuri) arr <- tiledb_array(tmpuri, return_as="data.frame") @@ -91,7 +96,7 @@ expect_equal(dat[,-1], newdat[,-1]) unlink(tmpuri, recursive = TRUE) options(op) -#}) + #test_that("test full write-read cycle on sample data using schema", { op <- options() @@ -107,7 +112,7 @@ options(stringsAsFactors=FALSE) # accomodate R 3.* dat <- readRDS(system.file("sampledata", "bankSample.rds", package="tiledb")) -dir.create(tmpuri <- tempfile()) +tmpuri <- tempfile() n <- nrow(dat) dim <- tiledb_dim("rows", domain=c(1L,n), type="INT32", tile=1L) @@ -142,10 +147,7 @@ expect_equivalent(dat, newdat) unlink(tmpuri, recursive = TRUE) options(op) -#}) -## (some) r-universe builds are/were breaking here -if (Sys.getenv("MY_UNIVERSE", "") != "") exit_file("Skip remainder at r-universe") #test_that("test extended flag on reading", { op <- options() @@ -187,7 +189,6 @@ expect_equal(dat1, dat2) unlink(tmpuri, recursive = TRUE) options(op) -#}) #test_that("test attrs column selection on reading", { @@ -204,7 +205,7 @@ options(stringsAsFactors=FALSE) # accomodate R 3.* dat <- readRDS(system.file("sampledata", "bankSample.rds", package="tiledb")) -dir.create(tmpuri <- tempfile()) +tmpuri <- tempfile() fromDataFrame(dat[,-1], tmpuri) arr <- tiledb_array(tmpuri, return_as="data.frame", extended=FALSE) @@ -220,14 +221,14 @@ expect_equal(colnames(dat), sels) unlink(tmpuri, recursive = TRUE) options(op) -#}) + #test_that("test range selection on reading", { set.seed(100) y <- matrix((1:10) + runif(10)/10, 10) -rc <- dir.create(tmpuri <- tempfile()) +tmpuri <- tempfile() d1 <- tiledb_dim("d1", domain = c(1L, 25L), type="INT32", tile=1L) d2 <- tiledb_dim("d2", domain = c(1L, 25L), type="INT32", tile=1L) dom <- tiledb_domain(c(d1, d2)) @@ -278,11 +279,10 @@ expect_equal(nrow(val), 10) expect_equal(val[,"d1"], val[,"d2"]) unlink(tmpuri, recursive = TRUE) -#}) + #test_that("test range selection edge cases", { tmp <- tempfile() -dir.create(tmp) d1 <- tiledb_dim("d1", domain = c(1L, 10L)) d2 <- tiledb_dim("d2", domain = c(1L, 10L)) @@ -308,13 +308,11 @@ selected_points(x) <- list(2,2) # same, but via points val <- x[] expect_equal(nrow(val), 0L) - unlink(tmp, recursive = TRUE) -#}) + #test_that("test range selection edge cases sparse", { tmp <- tempfile() -dir.create(tmp) d1 <- tiledb_dim("d1", domain = c(1, 100)) d2 <- tiledb_dim("d2", domain = c(1, 100)) @@ -344,11 +342,10 @@ val <- x[] expect_equal(nrow(val), 0L) unlink(tmp, recursive = TRUE) -#}) + #test_that("test range selection for multiple dimensions", { tmp <- tempfile() -dir.create(tmp) dom <- tiledb_domain(dims = c(tiledb_dim("d1", c(1L, 4L), 4L, "INT32"), tiledb_dim("d2", c(1L, 4L), 4L, "INT32"), @@ -380,15 +377,13 @@ selected_points(A) <- list(1, 2, NULL, 4) expect_equal(nrow(A[]), 0L) unlink(tmp, recursive = TRUE) -#}) + #test_that("test int64 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) - tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] ## We use @@ -417,12 +412,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { expect_silent(tiledb_dim("rows", as.integer64(c(1,4)), 4L, "INT64")) } + #test_that("test uint64 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] ## We use @@ -451,11 +446,11 @@ if (requireNamespace("bit64", quietly=TRUE)) { expect_silent(tiledb_dim("rows", as.integer64(c(1,4)), 4L, "UINT64")) } + #test_that("test uint32 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT32"), @@ -479,12 +474,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int16 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT16"), @@ -508,12 +503,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint16 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT16"), @@ -537,12 +532,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int8 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT8"), @@ -566,12 +561,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint8 dimension for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT8"), @@ -595,12 +590,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int8 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT8"), @@ -626,12 +621,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint8 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT8"), @@ -657,12 +652,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int16 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT16"), @@ -688,12 +683,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint16 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT16"), @@ -719,12 +714,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int32 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT32"), @@ -750,12 +745,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint32 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "UINT32"), @@ -781,12 +776,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test int64 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", as.integer64(c(1,4)), as.integer64(4), "INT64"), @@ -813,12 +808,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test uint64 dimension for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", as.integer64(c(1,4)), as.integer64(4), "UINT64"), @@ -845,12 +840,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test all integer types as attributes for dense arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT32"), @@ -902,12 +897,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + #test_that("test all integer types as attributes for sparse arrays", { if (requireNamespace("bit64", quietly=TRUE)) { suppressMessages(library(bit64)) tmp <- tempfile() - dir.create(tmp) ## The array will be 4x4 with dimensions "rows" and "cols", with domain [1,4] dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L,4L), 4L, "INT32"), @@ -958,12 +953,12 @@ if (requireNamespace("bit64", quietly=TRUE)) { unlink(tmp, recursive = TRUE) } + if (tiledb_version(TRUE) >= "2.8.0" && tiledb_version(TRUE) < "2.10.0") exit_file("2.8.* and 2.9.* skip remainder") ## n=104 ## non-empty domain, var and plain tmp <- tempfile() -dir.create(tmp) ## create 4x4 with single attribute dom <- tiledb_domain(dims = c(tiledb_dim("d1", c(1L, 4L), 4L, "INT32"), @@ -995,10 +990,10 @@ schema3 <- tiledb::schema(arr) expect_true(is(schema3, "tiledb_array_schema")) expect_equivalent(schema, schema3) # switched to equivalent + ## n=114 ## time travel tmp <- tempfile() -dir.create(tmp) dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 10L), 5L, "INT32"), tiledb_dim("cols", c(1L, 10L), 5L, "INT32"))) schema <- tiledb_array_schema(dom, attrs=c(tiledb_attr("a", type = "INT32")), sparse = TRUE) @@ -1033,10 +1028,10 @@ if (tiledb_version(TRUE) >= "2.10.0") { expect_equal(nrow(A[]), 6) } + ## n=118 ## as.matrix tmp <- tempfile() -dir.create(tmp) ## Generate a matrix n <- 5L k <- 4L @@ -1088,6 +1083,7 @@ expect_equal(length(res), 2L) expect_equal(res$vals, mat) expect_equal(res$vals2, 10*mat) + ## n=134 ## PR #245 (variant of examples/ex_1.R) uri <- tempfile() @@ -1115,6 +1111,7 @@ expect_equal(res[["a"]], data[["a"]]) expect_equal(res[["b"]], data[["b"]]) expect_equal(res[["c"]], data[["c"]]) + ## n=139 ## PR #246 N <- 25L @@ -1131,6 +1128,7 @@ obj[] <- M # prior to #246 this write had a write d chk <- tiledb_array(uri, return_as="matrix") expect_equivalent(chk[], M) + ## n=140 ## test for data.frame append if (!requireNamespace("palmerpenguins", quietly=TRUE)) exit_file("remainder needs 'palmerpenguins'") @@ -1180,6 +1178,7 @@ res2 <- arr[] expect_equal(nrow(res2), 2) expect_equal(res1, res2) + ## FYI: 152 tests here ## check for strings_as_factors arr <- tiledb_array(uri, return_as="data.frame") @@ -1216,6 +1215,7 @@ expect_equal(sum(is.na(res[1:3,1:2])), 6) # arr[1:3,1:2] all NA expect_equal(res[1:3,3:4], mat[1:3,3:4]) expect_equal(res[4:5,1:4], mat[4:5,1:4]) + ## issue 259 dense array with n>2 dimensions dom <- tiledb_domain(dims = list(tiledb_dim("rows", c(1L, 10L), 10L, "INT32"), tiledb_dim("cols", c(1L, 5L), 5L, "INT32"), @@ -1237,20 +1237,20 @@ res <- chk[] expect_equal(dim(res), c(100,6)) expect_equal(colnames(res), c("rows", "cols", "time", "a", "b", "c")) -## consolidate -expect_equal(array_consolidate(uri), NULL) -expect_error(array_consolidate(uri, start_time="abc")) # not a datetime -expect_error(array_consolidate(uri, end_time="def")) # not a datetime -now <- Sys.time() -expect_equal(array_consolidate(uri, start_time=now-60, end_time=now), NULL) - -## vaccum -expect_equal(array_vacuum(uri), NULL) -expect_error(array_vacuum(uri, start_time="abc")) # not a datetime -expect_error(array_vacuum(uri, end_time="def")) # not a datetime -expect_equal(array_vacuum(uri, start_time=now-60, end_time=now), NULL) - - +if (!isRESTCI) { + ## consolidate + expect_equal(array_consolidate(uri), NULL) + expect_error(array_consolidate(uri, start_time="abc")) # not a datetime + expect_error(array_consolidate(uri, end_time="def")) # not a datetime + now <- Sys.time() + expect_equal(array_consolidate(uri, start_time=now-60, end_time=now), NULL) + + ## vaccum + expect_equal(array_vacuum(uri), NULL) + expect_error(array_vacuum(uri, start_time="abc")) # not a datetime + expect_error(array_vacuum(uri, end_time="def")) # not a datetime + expect_equal(array_vacuum(uri, start_time=now-60, end_time=now), NULL) +} ## test return preference uri <- tempfile() @@ -1301,6 +1301,7 @@ if (hasTibble) { expect_true(inherits(res, "tbl")) } + ## n=178 ## test return_as for array and matrix uri <- tempfile() @@ -1326,6 +1327,7 @@ expect_true(inherits(res, "matrix")) set_return_as_preference(oldConversionValue) # reset baseline value + ## test query_statistics setter and getter uri <- tempfile() fromDataFrame(mtcars, uri) @@ -1442,7 +1444,7 @@ if (v[["major"]] == 2L && v[["minor"]] %in% c(4L, 10L, 11L, 12L, 14L)) exit_file ## CI issues at GitHub for r-release on Windows Server 2019 if (getRversion() < "4.3.0" && Sys.info()[["sysname"]] == "Windows") exit_file("Skip remainder for R 4.2.* on Windows") -if (Sys.info()[["sysname"]] == "Darwin") exit_file("Skip remainder on macOS") +if (isMacOS) exit_file("Skip remainder on macOS") ## check for incomplete status on unsuccessful query -- this no longer fails following some changes made #set_allocation_size_preference(128) # too low for penguins to query fully @@ -1475,81 +1477,83 @@ expect_equal(sum(is.na(oo$sex)), sum(is.na(pp$sex))) expect_equal(sum(oo$sex == "male"), sum(pp$sex == "male")) expect_equal(sum(oo$sex == "female"), sum(pp$sex == "female")) +if (!isRESTCI) { + ## [214] legacy validity mode + tdir <- tempfile() + tgzfile <- system.file("sampledata", "legacy_validity.tar.gz", package="tiledb") + untar(tarfile = tgzfile, exdir = tdir) + uri <- file.path(tdir, "legacy_validity") + cfg <- tiledb_config() + oldcfg <- cfg + cfg["r.legacy_validity_mode"] <- "true" + ctx <- tiledb_ctx(cfg) + arr <- tiledb_array(uri, strings_as_factors=FALSE, return_as="data.frame")[] + expect_equal(dim(arr)[1], 10) + expect_equal(dim(arr)[2], 3) + expect_equivalent(arr, data.frame(key=1:10, + val1=c(letters[1:4], NA, letters[6:7], NA, letters[9:10]), + val2=LETTERS[1:10])) + expect_equal(arr$val1, c(letters[1:4], NA, letters[6:7], NA, letters[9:10])) + ctx <- tiledb_ctx(oldcfg) # reset config + + ## [218] test conversion with metadata + outdir <- tempfile() + dir.create(outdir) + tiledb:::.legacy_validity(uri, outdir, fromlegacy=TRUE) + outuri <- file.path(outdir, "legacy_validity") + chk <- tiledb_array(outuri, return_as="data.frame")[] + expect_equal(dim(arr)[1], 10) + expect_equal(dim(arr)[2], 3) + expect_equivalent(arr, data.frame(key=1:10, + val1=c(letters[1:4], NA, letters[6:7], NA, letters[9:10]), + val2=LETTERS[1:10])) + expect_equal(arr$val1, c(letters[1:4], NA, letters[6:7], NA, letters[9:10])) + arr <- tiledb_array(outuri) + arr <- tiledb_array_open(arr, "READ") + expect_equal(tiledb_num_metadata(arr), 2) # two sets of meta data + mdlst <- tiledb_get_all_metadata(arr) + expect_equal(mdlst[["data"]], c(123L, 456L, 789L)) + expect_equal(mdlst[["text"]], "the quick brown fox") + + + ## n=223 + ## [225] test conversion: larger penguins example + tdir <- tempfile() + tgzfile <- system.file("sampledata", "legacy_write.tar.gz", package="tiledb") + untar(tarfile = tgzfile, exdir = tdir) + inuri <- file.path(tdir, "legacy_write", "penguins") + + outdir <- tempfile() + dir.create(outdir) + cfg["r.legacy_validity_mode"] <- "false" # reset to no conversion to read 'before' + ctx <- tiledb_ctx(cfg) + before <- tiledb_array(inuri, strings_as_factors=TRUE)[] + expect_equal(sum(is.na(before$sex)), 333) + + tiledb:::.legacy_validity(inuri, outdir, fromlegacy=TRUE) + outuri <- file.path(outdir, "penguins") + after <- tiledb_array(outuri, strings_as_factors=TRUE)[] + expect_equal(sum(is.na(after$sex)), 11) + for (col in colnames(before)[-c(1,8)]) {# exclude __tiledb_rows and sex + expect_equal(before[[col]], after[[col]]) + } + -## [214] legacy validity mode -tdir <- tempfile() -tgzfile <- system.file("sampledata", "legacy_validity.tar.gz", package="tiledb") -untar(tarfile = tgzfile, exdir = tdir) -uri <- file.path(tdir, "legacy_validity") -cfg <- tiledb_config() -oldcfg <- cfg -cfg["r.legacy_validity_mode"] <- "true" -ctx <- tiledb_ctx(cfg) -arr <- tiledb_array(uri, strings_as_factors=FALSE, return_as="data.frame")[] -expect_equal(dim(arr)[1], 10) -expect_equal(dim(arr)[2], 3) -expect_equivalent(arr, data.frame(key=1:10, - val1=c(letters[1:4], NA, letters[6:7], NA, letters[9:10]), - val2=LETTERS[1:10])) -expect_equal(arr$val1, c(letters[1:4], NA, letters[6:7], NA, letters[9:10])) -ctx <- tiledb_ctx(oldcfg) # reset config - -## [218] test conversion with metadata -outdir <- tempfile() -dir.create(outdir) -tiledb:::.legacy_validity(uri, outdir, fromlegacy=TRUE) -outuri <- file.path(outdir, "legacy_validity") -chk <- tiledb_array(outuri, return_as="data.frame")[] -expect_equal(dim(arr)[1], 10) -expect_equal(dim(arr)[2], 3) -expect_equivalent(arr, data.frame(key=1:10, - val1=c(letters[1:4], NA, letters[6:7], NA, letters[9:10]), - val2=LETTERS[1:10])) -expect_equal(arr$val1, c(letters[1:4], NA, letters[6:7], NA, letters[9:10])) -arr <- tiledb_array(outuri) -arr <- tiledb_array_open(arr, "READ") -expect_equal(tiledb_num_metadata(arr), 2) # two sets of meta data -mdlst <- tiledb_get_all_metadata(arr) -expect_equal(mdlst[["data"]], c(123L, 456L, 789L)) -expect_equal(mdlst[["text"]], "the quick brown fox") - - -## n=223 -## [225] test conversion: larger penguins example -tdir <- tempfile() -tgzfile <- system.file("sampledata", "legacy_write.tar.gz", package="tiledb") -untar(tarfile = tgzfile, exdir = tdir) -inuri <- file.path(tdir, "legacy_write", "penguins") - -outdir <- tempfile() -dir.create(outdir) -cfg["r.legacy_validity_mode"] <- "false" # reset to no conversion to read 'before' -ctx <- tiledb_ctx(cfg) -before <- tiledb_array(inuri, strings_as_factors=TRUE)[] -expect_equal(sum(is.na(before$sex)), 333) - -tiledb:::.legacy_validity(inuri, outdir, fromlegacy=TRUE) -outuri <- file.path(outdir, "penguins") -after <- tiledb_array(outuri, strings_as_factors=TRUE)[] -expect_equal(sum(is.na(after$sex)), 11) -for (col in colnames(before)[-c(1,8)]) {# exclude __tiledb_rows and sex - expect_equal(before[[col]], after[[col]]) + ## n=232 + newout <- tempfile() + ## legacy validity works on plain char columns, we now have factors so it is a mismatch + ## we could add a switch to revert the new 'with factors' behavior to the old on input + ## but that seems disproportionate to the issue (of legacy validation) at hand + if (tiledb_version(TRUE) < "2.16.0") { + tiledb:::.legacy_validity(outuri, newout, tolegacy=TRUE) + rvturi <- file.path(newout, "penguins") + revert <- tiledb_array(rvturi, strings_as_factors=TRUE)[] + expect_equal(sum(is.na(revert$sex)), 333) + for (col in colnames(before)[-c(1,8)]) # exclude __tiledb_rows + expect_equal(before[[col]], revert[[col]]) + } } -## n=232 -newout <- tempfile() -dir.create(newout) -## legacy validity works on plain char columns, we now have factors so it is a mismatch -## we could add a switch to revert the new 'with factors' behavior to the old on input -## but that seems disproportionate to the issue (of legacy validation) at hand -if (tiledb_version(TRUE) < "2.16.0") { - tiledb:::.legacy_validity(outuri, newout, tolegacy=TRUE) - rvturi <- file.path(newout, "penguins") - revert <- tiledb_array(rvturi, strings_as_factors=TRUE)[] - expect_equal(sum(is.na(revert$sex)), 333) - for (col in colnames(before)[-c(1,8)]) # exclude __tiledb_rows - expect_equal(before[[col]], revert[[col]]) -} ## check for error when setting on N+1 dims D <- data.frame(i=1:10, j=101:110, k=letters[1:10]) From aa1b1241dd4481698a7f4bfb72f4982e75b034a4 Mon Sep 17 00:00:00 2001 From: Dirk Eddelbuettel Date: Fri, 5 Jan 2024 16:09:33 -0600 Subject: [PATCH 2/2] Second batch of tests --- inst/tinytest/test_dim.R | 15 +++++--- inst/tinytest/test_dimsubset.R | 12 ++++-- inst/tinytest/test_domain.R | 10 +++-- inst/tinytest/test_filestore.R | 6 +-- inst/tinytest/test_filter.R | 6 +-- inst/tinytest/test_filterlist.R | 3 -- inst/tinytest/test_fragmentinfo.R | 12 ++++-- inst/tinytest/test_group.R | 15 ++++++-- inst/tinytest/test_libtiledb.R | 53 +++++++++++++------------- inst/tinytest/test_matrix.R | 10 +++-- inst/tinytest/test_metadata.R | 34 ++++++++++------- inst/tinytest/test_misc.R | 3 -- inst/tinytest/test_ordered.R | 7 ++++ inst/tinytest/test_query.R | 18 ++++----- inst/tinytest/test_querycondition.R | 20 ++++------ inst/tinytest/test_shmem.R | 3 ++ inst/tinytest/test_sparsematrix.R | 17 ++++++--- inst/tinytest/test_tiledbarray_extra.R | 2 - inst/tinytest/test_timetravel.R | 35 +++++++++-------- inst/tinytest/test_timetravel_extra.R | 6 +-- inst/tinytest/test_vfs.R | 6 +-- 21 files changed, 167 insertions(+), 126 deletions(-) diff --git a/inst/tinytest/test_dim.R b/inst/tinytest/test_dim.R index e921c5981e..c717050ef9 100644 --- a/inst/tinytest/test_dim.R +++ b/inst/tinytest/test_dim.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("tiledb_dim default constructor", { dim <- tiledb_dim("foo", c(1, 100)) expect_true(is(dim, "tiledb_dim")) @@ -92,7 +96,6 @@ suppressMessages({ }) atttype <- "INT32" intmax <- .Machine$integer.max # shorthand -uri <- tempfile() dimtypes <- c("ASCII", # Variable length string "INT8", # 8-bit integer "UINT8", # 8-bit unsigned integer @@ -119,7 +122,7 @@ dimtypes <- c("ASCII", # Variable length string "DATETIME_AS" # attosecond ) for (dtype in dimtypes) { - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() dom <- switch(dtype, "ASCII" = NULL, "INT8" =, @@ -287,7 +290,7 @@ dimtypes <- c("ASCII", # Variable length string "DATETIME_AS" # attosecond ) for (dtype in dimtypes) { - if (dir.exists(uri)) unlink(uri, recursive=TRUE) + uri <- tempfile() dom <- switch(dtype, "ASCII" = NULL, "INT8" =, diff --git a/inst/tinytest/test_dimsubset.R b/inst/tinytest/test_dimsubset.R index 500912221f..383e2df988 100644 --- a/inst/tinytest/test_dimsubset.R +++ b/inst/tinytest/test_dimsubset.R @@ -5,18 +5,22 @@ library(tinytest) library(tiledb) library(RcppSpdlog) # use logging for some informal profiling -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - if (!requireNamespace("nycflights13", quietly=TRUE)) exit_file("Needed 'nycflights13' package missing") +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + log_setup("test_dimsubset", "warn") # but set the default level to 'warn' -> silent, activate via 'info' ctx <- tiledb_ctx(limitTileDBCores()) log_info("ctx created") op <- options() options(stringsAsFactors=FALSE) # accomodate R 3.* -dir.create(tmp <- tempfile()) +tmp <- tempfile() library(nycflights13) diff --git a/inst/tinytest/test_domain.R b/inst/tinytest/test_domain.R index 2b4422d425..1348399618 100644 --- a/inst/tinytest/test_domain.R +++ b/inst/tinytest/test_domain.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("tiledb_domain basic constructor", { d1 <- tiledb_dim("d1", c(1L, 100L)) dom <- tiledb_domain(list(d1)) diff --git a/inst/tinytest/test_filestore.R b/inst/tinytest/test_filestore.R index 007ffdb262..d3fde2742a 100644 --- a/inst/tinytest/test_filestore.R +++ b/inst/tinytest/test_filestore.R @@ -1,13 +1,13 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - isWindows <- Sys.info()[["sysname"]] == "Windows" ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) exit_file("Skipping during REST CI") + if (tiledb_version(TRUE) < "2.9.0") exit_file("Needs TileDB 2.9.* or later") text_file <- tempfile() diff --git a/inst/tinytest/test_filter.R b/inst/tinytest/test_filter.R index 39303e54fe..60a8088948 100644 --- a/inst/tinytest/test_filter.R +++ b/inst/tinytest/test_filter.R @@ -1,11 +1,11 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) exit_file("Skipping during REST CI") + #test_that("tiledb_filter default constructor", { flt <- tiledb_filter() expect_true(is(flt, "tiledb_filter")) diff --git a/inst/tinytest/test_filterlist.R b/inst/tinytest/test_filterlist.R index 0b2b368e03..492ff02fd6 100644 --- a/inst/tinytest/test_filterlist.R +++ b/inst/tinytest/test_filterlist.R @@ -1,9 +1,6 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) #test_that("tiledb_filter_list default constructor", { diff --git a/inst/tinytest/test_fragmentinfo.R b/inst/tinytest/test_fragmentinfo.R index e17a7cd884..a24db2630f 100644 --- a/inst/tinytest/test_fragmentinfo.R +++ b/inst/tinytest/test_fragmentinfo.R @@ -1,14 +1,18 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") isMacOS <- (Sys.info()['sysname'] == "Darwin") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + uri <- tempfile() -if (dir.exists(uri)) unlink(uri, TRUE) ## create simple array set.seed(123) @@ -61,6 +65,8 @@ D2 <- data.frame(keys = 11:20, arr <- tiledb_array(uri, "WRITE") arr[] <- D2 +if (isRESTCI) exit_file("Skip consolidation during REST CI") + array_consolidate(uri) # written twice so consolidate rm(fraginf) diff --git a/inst/tinytest/test_group.R b/inst/tinytest/test_group.R index 9b7a71cd92..33c806348d 100644 --- a/inst/tinytest/test_group.R +++ b/inst/tinytest/test_group.R @@ -1,20 +1,25 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") isWindows <- Sys.info()[["sysname"]] == "Windows" isMacOS <- (Sys.info()['sysname'] == "Darwin") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (tiledb_version(TRUE) < "2.8.0") exit_file("TileDB Group requires TileDB 2.8.* or later") uri <- tempfile() chk <- tiledb_group_create(uri) expect_equal(chk, uri) # returns uri -expect_true(dir.exists(chk)) +if (!isRESTCI) expect_true(dir.exists(chk)) ## instantiate and check properties grp <- tiledb_group(uri) @@ -86,11 +91,13 @@ grp <- tiledb_group_close(grp) #expect_equal(tiledb_group_metadata_num(grp2), 2) #expect_false(tiledb_group_has_metadata(grp2, "otherkey")) +if (isRESTCI) exit_file("skip remainder") # TODO should this work? Getting 'unrecognised array' ## create some temp arrays to adds as groups uri1 <- file.path(uri, "anny") uri2 <- file.path(uri, "bob") uri3 <- file.path(uri, "chloe") uri4 <- file.path(uri, "dave") + df1 <- data.frame(val=seq(100, 200, by=10)) df2 <- data.frame(letters=letters) df3 <- data.frame(nine=rep(9L, 9)) @@ -100,7 +107,7 @@ tiledb::fromDataFrame(df2, uri2) tiledb::fromDataFrame(df3, uri3) tiledb::fromDataFrame(df4, uri4) -## add member +## add member (unless REST CI) grp <- tiledb_group_open(grp, "WRITE") grp <- tiledb_group_add_member(grp, uri1, FALSE) # use absolute URL grp <- tiledb_group_close(grp) diff --git a/inst/tinytest/test_libtiledb.R b/inst/tinytest/test_libtiledb.R index d5ab6c3476..93f66427a4 100644 --- a/inst/tinytest/test_libtiledb.R +++ b/inst/tinytest/test_libtiledb.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + #test_that("version is valid", { ver <- tiledb_version() expect_equal(length(ver), 3) @@ -33,13 +37,11 @@ expect_equal(unname(tiledb:::libtiledb_config_get(config, "don't exist")), NA_ch #}) #test_that("construct libtiledb_config with an empty vector of paramters", { -params = c() +params <- c() default_config <- tiledb:::libtiledb_config() params_config <- tiledb:::libtiledb_config(params) -expect_equal( - tiledb:::libtiledb_config_get(default_config, "sm.tile_cache_size"), - tiledb:::libtiledb_config_get(params_config, "sm.tile_cache_size") -) +expect_equal(tiledb:::libtiledb_config_get(default_config, "sm.tile_cache_size"), + tiledb:::libtiledb_config_get(params_config, "sm.tile_cache_size")) #}) #test_that("tiledb_config can be converted to an R vector", { @@ -92,7 +94,7 @@ dim <- tiledb:::libtiledb_dim(ctx, "d1", "FLOAT64", c(1.0, 100.0), 10.0) expect_true(is(dim, "externalptr")) #}) - +# n=161 #test_that("basic libtiledb_domain constructor works", { ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr @@ -120,6 +122,7 @@ attr <- tiledb:::libtiledb_attribute(ctx, "a1", "INT32", filter_list, 1, FALSE) expect_true(is(attr, "externalptr")) #}) +## n=164 #test_that("basic float64 libtiledb_attr constructor works", { ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr @@ -143,7 +146,7 @@ expect_true(is(sch, "externalptr")) #}) #test_that("basic dense vector libtiledb_array creation works", { -dir.create(tmp <- tempfile()) +tmp <- tempfile() ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr dim <- tiledb:::libtiledb_dim(ctx, "d1", "INT32", c(1L, 3L), 3L) @@ -152,14 +155,13 @@ filter <- tiledb:::libtiledb_filter(ctx, "NONE") filter_list <- tiledb:::libtiledb_filter_list(ctx, c(filter)) att <- tiledb:::libtiledb_attribute(ctx, "a1", "FLOAT64", filter_list, 1, FALSE) sch <- tiledb:::libtiledb_array_schema(ctx, dom, c(att), cell_order = "COL_MAJOR", tile_order = "COL_MAJOR", sparse = FALSE) -pth <- paste(tmp, "test_array", sep = "/") -uri <- tiledb:::libtiledb_array_create(pth, sch) -expect_true(dir.exists(pth)) +uri <- tiledb:::libtiledb_array_create(tmp, sch) +if (!isRESTCI) expect_true(dir.exists(tmp)) unlink(tmp, recursive = TRUE) #}) #test_that("basic dense vector writes / reads works", { -dir.create(tmp <- tempfile()) +tmp <- tempfile() ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr dim <- tiledb:::libtiledb_dim(ctx, "d1", "INT32", c(1L, 3L), 3L) @@ -168,8 +170,7 @@ filter <- tiledb:::libtiledb_filter(ctx, "NONE") filter_list <- tiledb:::libtiledb_filter_list(ctx, c(filter)) att <- tiledb:::libtiledb_attribute(ctx, "a1", "FLOAT64", filter_list, 1, FALSE) sch <- tiledb:::libtiledb_array_schema(ctx, dom, c(att), cell_order = "COL_MAJOR", tile_order = "COL_MAJOR", sparse = FALSE) -pth <- paste(tmp, "test_dense_read_write", sep = "/") -uri <- tiledb:::libtiledb_array_create(pth, sch) +uri <- tiledb:::libtiledb_array_create(tmp, sch) dat <- c(3, 2, 1) arr <- tiledb:::libtiledb_array_open(ctx, uri, "WRITE") @@ -190,7 +191,7 @@ unlink(tmp, recursive = TRUE) #}) #test_that("basic dense vector read subarray works", { -dir.create(tmp <- tempfile()) +tmp <- tempfile() ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr dim <- tiledb:::libtiledb_dim(ctx, "d1", "INT32", c(1L, 3L), 3L) @@ -199,8 +200,7 @@ filter <- tiledb:::libtiledb_filter(ctx, "NONE") filter_list <- tiledb:::libtiledb_filter_list(ctx, c(filter)) att <- tiledb:::libtiledb_attribute(ctx, "a1", "FLOAT64", filter_list, 1, FALSE) sch <- tiledb:::libtiledb_array_schema(ctx, dom, c(att), cell_order = "COL_MAJOR", tile_order = "COL_MAJOR", sparse = FALSE) -pth <- paste(tmp, "test_dense_read_write", sep = "/") -uri <- tiledb:::libtiledb_array_create(pth, sch) +uri <- tiledb:::libtiledb_array_create(tmp, sch) dat <- c(3, 2, 1) arr <- tiledb:::libtiledb_array_open(ctx, uri, "WRITE") @@ -222,6 +222,9 @@ expect_equal(res, dat[sub]) unlink(tmp, recursive = TRUE) #}) +if (isRESTCI) exit_file("skip VFS tests") + +## n=170 #test_that("basic tiledb vfs constructor works", { ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr @@ -234,25 +237,21 @@ expect_true(is(vfs, "externalptr")) #}) #test_that("basic vfs is_dir, is_file functionality works", { -dir.create(tmp <- tempfile()) +tmp <- tempfile() ##ctx <- tiledb:::libtiledb_ctx() ctx <- tiledb_get_context()@ptr vfs <- tiledb:::libtiledb_vfs(ctx) ## test dir -expect_true(tiledb:::libtiledb_vfs_is_dir(vfs, tmp)) +expect_false(tiledb:::libtiledb_vfs_is_dir(vfs, tmp)) expect_false(tiledb:::libtiledb_vfs_is_dir(vfs, "i don't exist")) -test_file_path <- paste("file:/", tmp, "test_file", sep = "/") -test_file <- file(test_file_path, "wb") +test_file <- file(tmp, "wb") writeChar(c("foo", "bar", "baz"), test_file) close(test_file) ## test file -if(.Platform$OS.type != "windows") { - expect_true(tiledb:::libtiledb_vfs_is_file(vfs, test_file_path)) -} -expect_false(tiledb:::libtiledb_vfs_is_file(vfs, tmp)) +expect_true(tiledb:::libtiledb_vfs_is_file(vfs, tmp)) unlink(tmp, recursive = TRUE) #}) diff --git a/inst/tinytest/test_matrix.R b/inst/tinytest/test_matrix.R index 3376e2d418..1a9b1ea9dd 100644 --- a/inst/tinytest/test_matrix.R +++ b/inst/tinytest/test_matrix.R @@ -2,11 +2,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + uri <- tempfile() M <- matrix(1:16, 4, 4, dimnames=list(LETTERS[1:4], letters[1:4])) fromMatrix(M, uri) diff --git a/inst/tinytest/test_metadata.R b/inst/tinytest/test_metadata.R index d127cc5720..6a4a51a0eb 100644 --- a/inst/tinytest/test_metadata.R +++ b/inst/tinytest/test_metadata.R @@ -1,16 +1,21 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + tmp <- tempfile() unlink_and_create_simple <- function(tmp) { - if (dir.exists(tmp)) unlink(tmp, recursive = TRUE, force = TRUE) - dir.create(tmp, recursive = TRUE) + if (missing(tmp)) tmp <- tempfile() + #if (dir.exists(tmp)) unlink(tmp, recursive = TRUE, force = TRUE) + #dir.create(tmp, recursive = TRUE) dim <- tiledb_dim("dim", domain = c(1L, 4L)) dom <- tiledb_domain(c(dim)) @@ -32,7 +37,8 @@ unlink_and_create_simple <- function(tmp) { arr } -unlink_and_create_ptr <- function(tmp) { +unlink_and_create_ptr <- function() { + tmp <- tempfile() arr <- unlink_and_create_simple(tmp) tiledb_array_close(arr) @@ -62,7 +68,7 @@ close_and_reopen <- function(arr, txt) { #test_that("Can check presence of metadata", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arr <- tiledb_array_open(arr, "READ") @@ -75,7 +81,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can retrieve count of metadata", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arr <- tiledb_array_open(arr, "READ") @@ -85,7 +91,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can get metadata", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arr <- tiledb_array_open(arr, "READ") @@ -97,7 +103,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can put metadata", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() if (tiledb:::libtiledb_array_is_open(arr@ptr)) tiledb_array_close(arr) arr <- tiledb_array_open(arr, "WRITE") @@ -111,7 +117,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can do round trip", { -arr <- unlink_and_create_simple(tmp) +arr <- unlink_and_create_simple() vec <- c(1.1, 2.2, 3.3) expect_true(tiledb_put_metadata(arr, "dvec", vec)) @@ -140,7 +146,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can get by index", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arr <- tiledb_array_open(arr, "READ") @@ -154,7 +160,7 @@ unlink(tmp, recursive = TRUE, force = TRUE) #}) #test_that("Can get all", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arr <- tiledb_array_open(arr, "READ") @@ -165,7 +171,7 @@ expect_true("txt" %in% names(res)) #}) #test_that("Can delete by key", { -arr <- unlink_and_create_ptr(tmp) +arr <- unlink_and_create_ptr() arrR <- tiledb_array_open(arr, "READ") diff --git a/inst/tinytest/test_misc.R b/inst/tinytest/test_misc.R index d8f3445b99..64abeeb688 100644 --- a/inst/tinytest/test_misc.R +++ b/inst/tinytest/test_misc.R @@ -2,9 +2,6 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) if (is.null(get0("tiledb_error_message"))) exit_file("No 'tiledb_error_message'") diff --git a/inst/tinytest/test_ordered.R b/inst/tinytest/test_ordered.R index 5a5724f3c4..ec8bfcd2c5 100644 --- a/inst/tinytest/test_ordered.R +++ b/inst/tinytest/test_ordered.R @@ -4,6 +4,13 @@ library(tiledb) ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (tiledb_version(TRUE) < "2.17.0") exit_file("Remainder needs 2.17.* or later") ## A data.frame with an ordered column, taken from package `earth` and its `etitanic` cleaned diff --git a/inst/tinytest/test_query.R b/inst/tinytest/test_query.R index de75163d92..2c765f6daf 100644 --- a/inst/tinytest/test_query.R +++ b/inst/tinytest/test_query.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + .createArray <- function(tmp) { dom <- tiledb_domain(dims = c(tiledb_dim("d1", c(1L,4L), 4L, "INT32"), tiledb_dim("d2", c(1L,4L), 4L, "INT32"))) @@ -16,7 +20,6 @@ tiledb_ctx(limitTileDBCores()) #test_that("tiledb_query constructor", { tmp <- tempfile() -dir.create(tmp) arr <- .createArray(tmp) query <- tiledb_query(arr) @@ -28,7 +31,6 @@ unlink(tmp, recursive=TRUE) #test_that("tiledb_query type", { tmp <- tempfile() -dir.create(tmp) arr <- .createArray(tmp) query <- tiledb_query(arr) @@ -44,7 +46,6 @@ unlink(tmp, recursive=TRUE) #test_that("tiledb_query layout", { tmp <- tempfile() -dir.create(tmp) arr <- .createArray(tmp) query <- tiledb_query(arr) @@ -57,7 +58,6 @@ unlink(tmp, recursive=TRUE) #test_that("tiledb_query basic query", { tmp <- tempfile() -dir.create(tmp) arr <- .createArray(tmp) qry <- tiledb_query(arr, "WRITE") @@ -92,7 +92,6 @@ if (requireNamespace("nanotime", quietly=TRUE)) { }) tmp <- tempfile() - dir.create(tmp) dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(0, 1e12), 1, type = "DATETIME_NS"))) schema <- tiledb_array_schema(dom, attrs = c(tiledb_attr("a1", type = "INT32"), @@ -150,7 +149,6 @@ if (requireNamespace("nanotime", quietly=TRUE)) { #test_that("tiledb_query subarray", { tmp <- tempfile() -dir.create(tmp) dom <- tiledb_domain(dims = tiledb_dim("rows", c(1L, 10L), 1L, type = "INT32")) schema <- tiledb_array_schema(dom, @@ -247,7 +245,7 @@ expect_true(nchar(res) > 1000) # safe lower boundary res <- tiledb_ctx_stats() # test here rather than in test_ctx to have real query expect_true(is.character(res)) -expect_true(nchar(res) > 1000) # safe lower boundary +if (!isRESTCI) expect_true(nchar(res) > 1000) # safe lower boundary (but not for REST) ctx <- tiledb_ctx(oldcfg) # reset config diff --git a/inst/tinytest/test_querycondition.R b/inst/tinytest/test_querycondition.R index 5cdfaff8ff..906892597a 100644 --- a/inst/tinytest/test_querycondition.R +++ b/inst/tinytest/test_querycondition.R @@ -1,17 +1,20 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) isWindows <- Sys.info()[["sysname"]] == "Windows" -if (isOldWindows) exit_file("skip this file on old Windows releases") - -#if (Sys.getenv("_RUNNING_UNDER_VALGRIND_", "FALSE") == "TRUE" && Sys.Date() < as.Date("2022-08-06")) exit_file("Skipping under valgrind until Aug 6") ## GitHub Actions had some jobs killed on the larger data portion so we dial mem use down if (Sys.getenv("CI") != "") set_allocation_size_preference(1024*1024*5) ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + ## simple data.frame to test against D <- data.frame(a=1:20, b=seq(101,120)+0.5) @@ -38,7 +41,6 @@ ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 1) expect_equal(ndf[1,"a"], 2L) tiledb_array_close(arr) -rm(qry) ## check a >= 2 qry <- tiledb_query(arr, "READ") @@ -56,7 +58,6 @@ n <- tiledb_query_result_buffer_elements(qry, "a") ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 19) tiledb_array_close(arr) -rm(qry) ## check a != 2 && a != 12 qry <- tiledb_query(arr, "READ") @@ -76,7 +77,6 @@ n <- tiledb_query_result_buffer_elements(qry, "a") ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 18) tiledb_array_close(arr) -rm(qry) ## check a >=5 && b <= 115 qry <- tiledb_query(arr, "READ") @@ -96,7 +96,6 @@ n <- tiledb_query_result_buffer_elements(qry, "a") ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 10) tiledb_array_close(arr) -rm(qry) ## check b == 115.5 (yes, yes, yes, we know EQ is dicey on floats; can remove this if it croaks) qry <- tiledb_query(arr, "READ") @@ -114,7 +113,6 @@ n <- tiledb_query_result_buffer_elements(qry, "a") ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 1) tiledb_array_close(arr) -rm(qry) ## check b >= 115.4 && b <= 115.6 qry <- tiledb_query(arr, "READ") @@ -134,8 +132,6 @@ n <- tiledb_query_result_buffer_elements(qry, "a") ndf <- data.frame(rows=rows,a=cola,b=colb)[1:n,] expect_equal(nrow(ndf), 1) tiledb_array_close(arr) -rm(qry) - ## tiledb_array support if (!requireNamespace("palmerpenguins", quietly=TRUE)) exit_file("remainder needs 'palmerpenguins'") @@ -339,7 +335,7 @@ expect_equal(NROW(arr[]), sum(with(penguins, year < 2010))) ## query conditions over different types suppressMessages(library(bit64)) n <- 20L -dir.create(tmp <- tempfile()) +tmp <- tempfile() dim <- tiledb_dim("rows", domain=c(1L,n), type="INT32", tile=1L) dom <- tiledb_domain(dim) sch <- tiledb_array_schema(dom, diff --git a/inst/tinytest/test_shmem.R b/inst/tinytest/test_shmem.R index aecc47f2ab..29f7745191 100644 --- a/inst/tinytest/test_shmem.R +++ b/inst/tinytest/test_shmem.R @@ -6,6 +6,9 @@ if (Sys.info()['sysname'] == "Darwin") exit_file("Skip on macOS") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) exit_file("skip for REST CI") + uri <- tempfile() fromDataFrame(mtcars, uri) # create an array arr <- tiledb_array(uri, return_as="data.frame") diff --git a/inst/tinytest/test_sparsematrix.R b/inst/tinytest/test_sparsematrix.R index bde420be31..a06bebb1b3 100644 --- a/inst/tinytest/test_sparsematrix.R +++ b/inst/tinytest/test_sparsematrix.R @@ -1,11 +1,15 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} + if (!requireNamespace("Matrix", quietly=TRUE)) exit_file("Need the 'Matrix' package") library(Matrix) if (packageVersion("Matrix") < "1.3.0") exit_file("Old 'Matrix' package?") @@ -45,5 +49,8 @@ chk <- toSparseMatrix(uri) expect_true(is(chk, "sparseMatrix")) expect_true(inherits(chk, "dgTMatrix")) expect_equivalent(spmat, chk) -expect_equal(rownames(spmat), rownames(chk)) -expect_equal(colnames(spmat), colnames(chk)) +if (!isRESTCI) { + ## Under REST CI we drop row and column names. Is that expected? + expect_equal(rownames(spmat), rownames(chk)) + expect_equal(colnames(spmat), colnames(chk)) +} diff --git a/inst/tinytest/test_tiledbarray_extra.R b/inst/tinytest/test_tiledbarray_extra.R index 01c1121442..9e371de7df 100644 --- a/inst/tinytest/test_tiledbarray_extra.R +++ b/inst/tinytest/test_tiledbarray_extra.R @@ -1,8 +1,6 @@ library(tinytest) library(tiledb) exit_file("Skip for now") -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") isMacOS <- (Sys.info()['sysname'] == "Darwin") if (tiledb_version(TRUE) < "2.7.0") exit_file("Needs TileDB 2.7.* or later") diff --git a/inst/tinytest/test_timetravel.R b/inst/tinytest/test_timetravel.R index bf977d4f79..391b7d4201 100644 --- a/inst/tinytest/test_timetravel.R +++ b/inst/tinytest/test_timetravel.R @@ -1,12 +1,16 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") isMacOS <- (Sys.info()['sysname'] == "Darwin") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) { + ## we can rely on the normal tempfile semantics but override the tmpdir + ## argument to be our REST CI base url in the unit test namespace + tempfile <- function() { base::tempfile(tmpdir="tiledb://unit") } +} ## tests formerly in test_tiledbarray.R @@ -110,19 +114,20 @@ expect_equal(max(res5$grp), 3) ## timestamp_start and timestamp_end - -## time-travel vaccum test -vfs <- tiledb_vfs() -uridir <- if (tiledb_vfs_is_dir(file.path(uri, "__fragments"))) file.path(uri, "__fragments") else uri -ndirfull <- tiledb_vfs_ls(uridir, vfs=vfs) -array_consolidate(uri, start_time=times[2]-epst, end_time=times[3]+epst) -array_vacuum(uri, start_time=times[2]-epst, end_time=times[3]+epst) -ndircons <- tiledb_vfs_ls(uridir, vfs=vfs) -expect_true(length(ndircons) < length(ndirfull)) -array_consolidate(uri, start_time=times[1]-0.5, end_time=times[3]) -array_vacuum(uri, start_time=times[1]-0.5, end_time=times[3]) -ndircons2 <- tiledb_vfs_ls(uridir, vfs=vfs) -expect_true(length(ndircons2) < length(ndircons)) +if (!isRESTCI) { + ## time-travel vaccum test + vfs <- tiledb_vfs() + uridir <- if (tiledb_vfs_is_dir(file.path(uri, "__fragments"))) file.path(uri, "__fragments") else uri + ndirfull <- tiledb_vfs_ls(uridir, vfs=vfs) + array_consolidate(uri, start_time=times[2]-epst, end_time=times[3]+epst) + array_vacuum(uri, start_time=times[2]-epst, end_time=times[3]+epst) + ndircons <- tiledb_vfs_ls(uridir, vfs=vfs) + expect_true(length(ndircons) < length(ndirfull)) + array_consolidate(uri, start_time=times[1]-0.5, end_time=times[3]) + array_vacuum(uri, start_time=times[1]-0.5, end_time=times[3]) + ndircons2 <- tiledb_vfs_ls(uridir, vfs=vfs) + expect_true(length(ndircons2) < length(ndircons)) +} ## time-travel via policy object if (tiledb_version(TRUE) < "2.15.0") exit_file("Needs TileDB 2.15.* or later") diff --git a/inst/tinytest/test_timetravel_extra.R b/inst/tinytest/test_timetravel_extra.R index da1c10ad4c..f6033cd19a 100644 --- a/inst/tinytest/test_timetravel_extra.R +++ b/inst/tinytest/test_timetravel_extra.R @@ -2,17 +2,17 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") isMacOS <- (Sys.info()['sysname'] == "Darwin") ctx <- tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) exit_file("skip VFS tests under REST CI") + ## earlier time travel test recast via timestamp_{start,end} ## time travel tmp <- tempfile() -dir.create(tmp) dom <- tiledb_domain(dims = c(tiledb_dim("rows", c(1L, 10L), 5L, "INT32"), tiledb_dim("cols", c(1L, 10L), 5L, "INT32"))) schema <- tiledb_array_schema(dom, attrs=c(tiledb_attr("a", type = "INT32")), sparse = TRUE) diff --git a/inst/tinytest/test_vfs.R b/inst/tinytest/test_vfs.R index a201c6cc31..4ce7f688f5 100644 --- a/inst/tinytest/test_vfs.R +++ b/inst/tinytest/test_vfs.R @@ -1,11 +1,11 @@ library(tinytest) library(tiledb) -isOldWindows <- Sys.info()[["sysname"]] == "Windows" && grepl('Windows Server 2008', osVersion) -if (isOldWindows) exit_file("skip this file on old Windows releases") - tiledb_ctx(limitTileDBCores()) +isRESTCI <- Sys.getenv("TILEDB_CLOUD_REST_BIN", "") != "" +if (isRESTCI) exit_file("skip VFS tests under REST CI") + #test_that("tiledb_vfs default constructor", { vfs <- tiledb_vfs() expect_true(is(vfs, "tiledb_vfs"))