testUpdateObjectList <- function() {
    DEACTIVATED("cannot yet setClass during RUnit")
    setClass("A", representation(x="numeric"), prototype(x=1:10))
    a <- new("A")
    l <- list(a,a)
    checkTrue(identical(l, updateObject(l)))
    
    setMethod("updateObject", "A",
              function(object, ..., verbose=FALSE) {
                  if (verbose) message("updateObject object = 'A'")
                  object@x <- -object@x
                  object
              })

    obj <- updateObject(l)
    checkTrue(identical(lapply(l, function(elt) { elt@x <- -elt@x; elt }),
                        obj))
    removeMethod("updateObject", "A")
}

testUpdateObjectEnv <- function() {
    opts <- options()
    options(warn=-1)
    e <- new.env()
    e$x=1
    e$.x=1
    obj <- updateObject(e)
    checkTrue(identical(e,obj))         # modifies environment

    lockEnvironment(e)
    obj <- updateObject(e)              # copies environment
    checkTrue(identical(lapply(ls(e, all=TRUE), function(x) x),
                        lapply(ls(obj, all=TRUE), function(x) x)))
    checkTrue(!identical(e, obj))       # different environments

    e <- new.env()
    e$x=1
    e$.x=1
    lockBinding("x", e)
    checkException(updateObject(e), silent=TRUE)

    lockEnvironment(e)
    obj <- updateObject(e)
    checkTrue(TRUE==bindingIsLocked("x", obj)) # R bug, 14 May, 2006, fixed
    checkTrue(FALSE==bindingIsLocked(".x", obj))
    options(opts)
}

testUpdateObjectDefaultsBroken <- function() {
    x <- 1:10
    checkTrue(class(updateObjectTo(x, numeric())) == "numeric")
}

testUpdateObjectDefaults <- function() {
    x <- 1:10
    checkTrue(identical(x, updateObject(x)))
    checkTrue(identical(1:10, updateObjectTo(x, 10:1)))
    x <- as.numeric(1:10)
    checkTrue(identical(as.integer(1:10), updateObjectTo(x, integer())))
    checkTrue(!identical(as.numeric(1:10), updateObjectTo(x, integer())))
}

testUpdateObjectSetClass <- function() {
    DEACTIVATED("cannot yet setClass during RUnit")
    setClass("A",
             representation(x="numeric"),
             prototype=prototype(x=1:10))
    a <- new("A")
    checkTrue(identical(a,updateObject(a)))
    a1 <- new("A",x=10:1)
    checkTrue(identical(a, updateObjectTo(a, a1)))

    setClass("B", representation(x="numeric"))
    b <- new("B")
    checkException(updateObjectTo(a, b), silent=TRUE)

    setAs("A", "B", function(from) {
        b <- new("B")
        b@x <- from@x
        b
    })
    obj <- updateObjectTo(a,b)
    checkTrue(class(obj)=="B")
    checkIdentical(obj@x, a@x)
    removeMethod("coerce", c("A","B"))
}

testUpdateExpressionSet <- function() {
    opts <- options()
    options(warn=-1)
    obj <- new("ExpressionSet")
    checkTrue(identical(obj, updateObject(obj)))
    checkTrue(!identical(new("ExpressionSet"), updateObject(obj))) # different environments
    obj <- new("ExpressionSet", storage.mode="list")
    checkTrue(identical(obj, updateObject(obj)))
    checkTrue(identical(new("ExpressionSet", storage.mode="list"), updateObject(obj))) # same class -- list

    data(sample.ExpressionSet)
    classVersion(sample.ExpressionSet)["eSet"] <- "1.0.0"
    checkException(validObject(sample.ExpressionSet), silent=TRUE)

    suppressMessages(obj <- updateObject(sample.ExpressionSet))
    checkTrue(isVersioned(obj))
    checkTrue(all(isCurrent(obj)))
    checkTrue(validObject(obj))
    checkTrue(identical(lapply(ls(assayData(obj), all=TRUE), function(x) x),
                        lapply(ls(assayData(sample.ExpressionSet),all=TRUE), function(x) x)))
    checkTrue(identical(annotation(obj), annotation(sample.ExpressionSet)))

    suppressMessages(obj1a <- updateObjectTo(sample.ExpressionSet, new("ExpressionSet")))
    ## next better written as(sample.ExpressionSet, "MultiSet")
    suppressMessages(obj1b <- updateObjectTo(sample.ExpressionSet, new("MultiSet")))
    obj2 <- updateObject(obj)           # stop after eSet
    options(opts)
}

