Running 'backsolvetest.R' [1s/1s]
  Comparing 'backsolvetest.Rout' to 'backsolvetest.Rout.save' ... OK
  Running 'bdstest.R' [1s/1s]
  Comparing 'bdstest.Rout' to 'bdstest.Rout.save' ... OK
  Running 'chtest.R' [1s/1s]
  Comparing 'chtest.Rout' to 'chtest.Rout.save' ... OK
  Running 'chtest2.R' [1s/1s]
  Comparing 'chtest2.Rout' to 'chtest2.Rout.save' ... OK
  Running 'corner.R' [1s/1s]
  Comparing 'corner.Rout' to 'corner.Rout.save' ... OK
  Running 'corner2.R' [1s/1s]
  Comparing 'corner2.Rout' to 'corner2.Rout.save' ... OK
  Running 'gtest.R' [1s/1s]
  Comparing 'gtest.Rout' to 'gtest.Rout.save' ... OK
  Running 'gtest2.R' [1s/1s]
  Comparing 'gtest2.Rout' to 'gtest2.Rout.save' ... OK
  Running 'matrix.R' [1s/1s]
  Comparing 'matrix.Rout' to 'matrix.Rout.save' ... OK
  Running 'nullr.R' [1s/1s]
  Comparing 'nullr.Rout' to 'nullr.Rout.save' ... OK
  Running 'reconcile.R' [1s/1s]
  Running 'tinv.R' [1s/1s]
  Comparing 'tinv.Rout' to 'tinv.Rout.save' ... OK
