[H5r-commits] r66 - man src tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Sep 15 02:41:25 CEST 2011
Author: extemporaneousb
Date: 2011-09-15 02:41:24 +0200 (Thu, 15 Sep 2011)
New Revision: 66
Added:
src/h5_debug.c
tests/testErrors.R
tests/testGetGroup.R
tests/testMemory.R
tests/testRead.R
tests/testWrite.R
Removed:
tests/crash.R
tests/testread.R
tests/testwrite.R
Modified:
man/H5DataFrame.Rd
man/readPoints.Rd
src/h5_wrap.c
tests/Makefile
Log:
Modified: man/H5DataFrame.Rd
===================================================================
--- man/H5DataFrame.Rd 2011-08-12 19:01:13 UTC (rev 65)
+++ man/H5DataFrame.Rd 2011-09-15 00:41:24 UTC (rev 66)
@@ -6,7 +6,7 @@
}
\description{
'H5DataFrame' is a function that creates a list of equal-length
- vectors. It stores H5 data tables.
+ vectors.
}
\usage{
H5DataFrame(file, nms = NA)
@@ -14,46 +14,14 @@
\arguments{
\item{file}{
H5 file.
-}
+ }
\item{nms}{
File names.
+ }
}
-}
-\details{
-}
-\value{
-}
-\references{
-}
-\note{
-}
-\seealso{
-}
\examples{
require(h5r)
h5 <- H5File("test.h5", 'w')
-...
-## The function is currently defined as
-function (file, nms = NA)
-{
- .getCols <- function(h5) {
- nms <- names(listH5Contents(h5))
- nms[nms != "."]
- }
- h5File <- H5File(file)
- if (is.na(nms)) {
- nms <- .getCols(h5File)
- }
- h5Datasets <- lapply(nms, function(nm) {
- getH5Dataset(h5File, nm)
- })
- names(h5Datasets) <- nms
- stopifnot(length(unique(sapply(h5Datasets, length))) == 1)
- obj <- new("H5DataFrame")
- obj at h5File <- h5File
- obj at h5Datasets <- h5Datasets
- return(obj)
- }
}
\keyword{datagen}
Modified: man/readPoints.Rd
===================================================================
--- man/readPoints.Rd 2011-08-12 19:01:13 UTC (rev 65)
+++ man/readPoints.Rd 2011-09-15 00:41:24 UTC (rev 66)
@@ -32,8 +32,8 @@
\examples{
require(h5r)
h5 <- H5File("test.h5", 'w')
- d1 <- createH5Dataset(h5, "jon", runif(100000))
- p <- readPoints(d1, ss <- sample(1:length(d1), size = 1000, replace = T))
+ d1 <- createH5Dataset(h5, "dataset", runif(100000))
+ p <- readPoints(d1, ss <- sample(1:length(d1), size = 1000, replace = TRUE))
head(p)
all(p == d1[ss])
}
Added: src/h5_debug.c
===================================================================
--- src/h5_debug.c (rev 0)
+++ src/h5_debug.c 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,48 @@
+/**
+ * Code which is used to debug things.
+ */
+#include <hdf5.h>
+#include <Rinternals.h>
+#include <R.h>
+
+void h5R_allocate_finalizer(SEXP eptr) {
+ char* vector = R_ExternalPtrAddr(eptr);
+ Free(vector);
+ R_ClearExternalPtr(eptr);
+}
+
+SEXP h5R_allocate_meg() {
+ char* vector = (char*) Calloc(1048576, char);
+ for (int j = 0; j < 1048576; j++) {
+ vector[j] = 'c';
+ }
+ SEXP e_ptr = R_MakeExternalPtr(vector, R_NilValue, R_NilValue);
+ PROTECT(e_ptr);
+ R_RegisterCFinalizerEx(e_ptr, h5R_allocate_finalizer, TRUE);
+ UNPROTECT(1);
+ return e_ptr;
+}
+
+SEXP h5R_allocate_k() {
+ char* vector = (char*) Calloc(1024, char);
+ for (int j = 0; j < 1024; j++) {
+ vector[j] = 'c';
+ }
+ SEXP e_ptr = R_MakeExternalPtr(vector, R_NilValue, R_NilValue);
+ PROTECT(e_ptr);
+ R_RegisterCFinalizerEx(e_ptr, h5R_allocate_finalizer, TRUE);
+ UNPROTECT(1);
+ return e_ptr;
+}
+
+SEXP h5R_allocate_gig() {
+ char* vector = (char*) Calloc(1073741824, char);
+ for (int j = 0; j < 1073741824; j++) {
+ vector[j] = 'c';
+ }
+ SEXP e_ptr = R_MakeExternalPtr(vector, R_NilValue, R_NilValue);
+ PROTECT(e_ptr);
+ R_RegisterCFinalizerEx(e_ptr, h5R_allocate_finalizer, TRUE);
+ UNPROTECT(1);
+ return e_ptr;
+}
Modified: src/h5_wrap.c
===================================================================
--- src/h5_wrap.c 2011-08-12 19:01:13 UTC (rev 65)
+++ src/h5_wrap.c 2011-09-15 00:41:24 UTC (rev 66)
@@ -1,6 +1,5 @@
/**
* R/C Interface code for HDF5 file format.
- *
*/
#include <hdf5.h>
#include <Rinternals.h>
@@ -19,7 +18,9 @@
void h5R_finalizer(SEXP h5_obj) {
h5_holder* h = (h5_holder*) R_ExternalPtrAddr(h5_obj);
- if (! h) return;
+ if (! h) {
+ return;
+ }
if (h->is_file == 1) {
H5Fflush(HID(h5_obj), H5F_SCOPE_GLOBAL);
H5Fclose(HID(h5_obj));
@@ -35,10 +36,15 @@
H5Gclose(HID(h5_obj));
break;
default:
- error("Tried finalize type: %d.\n", H5Iget_type(HID(h5_obj)));
+ // error("Tried finalize type: %d.\n", H5Iget_type(HID(h5_obj)));
+ // Now that I'm writing, when I garbage collect I could
+ // pick up an already closed thing, which seems to give this branch
+ // problems.
+ break;
}
}
- Free(h);
+ free(h);
+ R_ClearExternalPtr(h5_obj);
}
SEXP h5R_flush(SEXP h5_file) {
@@ -50,11 +56,14 @@
if (id < 0) {
return R_NilValue;
}
- h5_holder* holder = (h5_holder*) Calloc(1, h5_holder);
+ /** Note the use of malloc/free here and above. **/
+ h5_holder* holder = (h5_holder*) malloc(sizeof(h5_holder));
holder->id = id;
holder->is_file = is_file;
- SEXP e_ptr = R_MakeExternalPtr(holder, install("hd5_handle"), R_NilValue);
+ SEXP e_ptr = R_MakeExternalPtr(holder, R_NilValue, R_NilValue);
+ PROTECT(e_ptr);
R_RegisterCFinalizerEx(e_ptr, h5R_finalizer, TRUE);
+ UNPROTECT(1);
return e_ptr;
}
@@ -123,6 +132,7 @@
int _h5R_get_ndims(SEXP h5_obj) {
hid_t space = _h5R_get_space(h5_obj);
int ndims = H5Sget_simple_extent_ndims(space);
+ H5Sclose(space);
return ((ndims < 0) ? 1 : ndims);
}
@@ -133,7 +143,6 @@
hsize_t* dims = (hsize_t* ) Calloc(ndims, hsize_t);
H5Sget_simple_extent_dims(space, dims, NULL);
-
for (i = 0; i < ndims; i++)
v *= dims[i];
@@ -239,7 +248,9 @@
/** Cleanup. **/
if (_h5R_is_vlen(h5_obj)) {
- H5Dvlen_reclaim (memtype, _h5R_get_space(h5_obj), H5P_DEFAULT, rdata);
+ hid_t space = _h5R_get_space(h5_obj);
+ H5Dvlen_reclaim (memtype, space, H5P_DEFAULT, rdata);
+ H5Sclose(space);
}
else {
for (i = 0; i < nelts; i++)
Modified: tests/Makefile
===================================================================
--- tests/Makefile 2011-08-12 19:01:13 UTC (rev 65)
+++ tests/Makefile 2011-09-15 00:41:24 UTC (rev 66)
@@ -1,9 +1,15 @@
clean :
- rm -f *.Rout
+ rm -f *.Rout *.h5
all :
- R CMD BATCH --no-save testread.R &
+ R CMD BATCH --no-save testRead.R &
R CMD BATCH --no-save testReadPoints.R &
- R CMD BATCH --no-save testwrite.R &
- R CMD BATCH --no-save crash.R &
+ R CMD BATCH --no-save testWrite.R &
+ R CMD BATCH --no-save testErrors.R &
+
+valgrind:
+ R -d "valgrind --tool=memcheck --leak-check=full" --vanilla < testread.R
+ R -d "valgrind --tool=memcheck --leak-check=full" --vanilla < testwrite.R
+
+
Deleted: tests/crash.R
===================================================================
--- tests/crash.R 2011-08-12 19:01:13 UTC (rev 65)
+++ tests/crash.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -1,20 +0,0 @@
-##
-## These are tests which error in hdf5 libraries and should give an R error.
-##
-require(h5r)
-
-source("tinyTestHarness.R")
-
-TH <- TestHarness()
-
-file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
-
-f <- H5File(file)
-
-TH("file existence", assertError(d <- H5File("sdfsdf")))
-TH("dataset existence", assertError(x <- getH5Dataset(f, "sdfsf")))
-TH("group existence", assertError(x <- getH5Group(f, "sdfasdf")))
-TH("attribute existence", assertError(getH5Attribute(f, "sfds")))
-
-TH(action='print')
-TH(action='throw')
Copied: tests/testErrors.R (from rev 64, tests/crash.R)
===================================================================
--- tests/testErrors.R (rev 0)
+++ tests/testErrors.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,20 @@
+##
+## These are tests which error in hdf5 libraries and should give an R error.
+##
+require(h5r)
+
+source("tinyTestHarness.R")
+
+TH <- TestHarness()
+
+file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
+
+f <- H5File(file)
+
+TH("file existence", assertError(d <- H5File("sdfsdf")))
+TH("dataset existence", assertError(x <- getH5Dataset(f, "sdfsf")))
+TH("group existence", assertError(x <- getH5Group(f, "sdfasdf")))
+TH("attribute existence", assertError(getH5Attribute(f, "sfds")))
+
+TH(action='print')
+TH(action='throw')
Added: tests/testGetGroup.R
===================================================================
--- tests/testGetGroup.R (rev 0)
+++ tests/testGetGroup.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,14 @@
+require(h5r)
+
+##
+## The tests.
+##
+file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
+f <- H5File(file)
+
+gc()
+v <- replicate(100000, {
+ getH5Group(f, "group_1")
+})
+rm(v)
+lapply(1:10, function(i) gc())
Added: tests/testMemory.R
===================================================================
--- tests/testMemory.R (rev 0)
+++ tests/testMemory.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,22 @@
+##
+## Currently, it seems as if I hold on to too much memory - this
+## corresponds to me not cleaning something up in HDF5 because
+## Valgrind says I'm fine.
+##
+require(h5r)
+
+m <- .Call("h5R_allocate_gig")
+rm(m)
+gc()
+
+m <- sapply(1:1000, function(a) {
+ .Call("h5R_allocate_meg")
+})
+rm(m)
+gc()
+
+m <- sapply(1:100000, function(a) {
+ .Call("h5R_allocate_k")
+})
+rm(m)
+gc()
Copied: tests/testRead.R (from rev 64, tests/testread.R)
===================================================================
--- tests/testRead.R (rev 0)
+++ tests/testRead.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,234 @@
+require(h5r)
+
+source("tinyTestHarness.R")
+
+##
+## Make a new TestHarness.
+##
+TH <- TestHarness()
+
+##
+## The tests.
+##
+file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
+
+## ex_1
+f <- H5File(file)
+g <- getH5Group(f, "group_1")
+
+TH("group name", g at name == "group_1")
+
+ds1 <- getH5Dataset(g, "ds_1", inMemory = T)
+
+TH("ds_1 dim, 1", all(dim(ds1) == c(1000, 10)))
+TH("ds_1 dim, 2", all(dim(ds1[1:10, 1:10]) == c(10, 10)))
+TH("ds_1 dim, 3", all(dim(ds1[1:10, ]) == c(10, 10)))
+TH("ds_1 dim, 4", is.null(dim(ds1[, 1])))
+TH("ds_1 dim, 5", assertError(ds1[,1:12]))
+
+## test existence.
+TH("existence, 1", h5DatasetExists(g, "ds_1"))
+TH("existence, 2", h5DatasetExists(g, "ds_232") == FALSE)
+
+## string dataset
+ds2M <- getH5Dataset(g, "ds_2", inMemory = T)
+ds2 <- getH5Dataset(g, "ds_2", inMemory = F)
+
+TH("ds_2 dim, 1", all(ds2[] == ds2M[]))
+TH("ds_2 dim, 2", all(ds2[1:5] == ds2M[1:5]))
+
+## attributes
+a <- getH5Attribute(ds2, "x")
+b <- getH5Attribute(ds2, "y")
+c <- getH5Attribute(ds2, "z")
+
+TH("attribute 1", all(a[] == 1:3))
+TH("attribute 2", all(b[] == rbind(1:3, 5:7)))
+TH("attribute 3", all(c[] == ds2[]))
+
+## > 2 dimensional data.
+ds3M <- getH5Dataset(g, "ds_3", inMemory = T)
+ds3 <- getH5Dataset(g, "ds_3", inMemory = F)
+
+TH("ds_3 dim", all(dim(ds3[,,]) == dim(ds3)) && all(dim(ds3M[,,]) == dim(ds3M)))
+
+## known inconsistency between two.
+TH("In memory inconsistency (!! FIXME !!)", assertError(all(ds3M[] == ds3[])))
+
+## the 3d R object.
+id3 <- ds3M at .data$.data
+
+TH("3d consistency, slabbed", all(id3[,,] == ds3[,,]) &
+ all(id3[,1,,drop=TRUE] == ds3[,1,,drop=TRUE]) &
+ all(id3[1,1,,drop=TRUE] == ds3[1,1,,drop=TRUE]) &
+ all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE]) &
+ all(id3[1,,1:3,drop=TRUE] == ds3[1,,1:3,drop=TRUE]))
+
+TH("3d consistency, contiguity",
+ all(id3[,2:1,] == ds3[,2:1,]) &
+ all(id3[,1,seq(1,9,by=4)] == ds3[,1,seq(1,9,by=4)]) &
+ all(id3[3:1,,] == ds3[3:1,,]))
+
+
+TH("3d consistency, memory", all(id3[,,] == ds3M[,,]) &
+ all(id3[,1,,drop=TRUE] == ds3M[,1,,drop=TRUE]) &
+ all(id3[1,1,,drop=TRUE] == ds3M[1,1,,drop=TRUE]) &
+ all(id3[1,,3,drop=TRUE] == ds3M[1,,3,drop=TRUE]))
+
+TH("3d bounds check 1", assertError(ds3[0:10,,]))
+TH("3d bounds check 2", assertError(ds3[,,0:10]))
+TH("3d bounds check 3", assertError(ds3[1,2,1:1000]))
+
+## 2 dimensional string dataset.
+ds4M <- getH5Dataset(g, "ds_4", inMemory = T)
+ds4 <- getH5Dataset(g, "ds_4", inMemory = F)
+
+TH("ds_2 dim", all(dim(ds4[,]) == dim(ds4)) & all(dim(ds4M[,]) == dim(ds4)))
+
+TH("ds_4, memory", (function(n = 100, s = 100) {
+ g1 <- gc()[,1]
+ a <- replicate(n, {
+ replicate(s, getH5Dataset(g, "ds_4", inMemory = FALSE)[1:2,1:2])
+ })
+ rm(a)
+ all(g1 - gc()[,1] <= 0)
+})())
+
+## contiguity problem.
+TH("contiguity", all(ds4M[1, c(2,3,5)] == ds4[1, c(2,3,5)]))
+TH("contiguity - 1D", all(ds2M[c(1, 7, 13)] == ds2[c(1, 7, 13)]))
+
+ds5 <- getH5Dataset(g, "ds_5")
+ds5M <- ds5[]
+
+TH("ds5 contiguity",
+ all(ds5[10:1, ] == ds5M[ 10:1, ]) &&
+ all(ds5[10:1, 2] == ds5M[ 10:1, 2]) &&
+ all(ds5[seq(1, 10, by = 3), 2] == ds5M[ seq(1, 10, by = 3), 2]))
+
+## 5-d object
+ds9M <- getH5Dataset(g, "ds_9", inMemory = T)
+ds9 <- getH5Dataset(g, "ds_9", inMemory = F)
+id9 <- ds9M[,,,,]
+
+TH("5-d 0", all(id9[] == ds9M[,,,,]) && all(id9[] == ds9[]))
+
+TH("5-d",
+ all(id9[c(7, 10), c(3, 4), , , ] == ds9[ c(7, 10), c(3, 4), , , ]) &&
+ all(id9[c(7, 10), c(3, 4), c(1, 5), , ] == ds9[ c(7, 10), c(3, 4), c(1, 5), , ]) &&
+ all(id9[c(7, 10), c(3, 4), 1:5, , ] == ds9[ c(7, 10), c(3, 4), 1:5, , ]) &&
+ all(id9[c(7, 10), c(3, 4), , , ] == ds9[ c(7, 10), c(3, 4), , , ]) &&
+ all(id9[c(10, 7), 10:1, , , ] == ds9[ c(10, 7), 10:1, , , ]) &&
+ all(id9[, , 1:2, 1:2, ] == ds9[ , , 1:2, 1:2, ]) &&
+ all(id9[, , 2:1, 2:1, ] == ds9[ , , 2:1, 2:1, ]) &&
+ all(id9[ , , , 1:2, 1:2 ] == ds9[ , , , 1:2, 1:2]) &&
+ all(id9[1,1,1,1,1] == ds9[1,1,1,1,1]))
+
+
+##
+## More in-depth testing of slicing.
+##
+ds6 <- getH5Dataset(g, "ds_6", inMemory = FALSE)
+ds6M <- getH5Dataset(g, "ds_6", inMemory = TRUE)
+
+TH("ds6, slicing", all(ds6[,] == ds6M[,]) & all(ds6[2:1001] == ds6M[2:1001]))
+
+timeMe <- function(d) {
+ k <- 100
+ n <- 100
+ system.time({
+ for (i in seq.int(1, n)) {
+ b <- runif(1, 1, nrow(d) - k)
+ d[b:(b + k)]
+ }
+ })[3]
+}
+
+## These are *real* upper-bounds on timing.
+TH("slab selection, timing", (mean(replicate(10, timeMe(ds6))) < 1))
+TH("slab selection, timing -- memory", (mean(replicate(10, timeMe(ds6M))) < 1))
+
+randomSlice <- function(d) {
+ dims <- dim(d)
+
+ starts <- floor(runif(length(dims), rep(1, length(dims)), dims))
+ ends <- starts + floor(rexp(length(dims), 1/4))
+ ends <- ifelse(ends > dims, dims, ends)
+
+ lst <- as.list(call("[", d))
+
+ for (i in 1:length(dims)) {
+ lst[[i + 2]] <- starts[i]:ends[i]
+ }
+ eval(as.call(lst))
+}
+
+ds7 <- getH5Dataset(g, "ds_7", inMemory = FALSE)
+ds7M <- getH5Dataset(g, "ds_7", inMemory = TRUE)
+
+TH("random slice", {
+ set.seed(10)
+ system.time({a <- replicate(10000, randomSlice(ds7))})
+ set.seed(10)
+ system.time({b <- replicate(10000, randomSlice(ds7M))})
+ all.equal(a,b)
+})
+
+TH("list attributes, file", {
+ length(listH5Contents(f)) == 15
+})
+
+TH("list attributes, group", {
+ length(listH5Contents(g)) == 12
+})
+
+ds8 <- getH5Dataset(g, "ds_8", inMemory = FALSE)
+
+TH("dim check 1", assertError(ds8[,0:5]))
+TH("dim check 2", assertError(ds8[0,1:5]))
+TH("dim check 3", assertError(ds8[-1,1:5]))
+TH("dim check 4", assertError(ds8[10,1]))
+TH("test 0-vs-1 based", all(ds8[1,1:5] == 1:5))
+
+
+TH("hSlab grab",
+ all(ds8[hSlab(c(1,1), end = c(2,2))] == ds8[1:2, 1:2]) &
+ all(ds8[] == ds8[ hSlab(c(1,1), end = dim(ds8)) ]))
+
+TH("normal time", {
+ all(replicate(10000, {
+ m <- apply(cbind(c(1,1,1), dim(ds7)), 1, function(b) {
+ a <- runif(1, b[1], b[2])
+ floor(c(a, runif(1, a, b[2])))
+ })
+ ds7[m[1,1]:m[2,1],
+ m[1,2]:m[2,2],
+ m[1,3]:m[2,3]]
+ return(TRUE)
+ }))
+})
+
+TH("hSlab time", {
+ all(replicate(10000, {
+ m <- apply(cbind(c(1,1,1), dim(ds7)), 1, function(b) {
+ a <- runif(1, b[1], b[2])
+ floor(c(a, runif(1, a, b[2])))
+ })
+ ds7[hSlab(m[1,], end = m[2,])]
+ return(TRUE)
+ }))
+})
+
+TH("slabs equal", all(readSlab(ds6, 1, 10) == read1DSlabs(ds6, 1, 10)[[1]]))
+TH("slabs equal iteration", {
+ r1 <- read1DSlabs(ds6, 1:10, rep(5, 10))
+ r2 <- lapply(1:10, function(a) {
+ as.integer(readSlab(ds6, a, 5))
+ })
+ all.equal(r1, r2)
+})
+
+
+TH(action = "print")
+TH(action = "throw")
+
Copied: tests/testWrite.R (from rev 64, tests/testwrite.R)
===================================================================
--- tests/testWrite.R (rev 0)
+++ tests/testWrite.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -0,0 +1,77 @@
+require(h5r)
+
+source("tinyTestHarness.R")
+
+##
+## Make a new TestHarness.
+##
+TH <- TestHarness()
+
+fileName <- "testwrite.h5"
+
+TH("file create", { h5 <- H5File(fileName, 'w'); TRUE })
+TH("file remove", { fn <- h5 at fileName; rm(h5) ; gc() ; file.remove(fn); TRUE })
+
+h5 <- H5File(fileName, 'w')
+
+TH("group create 1", { g1 <- createH5Group( h5, "grp1" ); TRUE })
+TH("group create 2", {createH5Group( g1, "grp1-1" ); TRUE })
+TH("group create 3", {createH5Group( g1, "grp1-2" ); TRUE })
+
+TH("group exists 1", all(names(listH5Contents(h5)) == c(".", "grp1", "grp1/grp1-1", "grp1/grp1-2")))
+TH("group delete 1", deleteH5Obj(h5, "grp1/grp1-2"))
+TH("group exists 2", all(names(listH5Contents(h5)) == c(".", "grp1", "grp1/grp1-1")))
+
+TH("dataset exists 1", {
+ d <- createH5Dataset(g1, "d1", dims = c(10, 10), dType = "integer")
+ all(dim(d) == c(10, 10))
+})
+
+TH("dataset write 1", {
+ indta <- as.integer(outer(1:10, 1:10))
+ writeH5Data(d, data = indta, offsets = as.integer(c(1, 1)), extents = as.integer(c(10, 10)))
+ all(d[] == indta)
+
+ mdta <- rbind(as.integer(c(rep(1, 10), rep(2, 10))))
+ writeH5Data(d, data = mdta, offsets = as.integer(c(1, 1)), extents = as.integer(c(2, 10)))
+ indta[1:20] <- mdta
+
+ ## the by-column ordering vs. by-row.
+ all(indta == t(rbind(d[1:2,], d[3:10,])))
+})
+
+TH("string dataset create 1", {
+ d <- createH5Dataset(g1, "d2", z <- as.character(runif(1000)))
+ (all(d[1:10] == z[1:10]) &&
+ all(z[1:10]==unlist(read1DSlabs(d, 1:10, rep(1, 10)))))
+})
+
+TH("string dataset create 2", {
+ d <- createH5Dataset(g1, "d3", z <- cbind(as.character(runif(1000)), as.character(runif(1000))))
+ (all(d[1:2,1] == z[1:2, 1]) && all(z[1:2, 1] == readSlab(d, c(1,1), c(2, 1))))
+})
+
+TH("attribute creation 1", {
+ atr <- createH5Attribute(g1, "jim", 20:1)
+ atr at name == "jim"
+})
+TH("attribute fetch 1", {
+ all(getH5Attribute(g1, "jim")[] == 20:1)
+})
+TH("attribute deletion 1", {
+ deleteH5Attribute(g1, "jim")
+})
+
+TH("attribute creation 2", {
+ atr <- createH5Attribute(g1, "jim", as.character(20:1))
+ atr at name == "jim"
+})
+TH("attribute fetch 2", {
+ all(getH5Attribute(g1, "jim")[] == as.character(20:1))
+})
+TH("attribute deletion 2", {
+ deleteH5Attribute(g1, "jim")
+})
+
+TH(action = 'print')
+
Deleted: tests/testread.R
===================================================================
--- tests/testread.R 2011-08-12 19:01:13 UTC (rev 65)
+++ tests/testread.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -1,235 +0,0 @@
-require(h5r)
-
-source("tinyTestHarness.R")
-
-##
-## Make a new TestHarness.
-##
-TH <- TestHarness()
-
-
-##
-## The tests.
-##
-file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
-
-## ex_1
-f <- H5File(file)
-g <- getH5Group(f, "group_1")
-
-TH("group name", g at name == "group_1")
-
-ds1 <- getH5Dataset(g, "ds_1", inMemory = T)
-
-TH("ds_1 dim, 1", all(dim(ds1) == c(1000, 10)))
-TH("ds_1 dim, 2", all(dim(ds1[1:10, 1:10]) == c(10, 10)))
-TH("ds_1 dim, 3", all(dim(ds1[1:10, ]) == c(10, 10)))
-TH("ds_1 dim, 4", is.null(dim(ds1[, 1])))
-TH("ds_1 dim, 5", assertError(ds1[,1:12]))
-
-## test existence.
-TH("existence, 1", h5DatasetExists(g, "ds_1"))
-TH("existence, 2", h5DatasetExists(g, "ds_232") == FALSE)
-
-## string dataset
-ds2M <- getH5Dataset(g, "ds_2", inMemory = T)
-ds2 <- getH5Dataset(g, "ds_2", inMemory = F)
-
-TH("ds_2 dim, 1", all(ds2[] == ds2M[]))
-TH("ds_2 dim, 2", all(ds2[1:5] == ds2M[1:5]))
-
-## attributes
-a <- getH5Attribute(ds2, "x")
-b <- getH5Attribute(ds2, "y")
-c <- getH5Attribute(ds2, "z")
-
-TH("attribute 1", all(a[] == 1:3))
-TH("attribute 2", all(b[] == rbind(1:3, 5:7)))
-TH("attribute 3", all(c[] == ds2[]))
-
-## > 2 dimensional data.
-ds3M <- getH5Dataset(g, "ds_3", inMemory = T)
-ds3 <- getH5Dataset(g, "ds_3", inMemory = F)
-
-TH("ds_3 dim", all(dim(ds3[,,]) == dim(ds3)) && all(dim(ds3M[,,]) == dim(ds3M)))
-
-## known inconsistency between two.
-TH("In memory inconsistency (!! FIXME !!)", assertError(all(ds3M[] == ds3[])))
-
-## the 3d R object.
-id3 <- ds3M at .data$.data
-
-TH("3d consistency, slabbed", all(id3[,,] == ds3[,,]) &
- all(id3[,1,,drop=TRUE] == ds3[,1,,drop=TRUE]) &
- all(id3[1,1,,drop=TRUE] == ds3[1,1,,drop=TRUE]) &
- all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE]) &
- all(id3[1,,1:3,drop=TRUE] == ds3[1,,1:3,drop=TRUE]))
-
-TH("3d consistency, contiguity",
- all(id3[,2:1,] == ds3[,2:1,]) &
- all(id3[,1,seq(1,9,by=4)] == ds3[,1,seq(1,9,by=4)]) &
- all(id3[3:1,,] == ds3[3:1,,]))
-
-
-TH("3d consistency, memory", all(id3[,,] == ds3M[,,]) &
- all(id3[,1,,drop=TRUE] == ds3M[,1,,drop=TRUE]) &
- all(id3[1,1,,drop=TRUE] == ds3M[1,1,,drop=TRUE]) &
- all(id3[1,,3,drop=TRUE] == ds3M[1,,3,drop=TRUE]))
-
-TH("3d bounds check 1", assertError(ds3[0:10,,]))
-TH("3d bounds check 2", assertError(ds3[,,0:10]))
-TH("3d bounds check 3", assertError(ds3[1,2,1:1000]))
-
-## 2 dimensional string dataset.
-ds4M <- getH5Dataset(g, "ds_4", inMemory = T)
-ds4 <- getH5Dataset(g, "ds_4", inMemory = F)
-
-TH("ds_2 dim", all(dim(ds4[,]) == dim(ds4)) & all(dim(ds4M[,]) == dim(ds4)))
-
-TH("ds_4, memory", (function(n = 100, s = 100) {
- g1 <- gc()[,1]
- a <- replicate(n, {
- replicate(s, getH5Dataset(g, "ds_4", inMemory = FALSE)[1:2,1:2])
- })
- rm(a)
- all(g1 - gc()[,1] <= 0)
-})())
-
-## contiguity problem.
-TH("contiguity", all(ds4M[1, c(2,3,5)] == ds4[1, c(2,3,5)]))
-TH("contiguity - 1D", all(ds2M[c(1, 7, 13)] == ds2[c(1, 7, 13)]))
-
-ds5 <- getH5Dataset(g, "ds_5")
-ds5M <- ds5[]
-
-TH("ds5 contiguity",
- all(ds5[10:1, ] == ds5M[ 10:1, ]) &&
- all(ds5[10:1, 2] == ds5M[ 10:1, 2]) &&
- all(ds5[seq(1, 10, by = 3), 2] == ds5M[ seq(1, 10, by = 3), 2]))
-
-## 5-d object
-ds9M <- getH5Dataset(g, "ds_9", inMemory = T)
-ds9 <- getH5Dataset(g, "ds_9", inMemory = F)
-id9 <- ds9M[,,,,]
-
-TH("5-d 0", all(id9[] == ds9M[,,,,]) && all(id9[] == ds9[]))
-
-TH("5-d",
- all(id9[c(7, 10), c(3, 4), , , ] == ds9[ c(7, 10), c(3, 4), , , ]) &&
- all(id9[c(7, 10), c(3, 4), c(1, 5), , ] == ds9[ c(7, 10), c(3, 4), c(1, 5), , ]) &&
- all(id9[c(7, 10), c(3, 4), 1:5, , ] == ds9[ c(7, 10), c(3, 4), 1:5, , ]) &&
- all(id9[c(7, 10), c(3, 4), , , ] == ds9[ c(7, 10), c(3, 4), , , ]) &&
- all(id9[c(10, 7), 10:1, , , ] == ds9[ c(10, 7), 10:1, , , ]) &&
- all(id9[, , 1:2, 1:2, ] == ds9[ , , 1:2, 1:2, ]) &&
- all(id9[, , 2:1, 2:1, ] == ds9[ , , 2:1, 2:1, ]) &&
- all(id9[ , , , 1:2, 1:2 ] == ds9[ , , , 1:2, 1:2]) &&
- all(id9[1,1,1,1,1] == ds9[1,1,1,1,1]))
-
-
-##
-## More in-depth testing of slicing.
-##
-ds6 <- getH5Dataset(g, "ds_6", inMemory = FALSE)
-ds6M <- getH5Dataset(g, "ds_6", inMemory = TRUE)
-
-TH("ds6, slicing", all(ds6[,] == ds6M[,]) & all(ds6[2:1001] == ds6M[2:1001]))
-
-timeMe <- function(d) {
- k <- 100
- n <- 100
- system.time({
- for (i in seq.int(1, n)) {
- b <- runif(1, 1, nrow(d) - k)
- d[b:(b + k)]
- }
- })[3]
-}
-
-## These are *real* upper-bounds on timing.
-TH("slab selection, timing", (mean(replicate(10, timeMe(ds6))) < 1))
-TH("slab selection, timing -- memory", (mean(replicate(10, timeMe(ds6M))) < 1))
-
-randomSlice <- function(d) {
- dims <- dim(d)
-
- starts <- floor(runif(length(dims), rep(1, length(dims)), dims))
- ends <- starts + floor(rexp(length(dims), 1/4))
- ends <- ifelse(ends > dims, dims, ends)
-
- lst <- as.list(call("[", d))
-
- for (i in 1:length(dims)) {
- lst[[i + 2]] <- starts[i]:ends[i]
- }
- eval(as.call(lst))
-}
-
-ds7 <- getH5Dataset(g, "ds_7", inMemory = FALSE)
-ds7M <- getH5Dataset(g, "ds_7", inMemory = TRUE)
-
-TH("random slice", {
- set.seed(10)
- system.time({a <- replicate(10000, randomSlice(ds7))})
- set.seed(10)
- system.time({b <- replicate(10000, randomSlice(ds7M))})
- all.equal(a,b)
-})
-
-TH("list attributes, file", {
- length(listH5Contents(f)) == 15
-})
-
-TH("list attributes, group", {
- length(listH5Contents(g)) == 12
-})
-
-ds8 <- getH5Dataset(g, "ds_8", inMemory = FALSE)
-
-TH("dim check 1", assertError(ds8[,0:5]))
-TH("dim check 2", assertError(ds8[0,1:5]))
-TH("dim check 3", assertError(ds8[-1,1:5]))
-TH("dim check 4", assertError(ds8[10,1]))
-TH("test 0-vs-1 based", all(ds8[1,1:5] == 1:5))
-
-
-TH("hSlab grab",
- all(ds8[hSlab(c(1,1), end = c(2,2))] == ds8[1:2, 1:2]) &
- all(ds8[] == ds8[ hSlab(c(1,1), end = dim(ds8)) ]))
-
-TH("normal time", {
- all(replicate(10000, {
- m <- apply(cbind(c(1,1,1), dim(ds7)), 1, function(b) {
- a <- runif(1, b[1], b[2])
- floor(c(a, runif(1, a, b[2])))
- })
- ds7[m[1,1]:m[2,1],
- m[1,2]:m[2,2],
- m[1,3]:m[2,3]]
- return(TRUE)
- }))
-})
-
-TH("hSlab time", {
- all(replicate(10000, {
- m <- apply(cbind(c(1,1,1), dim(ds7)), 1, function(b) {
- a <- runif(1, b[1], b[2])
- floor(c(a, runif(1, a, b[2])))
- })
- ds7[hSlab(m[1,], end = m[2,])]
- return(TRUE)
- }))
-})
-
-TH("slabs equal", all(readSlab(ds6, 1, 10) == read1DSlabs(ds6, 1, 10)[[1]]))
-TH("slabs equal iteration", {
- r1 <- read1DSlabs(ds6, 1:10, rep(5, 10))
- r2 <- lapply(1:10, function(a) {
- as.integer(readSlab(ds6, a, 5))
- })
- all.equal(r1, r2)
-})
-
-
-TH(action = "print")
-TH(action = "throw")
-
Deleted: tests/testwrite.R
===================================================================
--- tests/testwrite.R 2011-08-12 19:01:13 UTC (rev 65)
+++ tests/testwrite.R 2011-09-15 00:41:24 UTC (rev 66)
@@ -1,77 +0,0 @@
-require(h5r)
-
-source("tinyTestHarness.R")
-
-##
-## Make a new TestHarness.
-##
-TH <- TestHarness()
-
-fileName <- "test.h5"
-
-TH("file create", { h5 <- H5File(fileName, 'w'); TRUE })
-TH("file remove", { fn <- h5 at fileName; rm(h5) ; gc() ; file.remove(fn); TRUE })
-
-h5 <- H5File(fileName, 'w')
-
-TH("group create 1", { g1 <- createH5Group( h5, "grp1" ); TRUE })
-TH("group create 2", {createH5Group( g1, "grp1-1" ); TRUE })
-TH("group create 3", {createH5Group( g1, "grp1-2" ); TRUE })
-
-TH("group exists 1", all(names(listH5Contents(h5)) == c(".", "grp1", "grp1/grp1-1", "grp1/grp1-2")))
-TH("group delete 1", deleteH5Obj(h5, "grp1/grp1-2"))
-TH("group exists 2", all(names(listH5Contents(h5)) == c(".", "grp1", "grp1/grp1-1")))
-
-TH("dataset exists 1", {
- d <- createH5Dataset(g1, "d1", dims = c(10, 10), dType = "integer")
- all(dim(d) == c(10, 10))
-})
-
-TH("dataset write 1", {
- indta <- as.integer(outer(1:10, 1:10))
- writeH5Data(d, data = indta, offsets = as.integer(c(1, 1)), extents = as.integer(c(10, 10)))
- all(d[] == indta)
-
- mdta <- rbind(as.integer(c(rep(1, 10), rep(2, 10))))
- writeH5Data(d, data = mdta, offsets = as.integer(c(1, 1)), extents = as.integer(c(2, 10)))
- indta[1:20] <- mdta
-
- ## the by-column ordering vs. by-row.
- all(indta == t(rbind(d[1:2,], d[3:10,])))
-})
-
-TH("string dataset create 1", {
- d <- createH5Dataset(g1, "d2", z <- as.character(runif(1000)))
- (all(d[1:10] == z[1:10]) &&
- all(z[1:10]==unlist(read1DSlabs(d, 1:10, rep(1, 10)))))
-})
-
-TH("string dataset create 2", {
- d <- createH5Dataset(g1, "d3", z <- cbind(as.character(runif(1000)), as.character(runif(1000))))
- (all(d[1:2,1] == z[1:2, 1]) && all(z[1:2, 1] == readSlab(d, c(1,1), c(2, 1))))
-})
-
-TH("attribute creation 1", {
- atr <- createH5Attribute(g1, "jim", 20:1)
- atr at name == "jim"
-})
-TH("attribute fetch 1", {
- all(getH5Attribute(g1, "jim")[] == 20:1)
-})
-TH("attribute deletion 1", {
- deleteH5Attribute(g1, "jim")
-})
-
-TH("attribute creation 2", {
- atr <- createH5Attribute(g1, "jim", as.character(20:1))
- atr at name == "jim"
-})
-TH("attribute fetch 2", {
- all(getH5Attribute(g1, "jim")[] == as.character(20:1))
-})
-TH("attribute deletion 2", {
- deleteH5Attribute(g1, "jim")
-})
-
-TH(action = 'print')
-
More information about the H5r-commits
mailing list