library(rhdf5)

############################################################
context("h5ls supports native functionality")
############################################################

h5File <- withr::local_tempfile(fileext = ".h5")

h5createFile(file = h5File)

test_that("h5ls supports native", {
  h5createGroup(file = h5File, group = "test")
  m0 <- matrix(1:12, 3, 4)

  h5write(m0, file = h5File, name = "test/native", native = TRUE)
  h5write(m0, file = h5File, name = "test/nonnative", native = FALSE)

  xx <- h5ls(h5File)
  object <- subset(xx, group == "/test" & name == "nonnative", "dim")[[1]]
  expect_identical(object, "3 x 4")
  object <- subset(xx, group == "/test" & name == "native", "dim")[[1]]
  expect_identical(object, "4 x 3")

  xx <- h5ls(h5File, native = TRUE)
  object <- subset(xx, group == "/test" & name == "nonnative", "dim")[[1]]
  expect_identical(object, "4 x 3")
  object <- subset(xx, group == "/test" & name == "native", "dim")[[1]]
  expect_identical(object, "3 x 4")

  m0 <- array(1:24, c(2, 3, 4))
  h5write(m0, file = h5File, name = "test/native-array", native = TRUE)
  h5write(m0, file = h5File, name = "test/nonnative-array", native = FALSE)

  xx <- h5ls(h5File)
  object <-
    subset(xx, group == "/test" & name == "nonnative-array", "dim")[[1]]
  expect_identical(object, "2 x 3 x 4")
  object <-
    subset(xx, group == "/test" & name == "native-array", "dim")[[1]]
  expect_identical(object, "4 x 3 x 2")

  xx <- h5ls(h5File, native = TRUE)
  object <-
    subset(xx, group == "/test" & name == "nonnative-array", "dim")[[1]]
  expect_identical(object, "4 x 3 x 2")
  object <-
    subset(xx, group == "/test" & name == "native-array", "dim")[[1]]
  expect_identical(object, "2 x 3 x 4")
})

############################################################
context("h5read/h5write supports native functionality")
############################################################

test_that("h5read/write supports native", {
  h5createGroup(file = h5File, group = "test")

  ## matrix
  do_matrix <- function(values, nrow, ncol, val) {
    m0 <- matrix(values, nrow, ncol)

    h5write(
      m0,
      file = h5File,
      name = paste0("test/nonnative", val),
      native = FALSE
    )
    m1 <- h5read(
      file = h5File,
      name = paste0("test/nonnative", val),
      native = TRUE
    )
    expect_equivalent(m0, t(m1))
    m2 <- h5read(
      file = h5File,
      name = paste0("test/nonnative", val),
      native = FALSE
    )
    expect_equivalent(m0, m2)

    h5write(m0, file = h5File, name = paste0("test/native", val), native = TRUE)
    m1 <- h5read(
      file = h5File,
      name = paste0("test/native", val),
      native = FALSE
    )
    expect_equivalent(m0, t(m1))
    m2 <- h5read(
      file = h5File,
      name = paste0("test/native", val),
      native = TRUE
    )
    expect_equivalent(m0, m2)
  }
  do_matrix(1:12, 3, 4, "A")
  do_matrix(as.numeric(1:12), 3, 4, "B")
  do_matrix(sample(c(TRUE, FALSE), 12, replace = TRUE), 3, 4, "C")
  do_matrix(LETTERS[1:12], 3, 4, "D")

  ## 3D-array
  do_array <- function(values, dim, val) {
    m0 <- array(values, dim)

    h5write(
      m0,
      file = h5File,
      name = paste0("test/nonnative-array", val),
      native = FALSE
    )
    m1 <- h5read(
      file = h5File,
      name = paste0("test/nonnative-array", val),
      native = TRUE
    )
    expect_equivalent(m0, aperm(m1))
    m2 <- h5read(
      file = h5File,
      name = paste0("test/nonnative-array", val),
      native = FALSE
    )
    expect_equivalent(m0, m2)

    h5write(
      m0,
      file = h5File,
      name = paste0("test/native-array", val),
      native = TRUE
    )
    m1 <- h5read(
      file = h5File,
      name = paste0("test/native-array", val),
      native = FALSE
    )
    expect_equivalent(m0, aperm(m1))
    m2 <- h5read(
      file = h5File,
      name = paste0("test/native-array", val),
      native = TRUE
    )
    expect_equivalent(m0, m2)
  }

  do_array(1:12, c(2, 3, 4), "A")
  do_array(as.numeric(1:12), c(2, 3, 4), "B")
  do_array(sample(c(TRUE, FALSE), 12, replace = TRUE), c(2, 3, 4), "C")
  do_array(LETTERS[1:12], c(2, 3, 4), "D")
})

