Update stopifnot() assertions

R/Array.R

@@ -1,6 +1,6 @@
 #  MIT License
 #
-#  Copyright (c) 2017-2020 TileDB Inc.
+#  Copyright (c) 2017-2021 TileDB Inc.
 #
 #  Permission is hereby granted, free of charge, to any person obtaining a copy
 #  of this software and associated documentation files (the "Software"), to deal
@@ -39,16 +39,13 @@
 #'
 #' @export
 tiledb_array_create <- function(uri, schema, encryption_key) {
-  if (missing(uri) || !is.scalar(uri, "character")) {
-    stop("argument uri must be a string scalar")
-  } else if (missing(schema) || !is(schema, "tiledb_array_schema")) {
-    stop("argument schema must a tiledb_array_schema")
-  }
-  if (missing(encryption_key)) {
-    return(libtiledb_array_create(uri, schema@ptr))
-  } else {
-    return(libtiledb_array_create_with_key(uri, schema@ptr, encryption_key))
-  }
+    stopifnot(`The 'uri' argument must be a string scalar` = !missing(uri) && is.scalar(uri, "character"),
+              `The 'schema' argument must a tiledb_array_schema object` = !missing(schema) && is(schema, "tiledb_array_schema"))
+    if (missing(encryption_key)) {
+        return(libtiledb_array_create(uri, schema@ptr))
+    } else {
+        return(libtiledb_array_create_with_key(uri, schema@ptr, encryption_key))
+    }
 }
 
 ##' Open a TileDB Array
