tests/testthat/test-zero_lengths.R

In ff: Memory-Efficient Storage of Large Data on Disk and Fast Access Functions

library("testthat")
library("ff")

# expect_identical <- function(x, y, ...){
#   stopifnot(identical(x,y))
# }

is_not_macos <- function(){Sys.info()["sysname"] != 'Darwin'}

context("ff-zero-lengths")

test_that("file size is correct  when creating ff integer from scratch", {
  a0 <- ff(length=0, vmode="integer")
  f0 <- filename(a0)
  expect_true(file.exists(f0))
  expect_null(names(a0))
  names(a0) <- character(0)
  expect_identical(names(a0), character(0))
  a1 <- ff(length=1, vmode="integer")
  f1 <- filename(a1)
  expect_true(file.exists(f1))
  names(a1) <- "1"
  expect_equal(file.size(filename(a0)), 0)
  expect_equal(file.size(filename(a1)), 4)
  length(a0) <- 1
  length(a1) <- 0
  expect_equal(file.size(filename(a0)), 4)
  expect_equal(file.size(filename(a1)), 0)
  expect_identical(names(a0), "1")
  expect_identical(names(a1), character(0))
  rm(a0)
  rm(a1)
  expect_true(file.exists(f0))
  expect_true(file.exists(f1))
  gc()
  if (is_not_macos()){
    expect_false(file.exists(f0))
    expect_false(file.exists(f1))
  }
  rm(f0,f1)
})

test_that("file size is correct  when creating ff quad from scratch", {
  a0 <- ff(length=0, vmode="quad")
  f0 <- filename(a0)
  expect_true(file.exists(f0))
  expect_null(names(a0))
  names(a0) <- character(0)
  expect_identical(names(a0), character(0))
  a1 <- ff(length=1, vmode="quad")
  f1 <- filename(a1)
  expect_true(file.exists(f1))
  names(a1) <- "1"
  expect_equal(file.size(filename(a0)), 0)
  expect_equal(file.size(filename(a1)), 4)
  length(a0) <- 1
  length(a1) <- 0
  expect_equal(file.size(filename(a0)), 4)
  expect_equal(file.size(filename(a1)), 0)
  expect_identical(names(a0), "1")
  expect_identical(names(a1), character(0))
  rm(a0)
  rm(a1)
  expect_true(file.exists(f0))
  expect_true(file.exists(f1))
  gc()
  if (is_not_macos()){
    expect_false(file.exists(f0))
    expect_false(file.exists(f1))
  }
  rm(f0,f1)
})


test_that("file size is correct when creating ff integer from existing file", {
  a0 <- ff(length=0, vmode="integer", pattern="ff", finalizer="close")
  b0 <- ff(vmode="integer", filename=filename(a0), pattern="ff", finalizer="close")
  expect_identical(physical(a0),physical(b0))
  expect_identical(virtual(a0),virtual(b0))
  a1 <- ff(length=1, vmode="integer", pattern="ff", finalizer="close")
  b1 <- ff(vmode="integer", filename=filename(a1), pattern="ff", finalizer="close")
  expect_identical(physical(a1),physical(b1))
  expect_identical(virtual(a1),virtual(b1))
  f0 <- filename(a0)
  f1 <- filename(a1)
  expect_equal(file.size(f1), 4)
  close(b0)
  close(b1)
  delete(a0)
  delete(a1)
  rm(a0,b0,a1,b1)
  expect_false(file.exists(f0))
  expect_false(file.exists(f1))
  gc()
  if (is_not_macos()){
    expect_false(file.exists(f0))
    expect_false(file.exists(f1))
  }
  rm(f0,f1)
})


test_that("file size is correct when creating ff quad from existing file", {
  a0 <- ff(length=0, vmode="quad", pattern="ff", finalizer="close")
  b0 <- ff(vmode="quad", filename=filename(a0), pattern="ff", finalizer="close")
  expect_identical(physical(a0),physical(b0))
  expect_identical(virtual(a0),virtual(b0))
  a1 <- ff(length=1, vmode="quad", pattern="ff", finalizer="close")
  b1 <- ff(vmode="quad", filename=filename(a1), pattern="ff", finalizer="close")
  # note that quads are internally 32-bit-integers 
  # and hence quad-files are multiples of 32-bits 
  # and hence reading quad files reads multiples of 16 quads
  expect_identical(length(b1), 16L)
  # only after correcting the length to 1 we a1 and b1 are identical ff objects
  length(b1) <- 1
  expect_identical(physical(a1),physical(b1))
  expect_identical(virtual(a1),virtual(b1))
  f0 <- filename(a0)
  f1 <- filename(a1)
  expect_equal(file.size(f1), 4)
  close(b0)
  close(b1)
  delete(a0)
  delete(a1)
  rm(a0,b0,a1,b1)
  expect_false(file.exists(f0))
  expect_false(file.exists(f1))
  gc()
  if (is_not_macos()){
    expect_false(file.exists(f0))
    expect_false(file.exists(f1))
  }
  rm(f0,f1)
})


test_that("length changes are correct for ff integer", {
  a1 <- ff(length=1, vmode="integer", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="integer", pattern="ff", finalizer="close")
  f0 <- filename(a0)
  f1 <- filename(a1)
  r1 <- a1[]
  r0 <- a0[]
  a1[1] <- 1L
  r1[1] <- 1L
  n <- 64
  length(a1) <- n
  length(a0) <- n
  length(r1) <- n
  length(r0) <- n
  r1[is.na(r1)] <- 0L
  r0[is.na(r0)] <- 0L
  expect_equal(file.size(f1), n*4)
  expect_equal(file.size(f0), n*4)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  
  a1[] <- n:1
  a0[] <- n:1
  r1[] <- n:1
  r0[] <- n:1
  n <- 3
  length(a1) <- n
  length(a0) <- 0
  length(r1) <- n
  length(r0) <- 0
  expect_equal(file.size(f1), n*4)
  expect_equal(file.size(f0), 0)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  
  rm(n)
  rm(a0,a1)
  rm(r0,r1)
  rm(f0,f1)
  gc()
})


