diff --git a/NAMESPACE b/NAMESPACE index aa5b73c0..87b72c0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -142,6 +142,7 @@ export(H5Sselect_none) export(H5Sselect_valid) export(H5Sset_extent_simple) export(H5Sunlimited) +export(H5Tclose) export(H5Tcopy) export(H5Tenum_create) export(H5Tenum_insert) diff --git a/R/H5.R b/R/H5.R index 3a8dd52d..5eafc257 100644 --- a/R/H5.R +++ b/R/H5.R @@ -105,6 +105,7 @@ h5closeAll <- function(...) { H5I_GENPROP_LST = H5Pclose, H5I_DATASPACE = H5Sclose, H5I_ATTR = H5Aclose, + H5I_DATATYPE = H5Tclose, stop( "Error in h5closeAll(). Appropriate close function not found", call. = FALSE diff --git a/R/H5P.R b/R/H5P.R index 22270ef8..550045cf 100644 --- a/R/H5P.R +++ b/R/H5P.R @@ -555,6 +555,7 @@ H5Pset_fill_value <- function(h5plist, value) { logical = h5constants$H5T["H5T_STD_I8LE"], character = { tid <- H5Tcopy("H5T_C_S1") + on.exit(H5Tclose(tid)) size <- nchar(value, type = "bytes") H5Tset_size(tid, size) H5Tset_strpad(tid, strpad = "NULLPAD") @@ -575,6 +576,7 @@ H5Pset_fill_value <- function(h5plist, value) { } ) res <- .Call("_H5Pset_fill_value", h5plist@ID, tid, value, PACKAGE = "rhdf5") + invisible(res) } diff --git a/R/H5T.R b/R/H5T.R index 69122836..9ebefd23 100644 --- a/R/H5T.R +++ b/R/H5T.R @@ -33,6 +33,22 @@ H5Tcopy <- function(dtype_id = h5default(type = "H5T")) { invisible(.Call("_H5Tcopy", dtype_id, PACKAGE = "rhdf5")) } +#' Close an open HDF5 datatype +#' +#' @param dtype_id ID of the datatype to close. This should be a datatype +#' created with functions like `H5Tcopy()`, `H5Tcreate()`, or `H5Tenum_create()`. +#' +#' @examples +#' tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR") +#' H5Tenum_insert(tid, name = "TRUE", value = 1L) +#' H5Tenum_insert(tid, name = "FALSE", value = 0L) +#' H5Tclose(tid) +#' +#' @export +H5Tclose <- function(dtype_id) { + invisible(.Call("_H5Tclose", dtype_id, PACKAGE = "rhdf5")) +} + #' Retrieve or set the type of padding used by string datatype #' #' @param dtype_id ID of HDF5 datatype to query or modify. diff --git a/R/h5create.R b/R/h5create.R index a522316b..a32011f7 100644 --- a/R/h5create.R +++ b/R/h5create.R @@ -505,6 +505,10 @@ h5createDataset <- function( size, encoding = match.arg(encoding, choices = c("ASCII", "UTF-8", "UTF8")) ) + if (storage.mode[1] %in% c("character", "complex")) { + # opened in .setDataType + on.exit(H5Tclose(tid), add = TRUE) + } dcpl <- .createDCPL( chunk, @@ -638,6 +642,7 @@ h5createAttribute <- function( integer = h5constants$H5T["H5T_STD_I32LE"], character = { tid <- H5Tcopy("H5T_C_S1") + on.exit(H5Tclose(tid), add = TRUE) H5Tset_cset( tid, cset = match.arg(encoding, choices = c("ASCII", "UTF-8", "UTF8")) @@ -652,6 +657,7 @@ h5createAttribute <- function( }, logical = { tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR") + on.exit(H5Tclose(tid), add = TRUE) H5Tenum_insert(tid, name = "TRUE", value = 1L) H5Tenum_insert(tid, name = "FALSE", value = 0L) H5Tenum_insert(tid, name = "NA", value = 255L) diff --git a/R/h5writeAttr.R b/R/h5writeAttr.R index e9e2f456..4b278067 100644 --- a/R/h5writeAttr.R +++ b/R/h5writeAttr.R @@ -122,6 +122,7 @@ h5writeAttribute.array <- function( any_na <- checkForNA && anyNA(attr) tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR") + on.exit(H5Tclose(tid), add = TRUE) H5Tenum_insert(tid, name = "TRUE", value = 1L) H5Tenum_insert(tid, name = "FALSE", value = 0L) if (any_na) { @@ -138,6 +139,7 @@ h5writeAttribute.array <- function( H5type = tid, encoding = match.arg(encoding, choices = c("ASCII", "UTF-8", "UTF8")) ) + h5attr <- H5Aopen(h5obj, name) DimMem <- dim(attr) diff --git a/man/H5Tclose.Rd b/man/H5Tclose.Rd new file mode 100644 index 00000000..52f82a2f --- /dev/null +++ b/man/H5Tclose.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/H5T.R +\name{H5Tclose} +\alias{H5Tclose} +\title{Close an open HDF5 datatype} +\usage{ +H5Tclose(dtype_id) +} +\arguments{ +\item{dtype_id}{ID of the datatype to close. This should be a datatype +created with functions like \code{H5Tcopy()}, \code{H5Tcreate()}, or \code{H5Tenum_create()}.} +} +\description{ +Close an open HDF5 datatype +} +\examples{ +tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR") +H5Tenum_insert(tid, name = "TRUE", value = 1L) +H5Tenum_insert(tid, name = "FALSE", value = 0L) +H5Tclose(tid) + +} diff --git a/src/H5T.c b/src/H5T.c index e01c9890..e2e29d06 100644 --- a/src/H5T.c +++ b/src/H5T.c @@ -6,6 +6,7 @@ SEXP _H5Tcreate( SEXP _type, SEXP _size ) { size_t size = (size_t ) INTEGER(_size)[0]; hid_t tid = H5Tcreate(type, size); + addHandle(tid); SEXP Rval; PROTECT(Rval = HID_2_STRSXP(tid)); @@ -18,6 +19,7 @@ SEXP _H5Tcopy( SEXP _dtype_id ) { hid_t dtype_id = STRSXP_2_HID( _dtype_id ); hid_t tid = H5Tcopy(dtype_id); + addHandle(tid); SEXP Rval; PROTECT(Rval = HID_2_STRSXP(tid)); @@ -216,6 +218,7 @@ SEXP _H5Tenum_create( SEXP _base_id ) { hid_t base_id = STRSXP_2_HID( _base_id ); hid_t tid = H5Tenum_create(base_id); + addHandle(tid); SEXP Rval; PROTECT(Rval = HID_2_STRSXP(tid)); @@ -297,6 +300,21 @@ SEXP _H5Tget_class( SEXP _dtype_id ) { } break; } + UNPROTECT(1); + return Rval; +} + +/* herr_t H5Tclose( hid_t dtype_id ) */ +SEXP _H5Tclose( SEXP _dtype_id ) { + hid_t dtype_id = STRSXP_2_HID( _dtype_id ); + herr_t herr = H5Tclose( dtype_id ); + if (herr == 0) { + removeHandle(dtype_id); + } + + SEXP Rval; + PROTECT(Rval = allocVector(INTSXP, 1)); + INTEGER(Rval)[0] = herr; UNPROTECT(1); return Rval; } \ No newline at end of file diff --git a/src/H5T.h b/src/H5T.h index a25f8b5b..06d56c0a 100644 --- a/src/H5T.h +++ b/src/H5T.h @@ -7,10 +7,12 @@ #include #include "myhdf5.h" #include "H5constants.h" +#include "HandleList.h" SEXP _H5Tcreate( SEXP _type, SEXP _size ); SEXP _H5Tget_class( SEXP _dtype_id ); SEXP _H5Tcopy( SEXP _dtype_id ); +SEXP _H5Tclose( SEXP _dtype_id ); SEXP _H5Tset_size( SEXP _dtype_id, SEXP _size ); SEXP _H5Tget_size( SEXP _dtype_id ); SEXP _H5Tset_strpad( SEXP _dtype_id, SEXP _strpad ); diff --git a/src/wrap.c b/src/wrap.c index c3733725..aa95dfca 100644 --- a/src/wrap.c +++ b/src/wrap.c @@ -123,6 +123,7 @@ static R_CallMethodDef libraryRCalls[] = { {"_H5Tget_class", (DL_FUNC) &_H5Tget_class, 1}, {"_H5Tcreate", (DL_FUNC) &_H5Tcreate, 2}, {"_H5Tcopy", (DL_FUNC) &_H5Tcopy, 1}, + {"_H5Tclose", (DL_FUNC) &_H5Tclose, 1}, {"_H5Tset_size", (DL_FUNC) &_H5Tset_size, 2}, {"_H5Tget_size", (DL_FUNC) &_H5Tget_size, 1}, {"_H5Tset_strpad", (DL_FUNC) &_H5Tset_strpad, 2}, diff --git a/tests/testthat/test_H5A.R b/tests/testthat/test_H5A.R index 61e59e4b..7ebed932 100644 --- a/tests/testthat/test_H5A.R +++ b/tests/testthat/test_H5A.R @@ -36,6 +36,7 @@ test_that("writing attributes is silent", { expect_silent(H5Sclose(sid2)) expect_silent(H5Dclose(did)) expect_silent(H5Fclose(fid)) + expect_silent(H5Tclose(tid)) }) @@ -162,7 +163,7 @@ test_that("fixed length string attributes are correct", { H5Awrite(aid, attr_value) # string of length 7 - h5closeAll(aid, sid, fid) + h5closeAll(aid, sid, fid, tid) attr <- h5readAttributes(h5File, "/") expect_is(attr, class = "list") diff --git a/tests/testthat/test_H5P_dcpl.R b/tests/testthat/test_H5P_dcpl.R index 2379e742..dc0d3c8c 100644 --- a/tests/testthat/test_H5P_dcpl.R +++ b/tests/testthat/test_H5P_dcpl.R @@ -49,6 +49,7 @@ test_that("UTF8 strings can be used for fill values", { H5Pclose(pid) H5Sclose(sid) H5Fclose(fid) + H5Tclose(tid) expect_equivalent(h5read(tf, name = "/strings"), fill_value) }) diff --git a/tests/testthat/test_H5T.R b/tests/testthat/test_H5T.R index abed9741..a3b2acdf 100644 --- a/tests/testthat/test_H5T.R +++ b/tests/testthat/test_H5T.R @@ -1,27 +1,34 @@ library(rhdf5) -tid <- H5Tcopy("H5T_C_S1") -integer_tid <- H5Tcopy("H5T_STD_U32LE") - test_that("String padding can be read and changed", { + tid <- H5Tcopy("H5T_C_S1") + expect_silent(tid2 <- H5Tset_strpad(dtype_id = tid, strpad = "NULLTERM")) expect_identical(H5Tget_strpad(tid), 0L) expect_silent(tid2 <- H5Tset_strpad(dtype_id = tid, strpad = "NULLPAD")) expect_identical(H5Tget_strpad(tid), 1L) expect_silent(tid2 <- H5Tset_strpad(dtype_id = tid, strpad = "SPACEPAD")) expect_identical(H5Tget_strpad(tid), 2L) + + expect_silent(H5Tclose(tid)) }) test_that("String character set can be read and changed", { + tid <- H5Tcopy("H5T_C_S1") + expect_identical(H5Tget_cset(tid), 0L) expect_silent(H5Tset_cset(tid, cset = "UTF-8")) |> expect_gte(0) expect_identical(H5Tget_cset(tid), 1L) + + expect_silent(H5Tclose(tid)) }) test_that("H5T error handling works", { + tid <- H5Tcopy("H5T_C_S1") + expect_error(H5Tget_strpad()) expect_error(H5Tset_strpad(dtype_id = tid, strpad = "FOOBAA")) @@ -30,9 +37,13 @@ test_that("H5T error handling works", { expect_error(H5Tget_cset()) expect_error(H5Tget_cset(dtype_id = tid, cset = "FOOBAA")) + + expect_silent(H5Tclose(tid)) }) test_that("Precision can be modified", { + integer_tid <- H5Tcopy("H5T_STD_U32LE") + expect_identical(H5Tget_precision(integer_tid), 32L) expect_true(H5Tset_precision(integer_tid, precision = 8)) expect_identical(H5Tget_precision(integer_tid), 8L) @@ -49,12 +60,17 @@ test_that("Precision can be modified", { H5Tset_precision(integer_tid, 0), regexp = "'precision' argument must be greater than 0" ) + + expect_silent(H5Tclose(integer_tid)) }) test_that("Enum datatypes can be created and modified", { expect_silent(tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR")) + expect_is(tid, "character") expect_true(H5Tenum_insert(tid, name = "TRUE", value = 1L)) expect_true(H5Tenum_insert(tid, name = "FALSE", value = 0L)) + + expect_silent(H5Tclose(tid)) }) diff --git a/tests/testthat/test_H5T_extras.R b/tests/testthat/test_H5T_extras.R index cefa0d1c..817306fe 100644 --- a/tests/testthat/test_H5T_extras.R +++ b/tests/testthat/test_H5T_extras.R @@ -1,10 +1,10 @@ library(rhdf5) -tid <- H5Tenum_create() -H5Tenum_insert(tid, name = "TRUE", value = 1L) -H5Tenum_insert(tid, name = "FALSE", value = 0L) - test_that("enum details are extracted", { + tid <- H5Tenum_create() + H5Tenum_insert(tid, name = "TRUE", value = 1L) + H5Tenum_insert(tid, name = "FALSE", value = 0L) expect_identical(h5getEnumNames(tid), c("TRUE", "FALSE")) expect_identical(h5getEnumValues(tid), c(1L, 0L)) + expect_silent(H5Tclose(tid)) }) diff --git a/tests/testthat/test_H5Tclose.R b/tests/testthat/test_H5Tclose.R new file mode 100644 index 00000000..77c131d9 --- /dev/null +++ b/tests/testthat/test_H5Tclose.R @@ -0,0 +1,16 @@ +test_that("H5Tclose works for enum datatypes", { + tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR") + H5Tenum_insert(tid, name = "TRUE", value = 1L) + H5Tenum_insert(tid, name = "FALSE", value = 0L) + + # Should be able to close the datatype + expect_identical(H5Tclose(tid), 0L) +}) + +test_that("H5Tclose works for copied datatypes", { + tid <- H5Tcopy("H5T_C_S1") + H5Tset_size(tid, 10) + + # Should be able to close the datatype + expect_identical(H5Tclose(tid), 0L) +}) diff --git a/tests/testthat/test_h5read.R b/tests/testthat/test_h5read.R index a305e627..aff274a6 100644 --- a/tests/testthat/test_h5read.R +++ b/tests/testthat/test_h5read.R @@ -183,6 +183,7 @@ test_that("reading & writing scalar dataspaces", { expect_silent(H5Dclose(did)) expect_silent(H5Sclose(sid)) expect_silent(H5Fclose(fid)) + expect_silent(H5Tclose(tid)) }) test_that("we can read anndata nullable arrays", { diff --git a/tests/testthat/test_methods.R b/tests/testthat/test_methods.R index 450defd3..8133f5b1 100644 --- a/tests/testthat/test_methods.R +++ b/tests/testthat/test_methods.R @@ -46,6 +46,7 @@ test_that("Printing various object types", { expect_silent(H5Sclose(sid)) expect_silent(H5Dclose(did)) expect_silent(H5Fclose(fid)) + expect_silent(H5Tclose(tid)) }) ############################################################