Add H5Tclose

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)

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

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)
 }
 

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.

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)

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)

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;
 }

src/H5T.h

@@ -7,10 +7,12 @@
 #include <R_ext/Error.h>
 #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 );

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},

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")

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)
 })

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))
 })

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))
 })

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)
+})

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", {

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))
 })
 
 ############################################################