test_that("h5read/h5write supports index and hyperslab", {
  h5createDataset(file = h5File, dataset = "D", dims = c(10, 9), native = TRUE)

  ## Test index works
  h5write(
    1:4,
    file = h5File,
    name = "D",
    index = list(2:3, c(3, 6)),
    native = TRUE
  )
  res <- h5read(
    file = h5File,
    name = "D",
    index = list(2:3, c(3, 6)),
    native = TRUE
  )
  expect_equal(res, matrix(1:4, nrow = 2, ncol = 2))

  ## Test hyperslabs without stride and block arguments work
  h5write(
    matrix(1:12, nrow = 4, ncol = 3),
    file = h5File,
    name = "D",
    start = c(2, 2),
    stride = NULL,
    count = c(4, 3),
    block = NULL,
    native = TRUE
  )
  expect_equal(
    h5read(h5File, "D", native = TRUE)[2:5, 2:4],
    matrix(1:12, nrow = 4, ncol = 3)
  )
  res <- h5read(
    file = h5File,
    name = "D",
    start = c(2, 2),
    stride = NULL,
    count = c(4, 3),
    block = NULL,
    native = TRUE
  )
  expect_equal(res, matrix(1:12, nrow = 4, ncol = 3))

  ## Test hyperslabs with all arguments work
  h5write(
    matrix(1:48, nrow = 6, ncol = 8),
    file = h5File,
    name = "D",
    start = c(1, 1),
    stride = c(4, 5),
    count = c(2, 2),
    block = c(3, 4),
    native = TRUE
  )
  expect_equal(
    h5read(h5File, "D", native = TRUE)[c(1:3, 5:7), c(1:4, 6:9)],
    matrix(1:48, nrow = 6, ncol = 8)
  )
  res <- h5read(
    file = h5File,
    name = "D",
    start = c(1, 1),
    stride = c(4, 5),
    count = c(2, 2),
    block = c(3, 4),
    native = TRUE
  )
  expect_equal(res, matrix(1:48, nrow = 6, ncol = 8))
})

test_that("h5read native non-R hdf5 files", {
  enum <- system.file("testfiles", "h5ex_t_enum.h5", package = "rhdf5")
  arr <- system.file("testfiles", "h5ex_t_array.h5", package = "rhdf5")
  compound <- system.file("testfiles", "h5ex_t_cmpd.h5", package = "rhdf5")

  # Test enums type
  m1 <- h5read(file = enum, name = "/DS1", native = TRUE)
  m2 <- h5read(file = enum, name = "/DS1", native = FALSE)
  expect_equivalent(m1, t(m2))

  # Test arrays type
  m1 <- h5read(file = arr, name = "/DS1", native = TRUE)
  m2 <- h5read(file = arr, name = "/DS1", native = FALSE)
  expect_equivalent(m1, aperm(m2))

  # Test compound type (currently native provides no different functionality)
  m1 <- h5read(file = compound, name = "/DS1", native = TRUE)
  m2 <- h5read(file = compound, name = "/DS1", native = FALSE)
  expect_equivalent(m1, m2)
})

############################################################
context("H5Sselect_hyperslab supports native functionality")
############################################################

test_that("Selecting hyperslabs", {
  expect_silent(sid <- H5Screate_simple(dims = c(10, 20), native = TRUE))

  expect_silent(H5Sselect_hyperslab(sid))

  expect_silent(H5Sclose(sid))
})

############################################################
context("H5Sselect_index supports native functionality")
############################################################

test_that("Selecting using an index", {
  expect_silent(sid <- H5Screate_simple(dims = c(10, 20, 30)))

  expect_silent(size <- H5Sselect_index(sid, index = list(1:5, 1:5, 11:15)))
  expect_identical(size, c(5, 5, 5))

  expect_silent(size <- H5Sselect_index(sid, index = list(NULL, NULL, NULL)))
  expect_identical(size, c(10, 20, 30))

  ## errors when not providing enough dimensions or incorrect dimensions
  expect_error(
    H5Sselect_index(sid, index = list(10)),
    regexp = "length of list index not equal to h5space dimensional extension"
  )
  expect_error(
    H5Sselect_index(sid, index = list(1:5, 1:5, 0:5)),
    regexp = "negative indices and 0 not supported"
  )
  expect_error(
    H5Sselect_index(sid, index = list(1:15, 1:5, 1:5)),
    regexp = "index exceeds HDF5-array dimension"
  )

  expect_silent(H5Sclose(sid))
})

############################################################
context("H5F supports native functionality")
############################################################

test_that("H5F native functionality", {
  for (native in c(FALSE, TRUE)) {
    h5createGroup(file = h5File, group = "H5Ftest")

    A <- matrix(1:10, nrow = 5, ncol = 2)
    h5write(A, h5File, paste0("H5Ftest/A", native), native = native)

    h5f <- H5Fopen(h5File, native = native)
    h5d <- h5f & paste0("/H5Ftest/A", native)

    expect_equivalent(h5d[,], A)
    expect_equivalent(h5d[1, ], A[1, ])

    h5d[, 1] <- 11:15
    expect_equivalent(h5d[, 1], 11:15)

    H5Oclose(h5d)

    B <- matrix(11:20, nrow = 5, ncol = 2)
    h5writeDataset(B, h5f, paste0("H5Ftest/A", native))

    H5Fclose(h5f)

    expect_equivalent(
      h5read(h5File, paste0("H5Ftest/A", native), native = native),
      B
    )
  }
})