testUpdateESetMisc <- function() {
    opts <- options()
    options(warn=-1)
    data(sample.exprSet)
    suppressMessages(obj <- as(sample.exprSet, "ExpressionSet"))
    checkTrue(validObject(obj, complete=TRUE))
    checkTrue(all(sapply(c("phenoData", "experimentData", "featureData"),
                         function(nm) isS4(eval(parse(text=paste(nm,"(obj)", sep="")))))))

    data(sample.eSet)
    obj <- as(sample.eSet, "MultiSet")
    checkTrue(validObject(obj, complete=TRUE))
    checkTrue(all(sapply(c("phenoData", "experimentData", "featureData"),
                         function(nm) isS4(eval(parse(text=paste(nm,"(obj)", sep="")))))))

    data(eset)
    obj <- as(eset, "ExpressionSet")
    checkTrue(validObject(obj, complete=TRUE))
    checkTrue(all(sapply(c("phenoData", "experimentData", "featureData"),
                         function(nm) isS4(eval(parse(text=paste(nm,"(obj)", sep="")))))))

    options(opts)
}

testUpdateMiscPreviousInstances <- function() {
    opts <- options("warn")
    options(warn=-1)
    on.exit(options(opts))

    rda <- list.files(system.file("UnitTests", "VersionedClass_data", package="Biobase"),
                       full.names=TRUE, recursive=TRUE, pattern="^([^(ExpressionSet|exprSet)]).*\.Rda")
    for (nm in rda) {
        env <- new.env(parent=emptyenv())
        load(nm, env)
        eapply(env,
               function(elt) {
                   suppressMessages(obj <- updateObject(elt))
                   checkTrue(isS4(obj))
                   checkTrue(validObject(obj, complete=TRUE))
               })
               
    }
}

testUpdatePreviousExprSet <- function() {
    opts <- options("warn")
    options(warn=-1)
    on.exit(options(opts))

    rda <- list.files(system.file("UnitTests", "VersionedClass_data", package="Biobase"),
                      full.names=TRUE, recursive=TRUE, pattern="^exprSet.*\.Rda")

    for (nm in rda) {
        env <- new.env(parent=emptyenv())
        load(nm, env)
        eapply(env,
               function(elt) {
                   suppressMessages(obj <- updateObject(elt))
                   checkTrue(validObject(obj, complete=TRUE))
                   ## S4
                   checkTrue(all(sapply(c("phenoData", "description"),
                                        function(nm) isS4(eval(parse(text=paste(nm,"(obj)", sep="")))))))
                   ## content
                   checkTrue(identical(exprs(obj), exprs(elt)))
                   checkTrue(identical(pData(phenoData(obj)), pData(phenoData(elt))))
                   checkTrue(identical(varMetadata(phenoData(obj)), varMetadata(phenoData(elt))))
                   nms <- names(getSlots("MIAME"))
                   nms <- nms[!nms %in% ".__classVersion__"]
                   checkTrue(all(sapply(nms, function(nm)
                                        identical(slot(description(obj), nm),
                                                  slot(description(elt), nm)))))
               })
    }
}

testUpdatePreviousExpressionSet <- function() {
    opts <- options("warn")
    options(warn=-1)
    on.exit(options(opts))

    rda <- list.files(system.file("UnitTests", "VersionedClass_data", package="Biobase"),
                      full.names=TRUE, recursive=TRUE, pattern="^ExpressionSet.*\.Rda")

    for (nm in rda) {
        env <- new.env(parent=emptyenv())
        load(nm, env)
        eapply(env,
               function(elt) {
                   suppressMessages(obj <- updateObject(elt))
                   checkTrue(validObject(obj, complete=TRUE))
                   ## S4
                   checkTrue(all(sapply(c("phenoData", "experimentData", "featureData"),
                                        function(nm) isS4(eval(parse(text=paste(nm,"(obj)", sep="")))))))
                   ## content
                   checkTrue(identical(exprs(obj), exprs(elt)))
                   checkTrue(identical(pData(phenoData(obj)), pData(phenoData(elt))))
                   checkTrue(identical(varMetadata(phenoData(obj)), varMetadata(phenoData(elt))))
                   nms <- names(getSlots("MIAME"))
                   nms <- nms[!nms %in% ".__classVersion__"]
                   lapply(nms, function(nm)
                          checkTrue(identical(slot(experimentData(obj), nm),
                                              slot(experimentData(elt), nm))))
               })
    }
}