src/library/methods/R/fixPrevious.R

#  File src/library/methods/R/fixPrevious.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2015 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

## fixPre1.8(names)
##   The objects in names should have been loaded from a version of R
##   previous to 1.8.0
##   The classes of these objects must be defined in the current session.
##   Objects are modified to have the correct version of its class,
##   and re-assigned.
##
##   The function checks for existence and consistency of class definitions.
fixPre1.8 <- function(names, where = topenv(parent.frame())) {
    done <- character()
    for(what in names) {
        objWhere <- .findAll(what, where)
        if(length(objWhere) == 0) {
            warning(gettextf("object %s not found",
                             sQuote(what)),
                    domain = NA)
            next
        }
        objWhere <- objWhere[[1L]]
        obj <- get(what, objWhere)
        ## don't fix up basic datatypes with no explicit class
        if(is.null(attr(obj, "class")))
            next
        Class <- class(obj)
        if(is.null(attr(Class, "package"))) {
            if(isClass(Class, where = where)) {
                ClassDef <- getClass(Class, where = where)
                ok <- !(isVirtualClass(ClassDef) ||
			!isTRUE(validObject(obj, test=TRUE)))
                if(ok) {
                    class(obj) <- ClassDef@className
                    assign(what, obj, objWhere)
                    done <- c(done, what)
                }
                else
                    warning(gettextf("object %s not changed (it is not consistent with the current definition of class %s from %s)",
                                     sQuote(what),
                                     dQuote(Class),
                                     sQuote(ClassDef@package)),
                            domain = NA)
            }
            else
                warning(gettextf("no definition for the class of %s (class %s) found",
                                 sQuote(what),
                                 dQuote(class)),
                        domain = NA)
        }
        else
            warning(gettextf("object %s not changed (it does not appear to be from a version of R earlier than 1.8.0)",
                             sQuote(what)),
                    domain = NA)
    }
    done
}