Adjust tests for enumerations

R/DataFrame.R

@@ -98,10 +98,12 @@ fromDataFrame <- function(obj, uri, col_index=NULL, sparse=TRUE, allows_dups=spa
 
     ## turn factor columns in char columns
     ## TODO: add an option
-    #factcols <- grep("factor", sapply(obj, class))
-    #if (length(factcols) > 0) {
-    #    for (i in factcols) obj[,i] <- as.character(obj[,i])
-    #}
+    if (tiledb_version(TRUE) < "2.17.0") {
+        factcols <- grep("factor", sapply(obj, class))
+        if (length(factcols) > 0) {
+            for (i in factcols) obj[,i] <- as.character(obj[,i])
+        }
+    }
 
     ## Create default filter_list from filter vector, 'NONE' and 'ZSTD' is default
     default_filter_list <- tiledb_filter_list(sapply(filter, tiledb_filter))

R/QueryCondition.R

@@ -60,7 +60,7 @@ tiledb_query_condition <- function(ctx = tiledb_get_context()) {
 #' @return The initialized 'tiledb_query_condition' object
 #' @export
 tiledb_query_condition_init <- function(attr, value, dtype, op, qc = tiledb_query_condition()) {
-    stopifnot("Argument 'qc' with query condition object required" = is(qc, "tiledb_query_condition"),
+    stopifnot("Argument 'qc' with query condition object required" = inherits(qc, "tiledb_query_condition"),
               "Argument 'attr' must be character" = is.character(attr),
               "Argument 'value' must be of length one" = (is.vector(value) ||
                                                           bit64::is.integer64(value) ||
@@ -164,8 +164,8 @@ parse_query_condition <- function(expr, ta=NULL, debug=FALSE, strict=TRUE, use_i
             if (debug) cat("-- [", as.character(x[2]), "]",
                            " ", as.character(x[1]),
                            " [", as.character(x[3]), "]\n", sep="")
-            .makeExpr(x[[2]])
-            .makeExpr(x[[3]])
+            .makeExpr(x[[2]], debug=debug)
+            .makeExpr(x[[3]], debug=debug)
             tiledb_query_condition_combine(.makeExpr(x[[2]]),
                                            .makeExpr(x[[3]]),
                                            .mapBoolToCharacter(as.character(x[1])))

inst/tinytest/test_query.R

@@ -229,6 +229,7 @@ expect_equal(nv[3], n)                  # third is length of validity buffer (if
 
 #})
 
+## n=31
 ## check for warning in insufficient memory
 oldcfg <- tiledb_config()
 cfg <- tiledb_config()
@@ -250,23 +251,22 @@ expect_true(nchar(res) > 1000)  		# safe lower boundary
 
 ctx <- tiledb_ctx(oldcfg)               # reset config
 
-
+## n==35
 ## check deletes
 if (tiledb_version(TRUE) < "2.12.0") exit_file("TileDB deletes requires TileDB 2.12.* or greater")
 if (!requireNamespace("palmerpenguins", quietly=TRUE)) exit_file("remainder needs 'palmerpenguins'")
 uri <- tempfile()
 pp <- palmerpenguins::penguins
 fromDataFrame(pp, uri, sparse = TRUE, col_index = c("species", "year"))
 
-qc <- parse_query_condition(body_mass_g > 4000 || island == "Biscoe" || sex == "male")
 arr <- tiledb_array(uri)
+qc <- parse_query_condition(body_mass_g > 4000 || island == "Biscoe" || sex == "male", ta = arr)
 qry <- tiledb_query(arr, "DELETE")
 qry <- tiledb_query_set_condition(qry, qc)
 tiledb_query_submit(qry)
 tiledb_query_finalize(qry)
 
 oo <- tiledb_array(uri, return_as="data.frame", strings_as_factors=TRUE)[]
-
 expect_equal(nrow(oo), 84)             # instead of 344 pre-deletion
 
 

inst/tinytest/test_tiledbarray.R

@@ -988,7 +988,7 @@ expect_equal(tiledb_array_get_non_empty_domain_from_name(arr, "d2"), c("a", "c")
 ## access schema from uri
 schema2 <- tiledb::schema(tmp)
 expect_true(is(schema2, "tiledb_array_schema"))
-expect_equal(schema, schema2)
+expect_equal(schema@ptr, schema2@ptr) # schema2 has two slots as we now return array pointer too
 
 ## access schema from array
 schema3 <- tiledb::schema(arr)