@@ -38,6 +38,10 @@ matching `Read10X_Image()`.
   `row`/`col`/`tissue` columns are kept in the image `misc` so a later
   downgrade restores them).
 - Both accept a file path (`.rds` / `.h5seurat`) plus `dest`.
+- Assays whose feature-level meta data has no columns (a fresh assay without
+  variable features) convert in both directions: SeuratObject's own
+  `Assay5 <-> Assay` coercions fail on such a table under R >= 4.5, so the
+  conversion pads it for the duration of the coercion.
 
 ## Lossless h5ad layout upgrade / downgrade (`upgradeH5AD`, `downgradeH5AD`, `h5adLayout`)
 
@@ -59,6 +63,13 @@ matching `Read10X_Image()`.
   directions. `strings = "categorical"` produces a file every anndata >= 0.8
   can read.
 
+- The rewriter and the AnnData readers close every HDF5 handle as soon as it
+  is no longer needed, and legacy `__categories` object references are built
+  from the object address instead of hdf5r's `create_reference()`, whose
+  temporary file handle corrupts hdf5r's reference bookkeeping after enough
+  references (a GC-timing dependent "r_count can never be more than 1 larger
+  than h5_count" error).
+
 ## AnnData cross-version compatibility (anndata 0.7 through 0.13)
 
 Fixture files written by anndata 0.7.8, 0.8.0, 0.10.9, 0.11.4, 0.12.19 and
 
@@ -65,6 +65,32 @@ NULL
 #'
 #' @keywords internal
 #' @noRd
+#' Close an hdf5r object handle without failing
+#'
+#' Handles are closed as soon as they are no longer needed: hdf5r's
+#' \code{close_all()} and its GC finalizers misbehave on HDF5 1.12 (the
+#' library bundled by the CRAN Windows binary) when a file is closed while
+#' many child handles are still open.
+#'
+#' @keywords internal
+#' @noRd
+.h5_close_quietly <- function(obj) {
+  if (!is.null(obj) && inherits(obj, "H5RefClass") && !inherits(obj, "H5File")) {
+    tryCatch(obj$close(), error = function(e) NULL)
+  }
+  invisible(NULL)
+}
+
+#' Open a child of an HDF5 group, apply a function and close the handle
+#'
+#' @keywords internal
+#' @noRd
+.h5_with_child <- function(parent, name, fn) {
+  child <- parent[[name]]
+  on.exit(.h5_close_quietly(child), add = TRUE)
+  fn(child)
+}
+
 .h5ad_as_logical <- function(x) {
   if (is.logical(x)) return(x)
   if (is.factor(x)) return(as.logical(toupper(as.character(x))))
@@ -89,8 +115,8 @@ NULL
 .h5ad_read_nullable <- function(grp) {
   if (!inherits(grp, "H5Group")) return(NULL)
   if (!(grp$exists("values") && grp$exists("mask"))) return(NULL)
-  values <- grp[["values"]]$read()
-  mask <- .h5ad_as_logical(grp[["mask"]]$read())
+  values <- .h5_with_child(grp, "values", function(d) d$read())
+  mask <- .h5ad_as_logical(.h5_with_child(grp, "mask", function(d) d$read()))
   enc <- .h5ad_encoding(grp)
   if (identical(enc, "nullable-boolean")) {
     values <- .h5ad_as_logical(values)
@@ -123,9 +149,11 @@ NULL
 .h5ad_read_categorical_group <- function(grp) {
   if (!inherits(grp, "H5Group")) return(NULL)
   if (!(grp$exists("codes") && grp$exists("categories"))) return(NULL)
-  codes <- grp[["codes"]]$read()
+  codes <- .h5_with_child(grp, "codes", function(d) d$read())
   categories <- .h5ad_read_string_like(grp, "categories")
-  if (is.null(categories)) categories <- as.character(grp[["categories"]]$read())
+  if (is.null(categories)) {
+    categories <- as.character(.h5_with_child(grp, "categories", function(d) d$read()))
+  }
   is_ordered <- isTRUE(.h5ad_as_logical(.h5ad_attr(grp, "ordered", FALSE))[1])
   .h5ad_decode_codes(as.integer(codes), as.character(categories), ordered = is_ordered)
 }
@@ -155,6 +183,7 @@ NULL
 .h5ad_read_string_like <- function(parent, name) {
   if (is.null(parent) || !parent$exists(name)) return(NULL)
   child <- parent[[name]]
+  on.exit(.h5_close_quietly(child), add = TRUE)
   if (inherits(child, "H5D")) {
     return(as.character(child$read()))
   }
@@ -237,6 +266,7 @@ NULL
 .h5ad_read_column <- function(grp, col) {
   if (!grp$exists(col)) return(NULL)
   obj <- grp[[col]]
+  on.exit(.h5_close_quietly(obj), add = TRUE)
   if (inherits(obj, "H5Group")) {
     vals <- .h5ad_read_nullable(obj)
     if (!is.null(vals)) return(vals)
@@ -247,9 +277,11 @@ NULL
   # Legacy (< 0.8) categorical: integer codes + __categories/<col>
   if (grp$exists("__categories")) {
     cats_grp <- grp[["__categories"]]
+    on.exit(.h5_close_quietly(cats_grp), add = TRUE)
     if (cats_grp$exists(col)) {
       codes <- obj$read()
       cats_dset <- cats_grp[[col]]
+      on.exit(.h5_close_quietly(cats_dset), add = TRUE)
       categories <- as.character(cats_dset$read())
       # anndata 0.7 stored booleans as categoricals with "False"/"True" categories
       if (length(categories) <= 2L && all(categories %in% c("False", "True"))) {
@@ -309,7 +341,11 @@ NULL
   if (inherits(obj, "H5D")) {
     enc <- .h5ad_encoding(obj)
     if (identical(enc, "null")) return(NULL)
-    simple <- tryCatch(obj$get_space()$is_simple(), error = function(e) TRUE)
+    simple <- tryCatch({
+      sp <- obj$get_space()
+      on.exit(.h5_close_quietly(sp), add = TRUE)
+      sp$is_simple()
+    }, error = function(e) TRUE)
     if (!isTRUE(simple)) return(NULL)
     vals <- obj$read()
     if (is.factor(vals) && all(levels(vals) %in% c("FALSE", "TRUE"))) {
@@ -328,7 +364,7 @@ NULL
   if (!is.null(cg)) return(cg)
   out <- list()
   for (nm in names(obj)) {
-    out[nm] <- list(tryCatch(.h5ad_read_element(obj[[nm]]), error = function(e) NULL))
+    out[nm] <- list(tryCatch(.h5_with_child(obj, nm, .h5ad_read_element), error = function(e) NULL))
   }
   out
 }
@@ -369,7 +405,7 @@ NULL
   # under __categories (this also restores the `ordered` flag).
   redo <- character(0)
   if (grp$exists("__categories")) {
-    redo <- intersect(names(grp[["__categories"]]), wanted)
+    redo <- intersect(.h5_with_child(grp, "__categories", names), wanted)
     cols[redo] <- NULL
   }
   for (col in setdiff(wanted, names(cols))) {
 
@@ -149,6 +149,26 @@ NULL
   dst_parent[[dst_name]]
 }
 
+# Object reference to `obj` (an H5D / H5Group of `file`) for a
+# H5T_STD_REF_OBJ attribute. hdf5r's own `create_reference()` opens a
+# temporary file handle whose garbage-collection finalizer corrupts hdf5r's
+# reference bookkeeping ("r_count can never be more than 1 larger than
+# h5_count" after enough references, at GC-dependent moments). A classic
+# object reference is the object's header address, so it is assembled here
+# from `obj_info()` and attached to the file handle we already hold; the
+# caller closes the returned object right after writing the attribute.
+.h5w_object_reference <- function(file, obj) {
+  addr <- as.numeric(obj$obj_info()$addr)
+  bytes <- integer(8)
+  for (i in seq_len(8)) {
+    bytes[i] <- addr %% 256
+    addr <- addr %/% 256
+  }
+  ref <- hdf5r::H5R_OBJECT$new(1, file)
+  ref$ref <- as.raw(bytes)
+  ref
+}
+
 .h5_is_scalar <- function(dset) {
   isTRUE(tryCatch(dset$get_space()$get_simple_extent_type() == "H5S_SCALAR",
                   error = function(e) FALSE)) ||
@@ -208,12 +228,15 @@ NULL
           !enc %in% .H5AD_MATRIX_ENCODINGS) {
         walk(obj, depth + 1L)
       }
+      .h5_close_quietly(obj)
     }
   }
   walk(h5, 0L)
   root_enc <- .h5ad_encoding(h5)
-  obs_is_group <- h5$exists("obs") && inherits(h5[["obs"]], "H5Group")
-  obs_df_version <- if (obs_is_group) as.character(.h5ad_attr(h5[["obs"]], "encoding-version", "")) else ""
+  obs_is_group <- h5$exists("obs") && .h5_with_child(h5, "obs", function(o) inherits(o, "H5Group"))
+  obs_df_version <- if (obs_is_group) {
+    as.character(.h5_with_child(h5, "obs", function(o) .h5ad_attr(o, "encoding-version", "")))
+  } else ""
   layout <- if (compound) {
     "compound"
   } else if (legacy_cats || identical(obs_df_version, "0.1.0") ||
@@ -222,7 +245,7 @@ NULL
   } else {
     "encoded"
   }
-  has_manifest <- h5$exists("uns") && h5[["uns"]]$exists(.H5AD_MANIFEST)
+  has_manifest <- h5$exists("uns") && .h5_with_child(h5, "uns", function(u) u$exists(.H5AD_MANIFEST))
   has_ns <- "nullable-string-array" %in% encs
   has_nb <- any(c("nullable-integer", "nullable-boolean") %in% encs)
   has_null <- "null" %in% encs
@@ -448,18 +471,22 @@ print.h5ad_layout <- function(x, ...) {
 # recorded in the manifest so an upgrade can restore it.
 .h5ad_write_column_legacy <- function(g, col, x, src_enc, path, ctx, na_note = "") {
   write_cat <- function(f, note = "") {
-    if (!g$exists("__categories")) g$create_group("__categories")
+    if (!g$exists("__categories")) .h5_close_quietly(g$create_group("__categories"))
     cg <- g[["__categories"]]
+    on.exit(.h5_close_quietly(cg), add = TRUE)
     lv <- levels(f)
     cd <- .h5w_dataset(cg, col, lv)
+    on.exit(.h5_close_quietly(cd), add = TRUE)
     .h5w_attr(cd, "ordered", is.ordered(f))
     codes <- as.integer(f) - 1L
     codes[is.na(codes)] <- -1L
     d <- .h5w_dataset(g, col, codes, dtype = .h5w_codes_dtype(length(lv)))
-    ref <- cg$create_reference(col)
+    on.exit(.h5_close_quietly(d), add = TRUE)
+    ref <- .h5w_object_reference(ctx$dst_file, cd)
+    on.exit(.h5_close_quietly(ref), add = TRUE)
     d$create_attr(attr_name = "categories", robj = ref,
                   dtype = hdf5r::h5types$H5T_STD_REF_OBJ, space = .h5w_scalar_space())
-    invisible(d)
+    invisible(NULL)
   }
   if (is.factor(x)) {
     if (src_enc %in% c("nullable-string-array", "string-array")) {
@@ -501,6 +528,10 @@ print.h5ad_layout <- function(x, ...) {
 #' @noRd
 .h5ad_write_dataframe <- function(src, name, dst_parent, path, ctx) {
   obj <- src[[name]]
+  on.exit(.h5_close_quietly(obj), add = TRUE)
+  child_attr <- function(cn, attr, default) {
+    .h5_with_child(obj, cn, function(o) as.character(.h5ad_attr(o, attr, default)))
+  }
   # ---- decode
   if (inherits(obj, "H5D")) {
     # anndata < 0.7: single compound dataset. Categories (if any) live in
@@ -571,12 +602,12 @@ print.h5ad_layout <- function(x, ...) {
       }
       na_value <- rec$note %||% ""
       if (!nzchar(na_value) && inherits(obj, "H5Group") && obj$exists(cn)) {
-        na_value <- as.character(.h5ad_attr(obj[[cn]], "na-value", "NaN"))
+        na_value <- child_attr(cn, "na-value", "NaN")
       }
       .h5ad_write_column_encoded(g, cn, v, want, ctx, na_value = na_value)
     } else {
       na_note <- if (inherits(obj, "H5Group") && obj$exists(cn)) {
-        as.character(.h5ad_attr(obj[[cn]], "na-value", ""))
+        child_attr(cn, "na-value", "")
       } else ""
       .h5ad_write_column_legacy(g, cn, v, src_encs[[cn]], cpath, ctx, na_note = na_note)
     }
@@ -590,7 +621,7 @@ print.h5ad_layout <- function(x, ...) {
     if (want == "nullable-string-array" && !identical(ctx$strings, "categorical")) {
       na_value <- irec$note %||% ""
       if (!nzchar(na_value) && inherits(obj, "H5Group") && obj$exists(index_name)) {
-        na_value <- as.character(.h5ad_attr(obj[[index_name]], "na-value", "NaN"))
+        na_value <- child_attr(index_name, "na-value", "NaN")
       }
       .h5ad_write_nullable_encoded(g, index_name, idx, "nullable-string-array",
                                    na_value = na_value)
@@ -602,21 +633,23 @@ print.h5ad_layout <- function(x, ...) {
   } else {
     if (idx_enc == "nullable-string-array") {
       .ctx_record(ctx, ipath, idx_enc, "0.1.0",
-                  note = as.character(.h5ad_attr(obj[[index_name]], "na-value", "")))
+                  note = child_attr(index_name, "na-value", ""))
     }
     if (anyNA(idx)) idx[is.na(idx)] <- ""
     .h5w_dataset(g, index_name, idx)
     .h5w_encoding(g, "dataframe", "0.1.0")
   }
   .h5w_attr(g, "_index", index_name)
   .h5w_attr(g, "column-order", keep, force_array = TRUE)
-  invisible(g)
+  .h5_close_quietly(g)
+  invisible(NULL)
 }
 
 # ---- generic element rewriter -----------------------------------------------
 
 .h5ad_rewrite_dataset <- function(src, name, dst, path, ctx) {
   obj <- src[[name]]
+  on.exit(.h5_close_quietly(obj), add = TRUE)
   enc <- .h5ad_encoding(obj)
   if (identical(enc, "null") || .h5_is_null_space(obj)) {
     # anndata < 0.9 has no `null` encoding: drop it for the legacy layout and
@@ -627,9 +660,11 @@ print.h5ad_layout <- function(x, ...) {
     }
     d <- .h5w_copy(src, name, dst)
     .h5w_encoding(d, "null", "0.1.0")
-    return(invisible(d))
+    .h5_close_quietly(d)
+    return(invisible(NULL))
   }
   d <- .h5w_copy(src, name, dst)
+  on.exit(.h5_close_quietly(d), add = TRUE)
   if (ctx$target == "encoded") {
     if (!nzchar(enc) || enc == "array" || enc == "string-array" ||
         enc == "numeric-scalar" || enc == "string" || enc == "bytes") {
@@ -644,11 +679,12 @@ print.h5ad_layout <- function(x, ...) {
   } else {
     .h5w_strip_encoding(d)
   }
-  invisible(d)
+  invisible(NULL)
 }
 
 .h5ad_rewrite_group <- function(src, name, dst, path, ctx, role = "generic") {
   obj <- src[[name]]
+  on.exit(.h5_close_quietly(obj), add = TRUE)
   enc <- .h5ad_encoding(obj)
   if (identical(name, .H5AD_MANIFEST) && role == "uns") {
     return(invisible(NULL))  # never carry a stale manifest forward
@@ -657,20 +693,22 @@ print.h5ad_layout <- function(x, ...) {
   if (enc %in% .H5AD_MATRIX_ENCODINGS ||
       (obj$exists("data") && obj$exists("indices") && obj$exists("indptr"))) {
     g <- .h5w_copy(src, name, dst)
+    on.exit(.h5_close_quietly(g), add = TRUE)
     if (!nzchar(enc)) enc <- "csr_matrix"
     .h5w_encoding(g, enc, "0.1.0")
     if (!isTRUE(g$attr_exists("shape")) && ctx$target == "encoded") {
       # shape is required by anndata >= 0.8; derive it from indptr/indices
-      indptr <- obj[["indptr"]]$read()
-      indices <- obj[["indices"]]$read()
+      indptr <- .h5_with_child(obj, "indptr", function(d) d$read())
+      indices <- .h5_with_child(obj, "indices", function(d) d$read())
       major <- length(indptr) - 1L
       minor <- if (length(indices)) max(indices) + 1L else 0L
       .h5w_attr(g, "shape", if (enc == "csc_matrix") c(minor, major) else c(major, minor))
     }
-    return(invisible(g))
+    return(invisible(NULL))
   }
   if (enc %in% .H5AD_OPAQUE_ENCODINGS) {
-    return(invisible(.h5w_copy(src, name, dst)))
+    .h5_close_quietly(.h5w_copy(src, name, dst))
+    return(invisible(NULL))
   }
   # Dataframes
   is_df <- identical(enc, "dataframe") || role %in% c("obs", "var") ||
@@ -707,13 +745,14 @@ print.h5ad_layout <- function(x, ...) {
   }
   # Plain (dict) group: recurse
   g <- dst$create_group(name)
+  on.exit(.h5_close_quietly(g), add = TRUE)
   child_role <- if (role == "raw") "raw-child" else if (role == "uns") "uns" else "generic"
   for (child in names(obj)) {
     cpath <- paste0(path, "/", child)
-    cobj <- obj[[child]]
+    child_is_dataset <- .h5_with_child(obj, child, function(o) inherits(o, "H5D"))
     r <- child_role
     if (role == "raw" && child == "var") r <- "var"
-    if (inherits(cobj, "H5D")) {
+    if (child_is_dataset) {
       .h5ad_rewrite_dataset(obj, child, g, cpath, ctx)
     } else {
       .h5ad_rewrite_group(obj, child, g, cpath, ctx, role = r)
@@ -724,7 +763,7 @@ print.h5ad_layout <- function(x, ...) {
   } else {
     .h5w_strip_encoding(g)
   }
-  invisible(g)
+  invisible(NULL)
 }
 
 #' Rewrite an h5ad file into another on-disk layout
@@ -775,6 +814,7 @@ print.h5ad_layout <- function(x, ...) {
   ctx$source_layout <- info$layout
   ctx$writer <- pkg
   ctx$writer_version <- tryCatch(as.character(utils::packageVersion(pkg)), error = function(e) "")
+  ctx$dst_file <- dst
   ctx$src_uns_exists <- function(key) src$exists("uns") && src[["uns"]]$exists(key)
   ctx$src_uns_read <- function(key) src[["uns"]][[key]]$read()
 
@@ -787,7 +827,7 @@ print.h5ad_layout <- function(x, ...) {
     role <- roles[nm] %||% "generic"
     if (is.na(role)) role <- "generic"
     if (verbose) message("  ", nm)
-    if (inherits(src[[nm]], "H5D")) {
+    if (.h5_with_child(src, nm, function(o) inherits(o, "H5D"))) {
       if (nm %in% c("obs", "var")) {
         .h5ad_write_dataframe(src, nm, dst, nm, ctx)
       } else {