@@ -59,6 +56,7 @@ tiledb_array_create <- function(uri, schema, encryption_key) {
 ##' @importFrom methods .hasSlot
 ##' @export
 tiledb_array_open <- function(arr, type=c("READ","WRITE")) {
+  stopifnot(`The 'arr' argument must be a tiledb_array object` = is(arr, "tiledb_array") || is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"))
   type <- match.arg(type)
 
   if (.hasSlot(arr, "encryption_key") && length(arr@encryption_key) > 0) {
@@ -78,7 +76,8 @@ tiledb_array_open <- function(arr, type=c("READ","WRITE")) {
 ##' @return The TileDB Array object but opened for reading or writing
 ##' @export
 tiledb_array_open_at <- function(arr, type=c("READ","WRITE"), timestamp) {
-  stopifnot(timestamp_argument=inherits(timestamp, "POSIXct"))
+  stopifnot(`The 'arr' argument must be a tiledb_array object` = is(arr, "tiledb_array") || is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"),
+            `The 'timestamp' argument must a time object` = inherits(timestamp, "POSIXct"))
   type <- match.arg(type)
   ctx <- tiledb_get_context()
   if (.hasSlot(arr, "encryption_key") && length(arr@encryption_key) > 0) {
@@ -96,6 +95,7 @@ tiledb_array_open_at <- function(arr, type=c("READ","WRITE"), timestamp) {
 ##' @return The TileDB Array object but closed
 ##' @export
 tiledb_array_close <- function(arr) {
+  stopifnot(`The 'arr' argument must be a tiledb_array object` = is(arr, "tiledb_array") || is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"))
   libtiledb_array_close(arr@ptr)
   arr
 }
@@ -106,6 +106,7 @@ tiledb_array_close <- function(arr) {
 ##' @return A boolean indicating if the array has homogeneous domains
 ##' @export
 tiledb_array_is_homogeneous <- function(arr) {
+  stopifnot(`The argument 'arr' must be a tiledb_array object` = is(arr, "tiledb_array") || is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"))
   ## there is a non-exported call at the C level we could use instead
   sch <- schema(arr)
   dom <- domain(sch)
@@ -121,6 +122,7 @@ tiledb_array_is_homogeneous <- function(arr) {
 ##' @return A boolean indicating if the array has heterogenous domains
 ##' @export
 tiledb_array_is_heterogeneous <- function(arr) {
+  stopifnot(`The 'arr' argument must be a tiledb_array object` = is(arr, "tiledb_array") || is(arr, "tiledb_sparse") || is(arr, "tiledb_dense"))
   ## there is a non-exported call at the C level we could use instead
   sch <- schema(arr)
   dom <- domain(sch)

R/ArraySchema.R

@@ -28,9 +28,7 @@ setClass("tiledb_array_schema",
          slots = list(ptr = "externalptr"))
 
 tiledb_array_schema.from_ptr <- function(ptr) {
-  if (missing(ptr) || typeof(ptr) != "externalptr" || is.null(ptr)) {
-    stop("ptr argument must be a non NULL externalptr to a tiledb_array_schema instance")
-  }
+  stopifnot(`The 'ptr' argument must be a non NULL externalptr to a tiledb_array_schema instance` = !missing(ptr) && is(ptr, "externalptr") && !is.null(ptr) )
   new("tiledb_array_schema", ptr = ptr)
 }
 
@@ -122,11 +120,8 @@ tiledb_array_schema <- function(domain,
 }
 
 tiledb_array_schema.from_array <- function(x, ctx = tiledb_get_context()) {
-  if (!is(ctx, "tiledb_ctx")) {
-    stop("ctx argument must be a tiledb_ctx")
-  } else if (missing(x) || !is.array(x)) {
-    stop("x argument must be a valid array object")
-  }
+  stopifnot(`The 'ctx' argument must be a tiledb_ctx object` = is(ctx, "tiledb_ctx"),
+            `The 'x' argument must be a valid array object` = !missing(x) && is.array(x))
   xdim <- dim(x)
   dims <- lapply(seq_len(xdim), function(i) {
     tiledb_dim(c(1L, xdim[i]), type = "INT32", ctx)
@@ -339,6 +334,8 @@ setMethod("filter_list", "tiledb_array_schema", function(object) {
 #' @return The modified Array Schema object
 #' @export
 tiledb_array_schema_set_coords_filter_list <- function(sch, fl) {
+  stopifnot(`The 'sch' argument must be a tiledb_array_schema object` = is(sch, "tiledb_array_schema"),
+            `The 'fl' argument must be a tiledb_filter_list object` = is(fl, "tiledb_filter_list"))
   sch@ptr <- libtiledb_array_schema_set_coords_filter_list(sch@ptr, fl@ptr)
   sch
 }
@@ -350,6 +347,8 @@ tiledb_array_schema_set_coords_filter_list <- function(sch, fl) {
 #' @return The modified Array Schema object
 #' @export
 tiledb_array_schema_set_offsets_filter_list <- function(sch, fl) {
+  stopifnot(`The 'sch' argument must be a tiledb_array_schema object` = is(sch, "tiledb_array_schema"),
+            `The 'fl' argument must be a tiledb_filter_list object` = is(fl, "tiledb_filter_list"))
   sch@ptr <- libtiledb_array_schema_set_offsets_filter_list(sch@ptr, fl@ptr)
   sch
 }
@@ -434,6 +433,7 @@ setMethod("allows_dups", signature = "tiledb_array_schema", function(x) {
 #' @return the logical value
 #' @export
 tiledb_array_schema_get_allows_dups <- function(x) {
+  stopifnot(`The 'x' argument must be a tiledb_array_schema object` = is(x, "tiledb_array_schema"))
   libtiledb_array_schema_get_allows_dups(x@ptr)
 }
 
@@ -456,6 +456,8 @@ setMethod("allows_dups<-", signature = "tiledb_array_schema", function(x, value)
 #' @return the tiledb_array_schema object
 #' @export
 tiledb_array_schema_set_allows_dups <- function(x, value) {
+  stopifnot(`The 'x' argument must be a tiledb_array_schema object` = is(x, "tiledb_array_schema"),
+            `The 'value' argument must be a boolean` = is.logical(value))
   libtiledb_array_schema_set_allows_dups(x@ptr, value)
 }
 
@@ -465,7 +467,7 @@ tiledb_array_schema_set_allows_dups <- function(x, value) {
 ##' @return A character vector of dimension and attribute names
 ##' @export
 tiledb_schema_get_names <- function(sch) {
-  stopifnot(`Argument must be a schema` = is(sch, "tiledb_array_schema"))
+  stopifnot(`The 'sch' argument must be a schema` = is(sch, "tiledb_array_schema"))
   dom <- tiledb::domain(sch)
   dims <- tiledb::dimensions(dom)
   ndims <- length(dims)
@@ -483,7 +485,7 @@ tiledb_schema_get_names <- function(sch) {
 ##' @return A character vector of dimension and attribute data types
 ##' @export
 tiledb_schema_get_types <- function(sch) {
-  stopifnot(`Argument must be a schema` = is(sch, "tiledb_array_schema"))
+  stopifnot(`The 'sch' argument must be a schema` = is(sch, "tiledb_array_schema"))
   dom <- tiledb::domain(sch)
   dims <- tiledb::dimensions(dom)
   ndims <- length(dims)
@@ -503,7 +505,7 @@ tiledb_schema_get_types <- function(sch) {
 ##' @return An integer vector where each element corresponds to a schema entry,
 ##' and a value of one signals dimension and a value of two an attribute.
 tiledb_schema_get_dim_attr_status <- function(sch) {
-  stopifnot(`Argument must be a schema` = is(sch, "tiledb_array_schema"))
+  stopifnot(`The 'sch' argument must be a schema` = is(sch, "tiledb_array_schema"))
   dom <- tiledb::domain(sch)
   dims <- tiledb::dimensions(dom)
   attrs <- tiledb::attrs(sch)
@@ -541,6 +543,7 @@ setReplaceMethod("capacity", signature = "tiledb_array_schema", function(x, valu
 #' @return The tile capacity value
 #' @export
 tiledb_array_schema_get_capacity <- function(object) {
+  stopifnot(`The argument must be a tiledb_array_schema object` = is(object, "tiledb_array_schema"))
   libtiledb_array_schema_get_capacity(object@ptr)
 }
 
@@ -552,6 +555,8 @@ tiledb_array_schema_get_capacity <- function(object) {
 #' @return The modified \code{array_schema} object
 #' @export
 tiledb_array_schema_set_capacity <- function(x, value) {
+  stopifnot(`The first argument must be a tiledb_array_schema object` = is(x, "tiledb_array_schema"),
+            `The second argumebt must a int or numeric value` = is.numeric(value))
   libtiledb_array_schema_set_capacity(x@ptr, value)
   x
 }
@@ -579,6 +584,7 @@ setMethod("check", signature = "tiledb_array_schema", function(object) {
 #' schema; for an incorrect schema an error condition is triggered.
 #' @export
 tiledb_array_schema_check <- function(object) {
+  stopifnot(`The argument must be a tiledb_array_schema object` = is(object, "tiledb_array_schema"))
   libtiledb_array_schema_check(object@ptr)
 }
 
@@ -592,7 +598,7 @@ tiledb_array_schema_check <- function(object) {
 #' @return A boolean value indicating if the attribute exists in the schema
 #' @export
 has_attribute <- function(schema, attr) {
-  stopifnot(schema_argument=is(schema, "tiledb_array_schema"),
-            attr_argument=is.character(attr))
+  stopifnot(`The 'schema' argument must be an array schema` = is(schema, "tiledb_array_schema"),
+            `The 'attr' argument must be a character` = is.character(attr))
   libtiledb_array_schema_has_attribute(schema@ptr, attr)
 }

R/ArrowIO.R

@@ -31,8 +31,8 @@
 ##' pointers to the Arrow array and schema
 ##' @export
 tiledb_query_export_buffer <- function(query, name, ctx = tiledb_get_context()) {
-    stopifnot(`query argument`=is(query, "tiledb_query"),
-              `name argument`=is.character(name))
+    stopifnot(`The 'query' argument must be a tiledb query` = is(query, "tiledb_query"),
+              `The 'name' argument must be character` = is.character(name))
     res <- libtiledb_query_export_buffer(ctx@ptr, query@ptr, name)
     res
 }
@@ -49,10 +49,9 @@ tiledb_query_export_buffer <- function(query, name, ctx = tiledb_get_context())
 ##' @return The update Query external pointer is returned
 ##' @export
 tiledb_query_import_buffer <- function(query, name, arrowpointers, ctx = tiledb_get_context()) {
-    stopifnot(`query argument` = is(query, "tiledb_query"),
-              `name argument` = is.character(name),
-              `arrow pointers` = is.numeric(arrowpointers),
-              `length of arrow pointers vectors` = length(arrowpointers)==2)
+    stopifnot(`The 'query' argument must be a tiledb query` = is(query, "tiledb_query"),
+              `The 'name' argument must be character` = is.character(name),
+              `The 'arrowpointers' argument must be length-2 vector` = is.numeric(arrowpointers) && is.vector(arrowpointers) && length(arrowpointers)==2)
     query@ptr <- libtiledb_query_import_buffer(ctx@ptr, query@ptr, name, arrowpointers)
     query
 }

R/Attribute.R

@@ -28,9 +28,8 @@ setClass("tiledb_attr",
          slots = list(ptr = "externalptr"))
 
 tiledb_attr.from_ptr <- function(ptr) {
-   if (typeof(ptr) != "externalptr" || is.null(ptr)) {
-    stop("ptr argument must be a non NULL externalptr to a tiledb::Attribute instance")
-  }
+  stopifnot(`The 'ptr' argument must be a non-NULL external pointer to an Attribute instance` =
+                !missing(ptr) && is(ptr, "externalptr") && !is.null(ptr))
   new("tiledb_attr", ptr = ptr)
 }
 
@@ -61,19 +60,11 @@ tiledb_attr <- function(name,
                         nullable = FALSE,
                         ctx = tiledb_get_context()
                         ) {
-    if (missing(name)) {
-        name <- ""
-    }
-    if (missing(type)) {
-        stop("The 'type' argument for tiledb_attr() is mandatory")
-    }
-    if (!is(ctx, "tiledb_ctx")) {
-        stop("ctx argument must be a tiledb_ctx")
-    } else if (!is.scalar(name, "character")) {
-        stop("name argument must be a scalar string")
-    } else if(!is(filter_list, "tiledb_filter_list")) {
-        stop("filter_list argument must be a tiledb_filter_list instance")
-    }
+    if (missing(name)) name <- ""
+    stopifnot(`The 'type' argument for is mandatory` = !missing(type),
+              `The 'ctx' argument must be a tiledb_ctx` = is(ctx, "tiledb_ctx"),
+              `The 'name' argument must be a scalar string` = is.scalar(name, "character"),
+              `The 'filter_list' argument must be a tiledb_filter_list instance` = is(filter_list, "tiledb_filter_list"))
     ptr <- libtiledb_attribute(ctx@ptr, name, type, filter_list@ptr, ncells, nullable)
     new("tiledb_attr", ptr = ptr)
 }
@@ -251,8 +242,8 @@ tiledb_attribute_get_fill_value <- function(attr) {
 #' @return \code{NULL} is returned invisibly
 #' @export
 tiledb_attribute_set_fill_value <- function(attr, value) {
-  stopifnot(attr_object=is(attr, "tiledb_attr"),
-            value_type=is.integer(value) || is.numeric(value) || is.character(value))
+  stopifnot(`The first argument must be an attribute` = is(attr, "tiledb_attr"),
+            `The second argument must be int, numeric or char` = is.integer(value) || is.numeric(value) || is.character(value))
   libtiledb_attribute_set_fill_value(attr@ptr, value)
   invisible()
 }
@@ -263,7 +254,7 @@ tiledb_attribute_set_fill_value <- function(attr, value) {
 #' @return A boolean value indicating variable-size or not
 #' @export
 tiledb_attribute_is_variable_sized <- function(attr) {
-  stopifnot(attr_object=is(attr, "tiledb_attr"))
+  stopifnot(`The argument must be an attribute` = is(attr, "tiledb_attr"))
   libtiledb_attribute_is_variable_sized(attr@ptr)
 }
 
@@ -273,7 +264,7 @@ tiledb_attribute_is_variable_sized <- function(attr) {
 #' @return A numeric value with the cell size
 #' @export
 tiledb_attribute_get_cell_size <- function(attr) {
-  stopifnot(attr_object=is(attr, "tiledb_attr"))
+  stopifnot(`The argument must be an attribute` = is(attr, "tiledb_attr"))
   libtiledb_attribute_get_cell_size(attr@ptr)
 }
 
@@ -284,9 +275,9 @@ tiledb_attribute_get_cell_size <- function(attr) {
 #' @return Nothing is returned
 #' @export
 tiledb_attribute_set_nullable <- function(attr, flag) {
-    stopifnot(attr_object=is(attr, "tiledb_attr"),
-              flag_boolean_not_na=is.logical(flag) & !is.na(flag))
-    libtiledb_attribute_set_nullable(attr@ptr, flag)
+  stopifnot(`The first argument must be an attribute` = is(attr, "tiledb_attr"),
+            `The second argument must be a logical` = is.logical(flag) && !is.na(flag))
+  libtiledb_attribute_set_nullable(attr@ptr, flag)
 }
 
 #' Get the TileDB Attribute Nullable flag value
@@ -295,6 +286,6 @@ tiledb_attribute_set_nullable <- function(attr, flag) {
 #' @return A boolean value with the \sQuote{Nullable} status
 #' @export
 tiledb_attribute_get_nullable <- function(attr) {
-    stopifnot(attr_object=is(attr, "tiledb_attr"))
+    stopifnot(`The argument must be an attribute` = is(attr, "tiledb_attr"))
     libtiledb_attribute_get_nullable(attr@ptr)
 }