test_that("length changes are correct for ff quad", {
  a1 <- ff(length=1, vmode="quad", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="quad", pattern="ff", finalizer="close")
  f0 <- filename(a0)
  f1 <- filename(a1)
  r1 <- a1[]
  r0 <- a0[]
  a1[1] <- 1L
  r1[1] <- 1L
  n <- 63
  length(a1) <- n
  length(a0) <- n
  r1 <- as.quad(c(1, rep(0, n-1)))
  r0 <- quad(n)
  expect_equal(file.size(f1), ceiling(n/16)*4)
  expect_equal(file.size(f0), ceiling(n/16)*4)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  a1[] <- 1L  # we write hidden values beyond the future vector size
  a0[] <- 1L  # we write hidden values beyond the future vector size
  length(a1) <- 1 # hopefully the hidden values are removed
  length(a0) <- 0 # hopefully the hidden values are removed
  r1 <- as.quad(1)
  r0 <- quad(0)
  expect_equal(file.size(f1), 4)
  expect_equal(file.size(f0), 0)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)

  n <- 16
  length(a1) <- n
  length(a0) <- n
  r1 <- as.quad(c(1, rep(0, n-1)))
  r0 <- quad(n)
  expect_equal(file.size(f1), ceiling(n/16)*4) 
  expect_equal(file.size(f0), ceiling(n/16)*4)
  expect_equal(a1[], r1) # hopefully the hidden values are removed
  expect_equal(a0[], r0) # hopefully the hidden values are removed
  
  rm(n)
  rm(a0,a1)
  rm(r0,r1)
  rm(f0,f1)
  gc()
})



test_that("length changes are correct for named ff integer", {
  a1 <- ff(length=1, vmode="integer", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="integer", pattern="ff", finalizer="close")
  f0 <- filename(a0)
  f1 <- filename(a1)
  names(a1) <- "a"
  names(a0) <- character()
  expect_equal(names(a1), "a")
  expect_equal(names(a0), character())
  
  r1 <- a1[]
  r0 <- a0[]
  expect_equal(names(a1), names(r1))
  expect_equal(names(a0), names(r0))

  n <- 64  
  a1[1] <- 1L
  r1[1] <- 1L
  length(a1) <- n
  length(a0) <- n
  length(r1) <- n
  length(r0) <- n
  names(r1)[2:n] <- 2:n
  names(r0)[1:n] <- 1:n
  expect_equal(file.size(f1), n*4)
  expect_equal(file.size(f0), n*4)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  
  a1[] <- n:1
  a0[] <- n:1
  r1[] <- n:1
  r0[] <- n:1
  n <- 3
  length(a1) <- n
  length(a0) <- 0
  length(r1) <- n
  length(r0) <- 0
  expect_equal(file.size(f1), n*4)
  expect_equal(file.size(f0), 0)
  
  rm(n)
  rm(a0,a1)
  rm(r0,r1)
  rm(f0,f1)
  gc()
})


test_that("length changes are correct for named ff quad", {
  a1 <- ff(length=1, vmode="quad", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="quad", pattern="ff", finalizer="close")
  f0 <- filename(a0)
  f1 <- filename(a1)
  
  names(a1) <- "a"
  names(a0) <- character()
  expect_equal(names(a1), "a")
  expect_equal(names(a0), character())
  
  r1 <- a1[]
  r0 <- a0[]
  expect_equal(names(a1), names(r1))
  expect_equal(names(a0), names(r0))
  
  a1[1] <- 1L
  n <- 63
  length(a1) <- n
  length(a0) <- n
  r1 <- as.quad(c(1, rep(0, n-1)))
  r0 <- quad(n)
  names(r1) <- c("a",2:n)
  names(r0) <- 1:n
  expect_equal(file.size(f1), ceiling(n/16)*4)
  expect_equal(file.size(f0), ceiling(n/16)*4)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  a1[] <- 1L  # we write hidden values beyond the future vector size
  a0[] <- 1L  # we write hidden values beyond the future vector size
  length(a1) <- 1 # hopefully the hidden values are removed
  length(a0) <- 0 # hopefully the hidden values are removed
  r1 <- as.quad(1)
  r0 <- quad(0)
  names(r1) <- c("a")
  names(r0) <- character()
  expect_equal(file.size(f1), 4)
  expect_equal(file.size(f0), 0)
  expect_equal(a1[], r1)
  expect_equal(a0[], r0)
  
  n <- 16
  length(a1) <- n
  length(a0) <- n
  r1 <- as.quad(c(1, rep(0, n-1)))
  r0 <- quad(n)
  names(r1) <- c("a", 2:n)
  names(r0) <- 1:n
  expect_equal(file.size(f1), ceiling(n/16)*4) 
  expect_equal(file.size(f0), ceiling(n/16)*4)
  expect_equal(a1[], r1) # hopefully the hidden values are removed
  expect_equal(a0[], r0) # hopefully the hidden values are removed
  
  rm(n)
  rm(a0,a1)
  rm(r0,r1)
  rm(f0,f1)
  gc()
})