Running the tests in 'tests/reconcile.R' failed.
Complete output:
  > #
  > # Test cases for bdsmatrix.reconcile
  > #
  > library(bdsmatrix)
  
  Attaching package: 'bdsmatrix'
  
  The following object is masked from 'package:base':
  
      backsolve
  
  > aeq <- function(x,y) all.equal(as.vector(x), as.vector(y))
  > 
  > tmat <- bdsmatrix(c(3,2,2,4), 
  +               c(22,1,2,21,3,20,19,4,18,17,5,16,15,6,7, 8,14,9,10,13,11,12),
  +               matrix(c(1,0,1,1,0,0,1,1,0,1,0,10,0,
  +                        0,1,1,0,1,1,0,1,1,0,1,0,10), ncol=2))
  > id <- letters[1:13]
  > dimnames(tmat) <- list(id, id)
  > 
  > rmat <- matrix(1:169, 13,13)
  > rmat <- (rmat + t(rmat))/2
  > dimnames(rmat) <- list(rev(id), rev(id))
  > 
  > xmat <- bdsmatrix.reconcile(list(tmat, rmat), group=id)
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  bdsmatrix
   --- call from context --- 
  bdsmatrix.reconcile(list(tmat, rmat), group = id)
   --- call from argument --- 
  if (ismat(kmat)) {
      i <- i + 1
      kid <- dimnames(kmat)[[1]]
      if (length(kid) == 0) 
          stop("No dimnames found on a variance matrix")
      else {
          indx <- match(group, kid)
          if (any(is.na(indx))) {
              temp <- group[is.na(indx)]
              if (length(temp) > 5) 
                  temp <- temp[1:5]
              stop(paste("Group", paste(temp, collapse = " "), 
                  "is in the data but not in a varlist matrix"))
          }
          if (length(kid) > length(indx)) {
              indx <- sort(indx)
              kmat <- kmat[indx, indx]
              varlist[[j]] <- kmat
          }
          if (inherits(kmat, "bdsmatrix")) {
              nbds <- nbds + 1
              blocks <- kmat@blocksize
              rcol <- length(kmat@rmat)/nrow(kmat)
          }
          else any.matrix <- T
          if (i == 1 || inherits(kmat, "bdsmatrix")) 
              newgroup <- kid[!is.na(match(kid, group))]
      }
  }
   --- R stacktrace ---
  where 1: bdsmatrix.reconcile(list(tmat, rmat), group = id)
  
   --- value of length: 2 type: logical ---
  [1]  TRUE FALSE
   --- function from context --- 
  function (varlist, group) 
  {
      ismat <- function(x) class(x) %in% c("matrix", "bdsmatrix")
      msize <- length(group)
      if (any(duplicated(group))) 
          stop("Group index has duplicates")
      if (!is.list(varlist)) {
          if (is.function(varlist)) {
              varlist <- varlist(group)
              if (!inherits(varlist, "bdsmatrix")) 
                  stop("Invalid function call in a varlist")
          }
          else if (ismat(varlist)) {
              kid <- dimnames(varlist)[[1]]
              if (length(kid) == 0) 
                  stop("No dimnames found on a variance matrix")
              if (any(duplicated(kid))) 
                  stop("Duplicate dimnames in a variance matrix")
              indx <- match(group, kid)
              if (any(is.na(indx))) {
                  temp <- group[is.na(indx)]
                  if (length(temp) > 5) 
                    temp <- temp[1:5]
                  stop(paste("Group", paste(temp, collapse = " "), 
                    "is in the data but not in a varlist matrix"))
              }
              temp <- !is.na(match(kid, group))
              if (!all(temp)) {
                  varlist <- varlist[temp, temp]
              }
          }
          else stop("Invalid object in a variance list")
          return(varlist)
      }
      i <- 0
      nbds <- 0
      any.matrix <- F
      for (j in 1:length(varlist)) {
          kmat <- varlist[[j]]
          if (ismat(kmat)) {
              i <- i + 1
              kid <- dimnames(kmat)[[1]]
              if (length(kid) == 0) 
                  stop("No dimnames found on a variance matrix")
              else {
                  indx <- match(group, kid)
                  if (any(is.na(indx))) {
                    temp <- group[is.na(indx)]
                    if (length(temp) > 5) 
                      temp <- temp[1:5]
                    stop(paste("Group", paste(temp, collapse = " "), 
                      "is in the data but not in a varlist matrix"))
                  }
                  if (length(kid) > length(indx)) {
                    indx <- sort(indx)
                    kmat <- kmat[indx, indx]
                    varlist[[j]] <- kmat
                  }
                  if (inherits(kmat, "bdsmatrix")) {
                    nbds <- nbds + 1
                    blocks <- kmat@blocksize
                    rcol <- length(kmat@rmat)/nrow(kmat)
                  }
                  else any.matrix <- T
                  if (i == 1 || inherits(kmat, "bdsmatrix")) 
                    newgroup <- kid[!is.na(match(kid, group))]
              }
          }
      }
      if (any.matrix) {
          brow <- .C(Cbdsmatrix_index2, as.integer(1), as.integer(msize), 
              rows = integer((msize * (msize + 1))/2), cols = integer((msize * 
                  (msize + 1))/2))
          hash1 <- (brow$rows - 1) * msize + brow$cols
          for (i in 1:length(varlist)) {
              kmat <- varlist[[i]]
              if (is.function(kmat)) {
                  kmat <- kmat(group)
                  if (!inherits(kmat, "bdsmatrix")) 
                    stop("Invalid function call in a varlist")
              }
              kid <- dimnames(kmat)[[1]]
              indx <- match(kid, group)
              if (inherits(kmat, "bdsmatrix")) {
                  bb <- kmat@blocksize
                  bsize <- sum((bb * (bb + 1))/2)
                  temp <- .C(Cbdsmatrix_index2, as.integer(length(bb)), 
                    as.integer(bb), rows = integer(bsize), cols = integer(bsize))
                  newrow <- indx[temp$rows]
                  newcol <- indx[temp$cols]
                  hash2 <- (pmax(newrow, newcol) - 1) * msize + 
                    pmin(newrow, newcol)
                  if (length(kmat@rmat)) {
                    rdim <- dim(kmat@rmat)
                    first <- rdim[1] - rdim[2]
                    newrow <- indx[row(kmat@rmat)]
                    newcol <- indx[first + col(kmat@rmat)]
                    hash2 <- c(hash2, (pmax(newrow, newcol) - 1) * 
                      msize + pmin(newrow, newcol))
                    indx <- match(hash1, hash2, nomatch = 0)
                    temp <- c(0, kmat@blocks, kmat@rmat)
                    kmat <- bdsmatrix(blocksize = msize, blocks = temp[indx + 
                      1], dimnames = list(group, group))
                  }
                  else {
                    temp <- c(0, kmat@blocks)
                    indx <- match(hash1, hash2, nomatch = 0)
                    kmat <- bdsmatrix(blocksize = msize, blocks = temp[indx + 
                      1], dimnames = list(group, group))
                  }
              }
              else kmat <- bdsmatrix(blocksize = msize, blocks = c(kmat[indx, 
                  indx]), dimnames = list(group, group))
              varlist[[i]] <- kmat
          }
          return(varlist)
      }
      else group <- newgroup
      if (nbds > 1) {
          j <- 0
          for (i in 1:length(varlist)) {
              kmat <- varlist[[i]]
              if (inherits(kmat, "bdsmatrix")) {
                  if (length(kmat@rmat) > 0) {
                    stop("Can't handle 2 rmats in one list")
                  }
                  j <- j + 1
                  kid <- dimnames(kmat)[[1]]
                  indx <- match(group, kid)
                  block2 <- (rep(1:length(kmat@blocksize), kmat@blocksize))
                  block2 <- block2[indx]
                  if (j == 1) {
                    block1 <- block2
                    save <- kid
                    blocks <- kmat@blocksize
                  }
                  else {
                    ufun <- function(x) length(unique(x))
                    if (all(tapply(block2, block1, ufun) == 1)) {
                      block1 <- block2
                      save <- kid
                      blocks <- kmat@blocksize
                    }
                    else if (!all(tapply(block1, block2, ufun) == 
                      1)) {
                      stop(paste("Two variance matrices have", 
                        "incompatable structure"))
                    }
                  }
              }
          }
          group <- save
      }
      bsize <- sum((blocks * (blocks + 1))/2)
      brow <- .C(Cbdsmatrix_index2, as.integer(length(blocks)), 
          as.integer(blocks), rows = integer(bsize), cols = integer(bsize))
      hash1 <- (brow$rows - 1) * msize + brow$cols
      for (i in 1:length(varlist)) {
          kmat <- varlist[[i]]
          if (is.function(kmat)) {
              kmat <- kmat(group)
              if (!inherits(kmat, "bdsmatrix")) 
                  stop("varlist has a function that did not create a bdsmatrix")
              varlist[[i]] <- kmat
          }
          kid <- dimnames(kmat)[[1]]
          indx <- match(kid, group)
          if (any(indx != 1:length(indx)) || (length(kmat@blocksize) != 
              length(blocks)) || any(kmat@blocksize != blocks)) {
              bb <- kmat@blocksize
              bsize <- sum((bb * (bb + 1))/2)
              temp <- .C(Cbdsmatrix_index2, as.integer(length(bb)), 
                  as.integer(bb), rows = integer(bsize), cols = integer(bsize))
              newrow <- indx[temp$rows]
              newcol <- indx[temp$cols]
              hash2 <- (pmax(newrow, newcol) - 1) * msize + pmin(newrow, 
                  newcol)
              indx <- match(hash1, hash2, nomatch = 0)
              if (rcol > 0) {
                  if (length(kmat@rmat) > 0) 
                    stop("Impossible branch! Show this message to TMT")
                  first <- (msize - rcol)
                  newrow <- rep(1:msize, rcol)
                  newcol <- rep(first + 1:rcol, rep(msize, rcol))
                  hash3 <- (pmax(newrow, newcol) - 1) * msize + 
                    pmin(newrow, newcol)
                  indx2 <- match(hash3, hash2, nomatch = 0)
                  kmat <- bdsmatrix(blocksize = blocks, blocks = c(0, 
                    kmat@blocks)[indx + 1], rmat = matrix(c(0, 
                    kmat@blocks)[indx2 + 1], ncol = rcol), dimnames = list(group, 
                    group))
              }
              else {
                  kmat@blocksize <- blocks
                  kmat@blocks <- (c(0, kmat@blocks))[1 + indx]
                  kmat@Dimnames <- list(group, group)
              }
              varlist[[i]] <- kmat
          }
      }
      varlist
  }
  <bytecode: 0x46cbc48>
  <environment: namespace:bdsmatrix>
   --- function search by body ---
  Function bdsmatrix.reconcile in namespace bdsmatrix has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1