test_that("get, set and getset are correct when accessing zero and one file length", {
  a1 <- ff(length=1, vmode="quad", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="quad", pattern="ff", finalizer="close")
  
  expect_identical(get.ff(a1, integer()), quad(0))
  expect_identical(get.ff(a0, integer()), quad(0))
  
  expect_identical(get.ff(a1, 1), quad(1))
  expect_error(get.ff(a1, 2), "illegal index")
  expect_error(get.ff(a0, 1), "illegal index")
  
  expect_silent(set.ff(a1, 1, 2))
  expect_identical(get.ff(a1, 1), as.quad(2))
  expect_silent(set.ff(a1, 1, 2, add=TRUE))
  expect_identical(get.ff(a1, 1), as.quad(0))
  expect_identical(getset.ff(a1, 1, 2), as.quad(0))
  expect_identical(get.ff(a1, 1), as.quad(2))
  expect_identical(getset.ff(a1, 1, 2, add=2), as.quad(0))
  expect_identical(get.ff(a1, 1), as.quad(0))
  
  expect_error(set.ff(a0, 1, 2), "illegal index")
  expect_error(set.ff(a0, 1, 2, add=TRUE), "illegal index")
  expect_error(getset.ff(a0, 1, 2), "illegal index")
  expect_error(getset.ff(a0, 1, 2, add=TRUE), "illegal index")

  rm(a1,a0)
  gc()
})

test_that("read, write and readwrite are correct when accessing zero and one file length", {
  a1 <- ff(length=1, vmode="quad", pattern="ff", finalizer="close")
  a0 <- ff(length=0, vmode="quad", pattern="ff", finalizer="close")

  expect_identical(read.ff(a1,1,0), quad(0))
  expect_identical(read.ff(a0,1,0), quad(0))

  expect_error(read.ff(a1,0,0), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(read.ff(a0,0,0), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  expect_error(read.ff(a1,0,1), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(read.ff(a0,0,1), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  expect_error(read.ff(a1,0,2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(read.ff(a0,0,2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  expect_error(read.ff(a1,2,2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(read.ff(a0,1,2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  expect_error(read.ff(a1,3,0), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(read.ff(a0,2,0), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  expect_silent(write.ff(a1, 1, 2))
  expect_identical(read.ff(a1, 1, 1), as.quad(2))
  expect_silent(write.ff(a1, 1, 2, add=TRUE))
  expect_identical(read.ff(a1, 1, 1), as.quad(0))
  expect_identical(readwrite.ff(a1, 1, 2), as.quad(0))
  expect_identical(read.ff(a1, 1, 1), as.quad(2))
  expect_identical(readwrite.ff(a1, 1, 2, add=TRUE), as.quad(0))
  expect_identical(read.ff(a1, 1, 1), as.quad(0))

  expect_error(write.ff(a0, 1, 2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(write.ff(a0, 1, 2, add=TRUE), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(readwrite.ff(a0, 1, 2), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  expect_error(readwrite.ff(a0, 1, 2, add=TRUE), "0 < i && i [+] n [-] 1 [<][=] length[(]x[)] is not TRUE")
  
  rm(a1,a0)
  gc()
})


test_that("[[, [[<-, add and swap are correct when accessing zero and one file length", {
  r1 <- quad(1)
  r0 <- quad(0)
  names(r1) <- "a"
  names(r0) <- character()
  
  f1 <- ff(r1, pattern="ff", finalizer="close")
  f0 <- ff(r0, pattern="ff", finalizer="close")
  
  expect_error(f1[[]], 'argument "i" is missing, with no default')
  expect_error(f0[[]], 'argument "i" is missing, with no default')
  expect_error(f1[[]]<-1, 'argument "i" is missing, with no default')
  expect_error(f0[[]]<-1, 'argument "i" is missing, with no default')
  
  expect_error(f1[[integer()]], "i must have length 1")
  expect_error(f0[[integer()]], "i must have length 1")
  expect_error(f1[[integer()]]<-1, "i must have length 1")
  expect_error(f0[[integer()]]<-1, "i must have length 1")
  
  expect_error(f1[[2]], "illegal index")
  expect_identical(f1[[1]], quad(1))
  expect_error(f1[[0]], "illegal index")
  expect_error(f1[[NA]], "illegal index")
  expect_error(f1[[-1]], "illegal index")
  expect_error(f1[[-2]], "illegal index")

  expect_error(f1[[2]]<-1, "illegal index")
  expect_silent(f1[[1]]<-1)
  expect_identical(f1[[1]], as.quad(1))
  expect_silent(f1[[1]]<-4)
  expect_identical(f1[[1]], as.quad(0))
  expect_silent(f1[[1,add=TRUE]]<-2)
  expect_identical(f1[[1]], as.quad(2))
  expect_silent(f1[[1,add=TRUE]]<-2)
  expect_identical(f1[[1]], as.quad(0))
  expect_error(f1[[0]]<-1, "illegal index")
  expect_error(f1[[NA]]<-1, "illegal index")
  expect_error(f1[[-1]]<-1, "illegal index")
  expect_error(f1[[-2]]<-1, "illegal index")
  
  expect_error(f0[[2]], "illegal index")
  expect_error(f0[[1]], "illegal index")
  expect_error(f0[[0]], "illegal index")
  expect_error(f0[[NA]], "illegal index")
  expect_error(f0[[-1]], "illegal index")
  expect_error(f0[[-2]], "illegal index")

  expect_error(f0[[2]]<-1, "illegal index")
  expect_error(f0[[1]]<-1, "illegal index")
  expect_error(f0[[0]]<-1, "illegal index")
  expect_error(f0[[NA]]<-1, "illegal index")
  expect_error(f0[[-1]]<-1, "illegal index")
  expect_error(f0[[-2]]<-1, "illegal index")
    
  rm(r1,r0)
  rm(f1,f0)
  gc()
})



test_that("[ and [<- are correct when accessing zero and one file length", {
  r1 <- quad(1)
  r0 <- quad(0)
  names(r1) <- "a"
  names(r0) <- character()
  f1 <- as.ff(r1, pattern="ff", finalizer="close")
  f0 <- as.ff(r0, pattern="ff", finalizer="close")
  expect_identical(names(f1[]), names(r1))
  expect_identical(names(f0[]), names(r0))
  expect_identical(pattern(f1), "ff")
  expect_identical(pattern(f0), "ff")
  expect_identical(finalizer(f1), "close")
  expect_identical(finalizer(f0), "close")
  expect_identical(f1[], r1)
  expect_identical(f0[], r0)

  expect_identical(f1[,pack=TRUE], r1)
  expect_identical(f0[,pack=TRUE], r0)

  expect_identical(f1[integer()], r0)
  expect_identical(f0[integer()], r0)
  expect_identical(f1[integer(),pack=TRUE], r0)
  expect_identical(f0[integer(),pack=TRUE], r0)
  expect_silent(f1[integer()]<-1)
  expect_silent(f0[integer()]<-1)
  expect_identical(f1[], r1)
  expect_identical(f0[], r0)
  expect_silent(f1[integer()]<-1)
  expect_silent(f0[integer()]<-1)
  expect_identical(f1[], r1)
  expect_identical(f0[], r0)
  expect_silent(f1[integer(), add=TRUE]<-1)
  expect_silent(f0[integer(), add=TRUE]<-1)
  expect_identical(f1[], r1)
  expect_identical(f0[], r0)

  expect_error(f1[2], "positive subscripts out of range")
  expect_identical(f1[1], r1)
  expect_identical(f1[1,pack=TRUE], r1)
  expect_error(f1[0], "0s and mixed positive/negative subscripts not allowed")
  expect_identical(f1[-1], r0)
  expect_identical(f1[-1, pack=TRUE], r0)
  expect_error(f1[-2], "negative subscripts out of range")
  expect_error(f1[-2, pack=TRUE], "negative subscripts out of range")

  expect_error(f1[2]<-1, "positive subscripts out of range")
  expect_silent(f1[1]<-2)
  expect_identical(f1[1], r1+2L)
  expect_silent(f1[1]<-4)
  expect_identical(f1[1], r1)
  expect_silent(f1[1, add=TRUE]<-2)
  expect_identical(f1[1], r1+2L)
  expect_silent(f1[1, add=TRUE]<-2)
  expect_identical(f1[1], r1)
  expect_error(f1[0]<-1, "0s and mixed positive/negative subscripts not allowed")
  expect_silent(f1[-1]<-1)
  expect_identical(f1[], r1)
  expect_error(f1[-2]<-1, "negative subscripts out of range")
  
  expect_error(f0[2], "positive subscripts out of range")
  expect_error(f0[1], "positive subscripts out of range")
  expect_error(f0[0], "0s and mixed positive/negative subscripts not allowed")
  expect_error(f0[-1], "negative subscripts out of range")
  expect_error(f0[-2], "negative subscripts out of range")

  expect_error(f0[2,pack=TRUE], "positive subscripts out of range")
  expect_error(f0[1,pack=TRUE], "positive subscripts out of range")
  expect_error(f0[0,pack=TRUE], "0s and mixed positive/negative subscripts not allowed")
  expect_error(f0[-1,pack=TRUE], "negative subscripts out of range")
  expect_error(f0[-2,pack=TRUE], "negative subscripts out of range")

  expect_error(f0[2]<-1, "positive subscripts out of range")
  expect_error(f0[1]<-1, "positive subscripts out of range")
  expect_error(f0[0]<-1, "0s and mixed positive/negative subscripts not allowed")
  expect_error(f0[-1]<-1, "negative subscripts out of range")
  expect_error(f0[-2]<-1, "negative subscripts out of range")

  expect_error(f0[2,add=TRUE]<-1, "positive subscripts out of range")
  expect_error(f0[1,add=TRUE]<-1, "positive subscripts out of range")
  expect_error(f0[0,add=TRUE]<-1, "0s and mixed positive/negative subscripts not allowed")
  expect_error(f0[-1,add=TRUE]<-1, "negative subscripts out of range")
  expect_error(f0[-2,add=TRUE]<-1, "negative subscripts out of range")

  rm(r1,r0)
  rm(f1,f0)
  gc()
})


test_that("swap are correct when accessing zero and four file length", {
  r4 <- quad(4)
  r3 <- quad(3)
  r2 <- quad(2)
  r1 <- quad(1)
  r0 <- quad(0)
  names(r4)<- letters[1:4]
  names(r3) <- letters[1:3]
  names(r2) <- letters[1:2]
  names(r1) <- letters[1]
  names(r0) <- character()
  f4 <- as.ff(r4, pattern="ff", finalizer="close")
  f0 <- as.ff(r0, pattern="ff", finalizer="close")
  expect_identical(names(f4[]), names(r4))
  expect_identical(names(f0[]), names(r0))
  expect_identical(pattern(f4), "ff")
  expect_identical(pattern(f0), "ff")
  expect_identical(finalizer(f4), "close")
  expect_identical(finalizer(f0), "close")
  expect_identical(f4[], r4)
  expect_identical(f0[], r0)
  
  # -- first we do some checks for 4 elements
  expect_silent(ram <- f4[])
  expect_identical(swap(ram, 2L), r4)
  expect_identical(ram, r4+2L)
  expect_identical(swap(f4, 2L), r4)
  expect_identical(f4[], r4+2L)
  
  expect_identical(swap(ram, 4L, 1), r4[1]+2L)
  expect_identical(ram, r4+c(4L,2L,2L,2L))
  expect_identical(swap(f4, 4L, 1), r1+2L)
  expect_identical(f4[], r4+c(0L,2L,2L,2L))
  
  expect_identical(swap(ram, 1L, integer()), r4[integer()])
  expect_identical(ram, r4+c(4L,2L,2L,2L))
  expect_identical(swap(f4, 1L, integer()), r0)
  
  expect_identical(swap(ram, 1L, 0), r4[integer()])
  expect_identical(ram, r4+c(4L,2L,2L,2L))
  expect_error(swap(f4, 1L, 0), "0s and mixed positive/negative subscripts not allowed")
  expect_error(swap(f4, 1L, -5), "negative subscripts out of range")
  expect_error(swap(f4, 1L, 5), "positive subscripts out of range")
  
  f4[] <- 0L
  ram <- f4[]
  expect_identical(swap(ram, 1L, -(3:4)), r4[-(3:4)])
  expect_identical(ram, r4+c(1L,1L,0L,0L))
  expect_identical(swap(f4, 1L, -(3:4)), r2)
  expect_identical(f4[], r4+c(1L,1L,0L,0L))

  f4[] <- 0L
  expect_silent(swap(f4,5L))
  expect_identical(f4[], r4+1L)
  expect_silent(swap(f4,-1L))
  expect_identical(f4[], r4+3L)
  
  f4[] <- 0:3
  expect_identical(swap(f4,1L,add=TRUE), r4+c(1:3,0L))
  expect_identical(f4[], r4+c(1:3,0L))
  expect_identical(swap(f4,-1L,add=TRUE), r4+0:3)
  expect_identical(f4[], r4+0:3)
  

  # -- now we do similar for 0 elements
  expect_silent(ram <- f0[])
  expect_identical(swap(ram, 2L), r0)
  expect_identical(ram, r0)
  expect_identical(swap(f0, 2L), r0)
  expect_identical(f0[], r0)
  
  expect_true(is.na(swap(ram, 4L, 1)))  # assigns to new position
  expect_identical(ram, structure(4L, .Names = "", vmode = "quad"))  # now ram is longer than before
  ram <- f0[]
  expect_error(swap(f0, 4L, 1), "positive subscripts out of range")
  expect_identical(f0[], r0)
  
  expect_identical(swap(ram, 1L, integer()), r0[integer()])
  expect_identical(ram, r0)
  expect_identical(swap(f0, 1L, integer()), r0)
  
  expect_identical(swap(ram, 1L, 0), r0[integer()])
  expect_identical(ram, r0)
  expect_error(swap(f0, 1L, 0), "0s and mixed positive/negative subscripts not allowed")
  expect_error(swap(f0, 1L, -5), "negative subscripts out of range")
  expect_error(swap(f0, 1L, 5), "positive subscripts out of range")
  
  f0[] <- 0L
  ram <- f0[]
  expect_identical(swap(ram, 1L, -(3:4)), r0[-(3:4)])
  expect_identical(ram, r0)
  expect_error(swap(f0, 1L, -(3:4)), "negative subscripts out of range")
  expect_identical(f0[], r0)
  
  f0[] <- 0L
  expect_silent(swap(f0,5L))
  expect_identical(f0[], r0)
  expect_silent(swap(f0,-1L))
  expect_identical(f0[], r0)
  
  f0[] <- 0L
  expect_identical(swap(f0,1L,add=TRUE), r0)
  expect_identical(f0[], r0)
  expect_identical(swap(f0,-1L,add=TRUE), r0)
  expect_identical(f0[], r0)
    
  rm(r0,r1,r2,r3,r4)
  rm(f4)
  gc()
})



test_that("add is correct when accessing zero and four file length", {
  r4 <- quad(4)
  r3 <- quad(3)
  r2 <- quad(2)
  r1 <- quad(1)
  r0 <- quad(0)
  names(r4)<- letters[1:4]
  names(r3) <- letters[1:3]
  names(r2) <- letters[1:2]
  names(r1) <- letters[1]
  names(r0) <- character()
  f4 <- as.ff(r4, pattern="ff", finalizer="close")
  f0 <- as.ff(r0, pattern="ff", finalizer="close")
  expect_identical(names(f4[]), names(r4))
  expect_identical(names(f0[]), names(r0))
  expect_identical(pattern(f4), "ff")
  expect_identical(pattern(f0), "ff")
  expect_identical(finalizer(f4), "close")
  expect_identical(finalizer(f0), "close")
  expect_identical(f4[], r4)
  expect_identical(f0[], r0)
  
  # -- first we do some checks for 4 elements
  expect_silent(f4[] <- 0)
  expect_silent(ram <- f4[])
  expect_silent(add(ram, 1L))
  expect_identical(ram, r4+1L)
  expect_silent(add(f4, 1))
  expect_identical(f4[], r4+1L)
  
  expect_silent(f4[] <- 0)
  expect_silent(ram <- f4[])
  expect_silent(add(ram, 1:2))
  expect_identical(ram, r4+1:2)
  expect_silent(add(f4, 1:2))
  expect_identical(f4[], r4+1:2)
  
  expect_silent(f4[] <- 0)
  expect_silent(ram <- f4[])
  expect_warning(add(ram, 1:3), "longer object length is not a multiple of shorter object length")
  expect_identical(ram, r4+c(1:3,1L))
  expect_warning(add(f4, 1:3), "number of elements to replace is not multiple of values for replacement")
  expect_identical(f4[], r4+c(1:3,1L))
  
  expect_silent(f4[] <- 0)
  expect_silent(ram <- f4[])
  expect_warning(add(ram, 0:7), "number of items to replace is not a multiple of replacement length")
  expect_identical(ram, r4+0:3)
  expect_warning(add(f4, 0:7), "number of elements to replace is not multiple of values for replacement")
  expect_identical(f4[], r4+0:3)
  
  expect_warning(add(ram, -(0:7)), "number of items to replace is not a multiple of replacement length")
  expect_identical(ram, r4)
  expect_silent(add(f4, -(4:7))) # wrap-sround maps to -(0:3)
  expect_identical(f4[], r4)
  
  # -- now we do similar for 0 elements
  expect_silent(ram <- f0[])
  expect_silent(add(ram, 1L))
  expect_identical(ram, r0)
  expect_silent(add(f0, 1))
  expect_identical(f0[], r0)
  
  expect_silent(ram <- f0[])
  expect_silent(add(ram, 1:2))
  expect_identical(ram, r0)
  expect_silent(add(f0, 1:2))
  expect_identical(f0[], r0)
  

  rm(r0,r1,r2,r3,r4)
  rm(f4)
  gc()
})



test_that("zero length ff can be cloned", {
  expect_silent(a1 <- ff(length=1, vmode="integer", pattern="ff"))
  expect_silent(a0 <- ff(length=0, vmode="integer", pattern="ff"))
  
  expect_silent(b1 <- ff(a1))
  expect_silent(b0 <- ff(a0))
  
  expect_silent(c1 <- clone(a1))
  expect_silent(c0 <- clone(a0))
  
  expect_identical(a1[], b1[])
  expect_identical(a0[], b0[])
  
  expect_identical(a1[], c1[])
  expect_identical(a0[], c0[])
  
  rm(a0,a1)
  rm(b0,b1)
  rm(c0,c1)
  gc()
})




test_that("lots of stuff related to dims work", {
  
  vm <- "quad"
  
  expect_silent(r <- as.vmode(integer(), vmode=vm))
  
  expect_silent(r0 <- as.vmode(integer(0), vmode=vm))
  expect_silent(r1 <- as.vmode(integer(1), vmode=vm))
  
  expect_silent(r00 <- as.vmode(integer( 0), vmode=vm))
  expect_silent(r01 <- as.vmode(integer( 0), vmode=vm))
  expect_silent(r10 <- as.vmode(integer( 0), vmode=vm))
  expect_silent(r11 <- as.vmode(integer( 1), vmode=vm))
  expect_silent(r09 <- as.vmode(integer( 0), vmode=vm))
  expect_silent(r19 <- as.vmode(integer( 9), vmode=vm))
  expect_silent(r90 <- as.vmode(integer( 0), vmode=vm))
  expect_silent(r91 <- as.vmode(integer( 9), vmode=vm))
  expect_silent(r99 <- as.vmode(integer(81), vmode=vm))
  
  expect_error(dim(r) <- integer())
  
  expect_silent(dim(r) <- NULL)
  
  expect_silent(dim(r0) <- 0L)
  expect_silent(dim(r1) <- 1L)
  
  expect_silent(dim(r00) <- c(0L,0L))
  expect_silent(dim(r01) <- c(0L,1L))
  expect_silent(dim(r10) <- c(1L,0L))
  expect_silent(dim(r11) <- c(1L,1L))
  expect_silent(dim(r09) <- c(0L,9L))
  expect_silent(dim(r19) <- c(1L,9L))
  expect_silent(dim(r90) <- c(9L,0L))
  expect_silent(dim(r91) <- c(9L,1L))
  expect_silent(dim(r99) <- c(9L,9L))
  
  expect_silent(d <- NULL)

  expect_silent(d0 <- list(character()))
  expect_silent(d1 <- list(LETTERS[1]))
  
  expect_silent(d00 <- list(character(), character()))
  expect_silent(d01 <- list(character(), letters[1]))
  expect_silent(d10 <- list(LETTERS[1], character()))
  expect_silent(d11 <- list(LETTERS[1], letters[1]))
  expect_silent(d09 <- list(character(), letters[1:9]))
  expect_silent(d19 <- list(LETTERS[1], letters[1:9]))
  expect_silent(d90 <- list(LETTERS[1:9], character()))
  expect_silent(d91 <- list(LETTERS[1:9], letters[1]))
  expect_silent(d99 <- list(LETTERS[1:9], letters[1:9]))
  
  
  expect_silent(dimnames(r) <- d)
  
  expect_silent(dimnames(r0) <- d0)
  expect_silent(dimnames(r1) <- d1)
  
  expect_silent(dimnames(r00) <- d00)
  expect_silent(dimnames(r01) <- d01)
  expect_silent(dimnames(r10) <- d10)
  expect_silent(dimnames(r11) <- d11)
  expect_silent(dimnames(r09) <- d09)
  expect_silent(dimnames(r19) <- d19)
  expect_silent(dimnames(r90) <- d90)
  expect_silent(dimnames(r91) <- d91)
  expect_silent(dimnames(r99) <- d99)
  
  expect_silent(a <- as.ff(r))
  expect_silent(a0 <- as.ff(r0))
  expect_silent(a1 <- as.ff(r1))
  expect_silent(a00 <- as.ff(r00))
  expect_silent(a01 <- as.ff(r01))
  expect_silent(a10 <- as.ff(r10))
  expect_silent(a11 <- as.ff(r11))
  expect_silent(a09 <- as.ff(r09))
  expect_silent(a19 <- as.ff(r19))
  expect_silent(a90 <- as.ff(r90))
  expect_silent(a91 <- as.ff(r91))
  expect_silent(a99 <- as.ff(r99))
  
  expect_equal(a[], r[])
  expect_equal(a0[], r0[])
  expect_equal(a1[], r1[])
  expect_equal(a00[], r00[])
  expect_equal(a01[], r01[])
  expect_equal(a10[], r10[])
  expect_equal(a11[], r11[])
  expect_equal(a09[], r09[])
  expect_equal(a19[], r19[])
  expect_equal(a90[], r90[])
  expect_equal(a91[], r91[])
  expect_equal(a99[], r99[])

  expect_silent(c <- clone(a))
  expect_silent(c0 <- clone(a0))
  expect_silent(c1 <- clone(a1))
  expect_silent(c00 <- clone(a00))
  expect_silent(c01 <- clone(a01))
  expect_silent(c10 <- clone(a10))
  expect_silent(c11 <- clone(a11))
  expect_silent(c09 <- clone(a09))
  expect_silent(c19 <- clone(a19))
  expect_silent(c90 <- clone(a90))
  expect_silent(c91 <- clone(a91))
  expect_silent(c99 <- clone(a99))
  
  expect_equal(a[], c[])
  expect_equal(a0[], c0[])
  expect_equal(a1[], c1[])
  expect_equal(a00[], c00[])
  expect_equal(a01[], c01[])
  expect_equal(a10[], c10[])
  expect_equal(a11[], c11[])
  expect_equal(a09[], c09[])
  expect_equal(a19[], c19[])
  expect_equal(a90[], c90[])
  expect_equal(a91[], c91[])
  expect_equal(a99[], c99[])
  
  
  expect_error(f <- ff(0, vmode=vm, dim=integer()), "'dims' cannot be of length 0")
  expect_silent(f <- ff(0, vmode=vm))
  
  expect_silent(f0 <- ff(0, vmode=vm, dim=0L))
  expect_silent(f1 <- ff(0, vmode=vm, dim=1L))
  
  expect_silent(f00 <- ff(0, vmode=vm, dim=c(0L,0L)))
  expect_silent(f01 <- ff(0, vmode=vm, dim=c(0L,1L)))
  expect_silent(f10 <- ff(0, vmode=vm, dim=c(1L,0L)))
  expect_silent(f11 <- ff(0, vmode=vm, dim=c(1L,1L)))
  expect_silent(f09 <- ff(0, vmode=vm, dim=c(0L,9L)))
  expect_silent(f19 <- ff(0, vmode=vm, dim=c(1L,9L)))
  expect_silent(f90 <- ff(0, vmode=vm, dim=c(9L,0L)))
  expect_silent(f91 <- ff(0, vmode=vm, dim=c(9L,1L)))
  expect_silent(f99 <- ff(0, vmode=vm, dim=c(9L,9L)))
  

  expect_silent(dimnames(f) <- d)
  
  expect_silent(dimnames(f0) <- d0)
  expect_silent(dimnames(f1) <- d1)
  
  expect_silent(dimnames(f00) <- d00)
  expect_silent(dimnames(f01) <- d01)
  expect_silent(dimnames(f10) <- d10)
  expect_silent(dimnames(f11) <- d11)
  expect_silent(dimnames(f09) <- d09)
  expect_silent(dimnames(f19) <- d19)
  expect_silent(dimnames(f90) <- d90)
  expect_silent(dimnames(f91) <- d91)
  expect_silent(dimnames(f99) <- d99)
  
  expect_equal(dimnames(r), dimnames(f))
  #expect_equal(dimnames(r0), dimnames(f0))
  expect_equal(dimnames(r1), dimnames(f1))
  #expect_equal(dimnames(r00), dimnames(f00))
  #expect_equal(dimnames(r01), dimnames(f01))
  #expect_equal(dimnames(r10), dimnames(f10))
  expect_equal(dimnames(r11), dimnames(f11))
  #expect_equal(dimnames(r09), dimnames(f09))
  #expect_equal(dimnames(r90), dimnames(f90))
  expect_equal(dimnames(r19), dimnames(f19))
  expect_equal(dimnames(r91), dimnames(f91))
  expect_equal(dimnames(r99), dimnames(f99))
    
  expect_equal(a0[], f0[])
  expect_equal(a1[], f1[])
  expect_equal(a00[], f00[])
  expect_equal(a01[], f01[])
  expect_equal(a10[], f10[])
  expect_equal(a11[], f11[])
  expect_equal(a09[], f09[])
  expect_equal(a19[], f19[])
  expect_equal(a90[], f90[])
  expect_equal(a91[], f91[])
  expect_equal(a99[], f99[])
  
  for (frc in list(f00, f01, f10, f11, f09, f19, f90, f91, f99)){
    d <- dim(frc)
    i <- seq_len(d[[1]])
    j <- seq_len(d[[2]])
    k <- seq_len(prod(d))
    ftmp <- clone(frc)
    rtmp <- ftmp[]
    rtmp[] <- rtmp[] + 1L
    ftmp[] <- rtmp[]
    expect_equal(ftmp[], rtmp[])
    rtmp[,] <- rtmp[,] + 1L
    ftmp[,] <- rtmp[,]
    expect_equal(ftmp[], rtmp[])
    rtmp[k] <- rtmp[k] + 1L
    ftmp[k] <- rtmp[k]
    expect_equal(ftmp[], rtmp[])
    rtmp[i,] <- rtmp[i,] - 1L
    ftmp[i,] <- rtmp[i,]
    expect_equal(ftmp[], rtmp[])
    rtmp[,j] <- rtmp[,j] - 1L
    ftmp[,j] <- rtmp[,j]
    expect_equal(ftmp[], rtmp[])
    rtmp[i,j] <- rtmp[i,j] - 1L
    ftmp[i,j] <- rtmp[i,j]
    expect_equal(ftmp[], rtmp[])
    close(ftmp)
    delete(ftmp)
  }
    
  for (frc in list(f00, f01, f10, f11, f09, f19, f90, f91, f99)){
    d <- dim(frc)
    i <- seq_len(d[[1]])
    j <- seq_len(d[[2]])
    k <- seq_len(prod(d))
    ftmp <- clone(frc)
    rtmp <- ftmp[]
    expect_equal(swap(ftmp, 1L), {ret <- swap(rtmp, 1L); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    expect_equal(swap(ftmp, 1L,,), {ret <- swap(rtmp, 1L,,); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    expect_equal(swap(ftmp, 1L,k), {ret <- swap(rtmp, 1L,k); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    expect_equal(swap(ftmp, 1L,i,), {ret <- swap(rtmp, 1L,i,); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    expect_equal(swap(ftmp, 1L,,j), {ret <- swap(rtmp, 1L,,j); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    expect_equal(swap(ftmp, 1L,i,j), {ret <- swap(rtmp, 1L,i,j); vmode(ret) <- vm; ret})
    expect_equal(ftmp[], rtmp[])
    close(ftmp)
    delete(ftmp)
  }

  for (frc in list(f00, f01, f10, f11, f09, f19, f90, f91, f99)){
    d <- dim(frc)
    i <- seq_len(d[[1]])
    j <- seq_len(d[[2]])
    k <- seq_len(prod(d))
    ftmp <- clone(frc)
    rtmp <- ftmp[]
    expect_silent(rtmp[] <- 1L)
    expect_silent(ftmp[] <- 1L)
    expect_equal(ftmp[], rtmp[])
    expect_silent(rtmp[,] <- 2L)
    expect_silent(ftmp[,] <- 2L)
    expect_equal(ftmp[], rtmp[])
    expect_silent(rtmp[k] <- 3L)
    expect_silent(ftmp[k] <- 3L)
    expect_equal(ftmp[], rtmp[])
    expect_silent(rtmp[i,] <- 0L)
    expect_silent(ftmp[i,] <- 0L)
    expect_equal(ftmp[], rtmp[])
    expect_silent(rtmp[,j] <- 1L)
    expect_silent(ftmp[,j] <- 1L)
    expect_equal(ftmp[], rtmp[])
    expect_silent(rtmp[i,j] <- 2L)
    expect_silent(ftmp[i,j] <- 2L)
    expect_equal(ftmp[], rtmp[])
    close(ftmp)
    delete(ftmp)
  }

  dims <- list(f00, f01, f10, f11, f09, f19, f90, f91, f99)
  nams <- sapply(dims, function(x)paste(dim(x), sep="", collapse=""))
  dres <- array(list(NULL), dim=c(length(nams), length(nams)), dimnames = list(obj=nams, dim=nams))
  fres <- array(list(NULL), dim=c(length(nams), length(nams)), dimnames = list(obj=nams, dim=nams))
  for (frc in dims){
    for (drc in dims){
      dtmp <- dim(drc)
      dnam <- paste(dim(drc), sep="", collapse="")
      fnam <- paste(dim(frc), sep="", collapse="")
      ftmp <- clone(frc)
      rtmp <- ftmp[]
      etmp <- try(dim(rtmp) <- dtmp, silent = TRUE)
      if (inherits(etmp, 'try-error')){
        dres[[fnam,dnam]] <- as.character(etmp)
      }
      etmp <- try(dim(ftmp) <- dtmp, silent = TRUE)
      if (inherits(etmp, 'try-error')){
        fres[[fnam,dnam]] <- as.character(etmp)
      }
      close(ftmp)
      delete(ftmp)
    }
  }
  
  dok <- apply(dres, 1:2, function(x){is.null(x[[1]])})
  fok <- apply(fres, 1:2, function(x){is.null(x[[1]])})
  #check whether differences are plausible ...
  #b <- bok <- dok == fok
  #b[] <- ''
  #b[!bok] <- paste(dok[!bok], fok[!bok], sep="-")
  #b
  # ... and freeze results for regression-test
  expect_equal(dok, structure(c(
    TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, 
    FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, 
    TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, 
    FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, 
    TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, 
    FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, 
    FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, 
    FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, 
    FALSE, FALSE, FALSE, FALSE, FALSE, TRUE), .Dim = c(9L, 9L), .Dimnames = list(
      obj = c("00", "01", "10", "11", "09", "19", "90", "91", "99"
      ), dim = c("00", "01", "10", "11", "09", "19", "90", "91", 
                 "99"))))
  
  expect_equal(fok, structure(c(
    TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, 
    FALSE, TRUE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, 
    TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, 
    FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, 
    TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, 
    TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, 
    TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, 
    TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
    TRUE, TRUE, TRUE), .Dim = c(9L, 9L), .Dimnames = list(obj = c("00", 
    "01", "10", "11", "09", "19", "90", "91", "99"), dim = c("00", 
    "01", "10", "11", "09", "19", "90", "91", "99"))))
  
  rm(rtmp, ftmp, dtmp, etmp, dnam, fnam, dims, nams, dres, fres, dok, fok); gc()
  rm(i,j,k,vm,ret)
  rm(frc, drc)
  
  rm(d, d0, d1, d00, d01, d10, d11, d09, d19, d90, d91, d99)
  rm(r, r0, r1, r00, r01, r10, r11, r09, r19, r90, r91, r99)
  rm(a, a0, a1, a00, a01, a10, a11, a09, a19, a90, a91, a99)
  rm(c, c0, c1, c00, c01, c10, c11, c09, c19, c90, c91, c99)
  rm(f, f0, f1, f00, f01, f10, f11, f09, f19, f90, f91, f99)
  
})