View | Details | Raw Unified | Return to bug 16490 | Differences between
and this patch

Collapse All | Expand All

(-)src/library/base/R/namespace.R (-46 / +27 lines)
Lines 89-100 Link Here
89
	get(name, envir = ns, inherits = FALSE) # incl. error
89
	get(name, envir = ns, inherits = FALSE) # incl. error
90
    else {
90
    else {
91
	if (!is.null(oNam <- .getNamespaceInfo(ns, "exports")[[name]])) {
91
	if (!is.null(oNam <- .getNamespaceInfo(ns, "exports")[[name]])) {
92
	    get0(oNam, envir = ns)
92
	    get0(oNam, envir = ns) # inherits = TRUE necessary, so can't be [[
93
	} else { ##  <pkg> :: <dataset>  for lazydata :
93
	} else { ##  <pkg> :: <dataset>  for lazydata :
94
	    ld <- .getNamespaceInfo(ns, "lazydata")
94
	    ld <- .getNamespaceInfo(ns, "lazydata")
95
	    if (!is.null(obj <- get0(name, envir = ld, inherits = FALSE)))
95
	    if (!is.null(obj <- ld[[name]])) {
96
		obj
96
		obj
97
	    else { ## if there's a lazydata object with value NULL:
97
	    } else { ## if there's a lazydata object with value NULL:
98
		if(exists(name, envir = ld, inherits = FALSE))
98
		if(exists(name, envir = ld, inherits = FALSE))
99
		    NULL
99
		    NULL
100
		else
100
		else
Lines 126-132 Link Here
126
{
126
{
127
    ## only used to run .onAttach
127
    ## only used to run .onAttach
128
    runHook <- function(hookname, env, libname, pkgname) {
128
    runHook <- function(hookname, env, libname, pkgname) {
129
        if (!is.null(fun <- get0(hookname, envir = env, inherits = FALSE))) {
129
        if (!is.null(fun <- env[[hookname]])) {
130
            res <- tryCatch(fun(libname, pkgname), error = identity)
130
            res <- tryCatch(fun(libname, pkgname), error = identity)
131
            if (inherits(res, "error")) {
131
            if (inherits(res, "error")) {
132
                stop(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
132
                stop(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
Lines 162-168 Link Here
162
    dimpenv <- .getNamespaceInfo(ns, "lazydata")
162
    dimpenv <- .getNamespaceInfo(ns, "lazydata")
163
    dnames <- names(dimpenv)
163
    dnames <- names(dimpenv)
164
    .Internal(importIntoEnv(env, dnames, dimpenv, dnames))
164
    .Internal(importIntoEnv(env, dnames, dimpenv, dnames))
165
    if(length(depends)) assign(".Depends", depends, env)
165
    if(length(depends)) env[[".Depends"]] <- depends
166
    Sys.setenv("_R_NS_LOAD_" = nsname)
166
    Sys.setenv("_R_NS_LOAD_" = nsname)
167
    on.exit(Sys.unsetenv("_R_NS_LOAD_"), add = TRUE)
167
    on.exit(Sys.unsetenv("_R_NS_LOAD_"), add = TRUE)
168
    runHook(".onAttach", ns, dirname(nspath), nsname)
168
    runHook(".onAttach", ns, dirname(nspath), nsname)
Lines 217-223 Link Here
217
    } else {
217
    } else {
218
        ## only used here for .onLoad
218
        ## only used here for .onLoad
219
        runHook <- function(hookname, env, libname, pkgname) {
219
        runHook <- function(hookname, env, libname, pkgname) {
220
	    if (!is.null(fun <- get0(hookname, envir = env, inherits = FALSE))) {
220
	    if (!is.null(fun <- env[[hookname]])) {
221
                res <- tryCatch(fun(libname, pkgname), error = identity)
221
                res <- tryCatch(fun(libname, pkgname), error = identity)
222
                if (inherits(res, "error")) {
222
                if (inherits(res, "error")) {
223
                    stop(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
223
                    stop(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
Lines 239-246 Link Here
239
            name <- as.character(as.name(name))
239
            name <- as.character(as.name(name))
240
            version <- as.character(version)
240
            version <- as.character(version)
241
            info <- new.env(hash = TRUE, parent = baseenv())
241
            info <- new.env(hash = TRUE, parent = baseenv())
242
            assign(".__NAMESPACE__.", info, envir = env)
242
            env[[".__NAMESPACE__."]] <- info
243
            assign("spec", c(name = name, version = version), envir = info)
243
            info[["spec"]] <- c(name = name, version = version)
244
            setNamespaceInfo(env, "exports", new.env(hash = TRUE, parent = baseenv()))
244
            setNamespaceInfo(env, "exports", new.env(hash = TRUE, parent = baseenv()))
245
            dimpenv <- new.env(parent = baseenv(), hash = TRUE)
245
            dimpenv <- new.env(parent = baseenv(), hash = TRUE)
246
            attr(dimpenv, "name") <- paste("lazydata", name, sep = ":")
246
            attr(dimpenv, "name") <- paste("lazydata", name, sep = ":")
Lines 251-259 Link Here
251
                             normalizePath(file.path(lib, name), "/", TRUE))
251
                             normalizePath(file.path(lib, name), "/", TRUE))
252
            setNamespaceInfo(env, "dynlibs", NULL)
252
            setNamespaceInfo(env, "dynlibs", NULL)
253
            setNamespaceInfo(env, "S3methods", matrix(NA_character_, 0L, 3L))
253
            setNamespaceInfo(env, "S3methods", matrix(NA_character_, 0L, 3L))
254
            assign(".__S3MethodsTable__.",
254
            env[[".__S3MethodsTable__."]] <- new.env(hash = TRUE, parent = baseenv())
255
                   new.env(hash = TRUE, parent = baseenv()),
256
                   envir = env)
257
            .Internal(registerNamespace(name, env))
255
            .Internal(registerNamespace(name, env))
258
            env
256
            env
259
        }
257
        }
Lines 302-308 Link Here
302
                                                           sym$name, varName, varName, sQuote(package)),
300
                                                           sym$name, varName, varName, sQuote(package)),
303
                                                  domain = NA, call. = FALSE)
301
                                                  domain = NA, call. = FALSE)
304
                                      else
302
                                      else
305
                                          assign(varName, sym, envir = env)
303
                                          env[[varName]] <- sym
306
                                  })
304
                                  })
307
                       })
305
                       })
308
306
Lines 330-336 Link Here
330
                                                origVarName, varName, sQuote(package)),
328
                                                origVarName, varName, sQuote(package)),
331
                                       domain = NA, call. = FALSE)
329
                                       domain = NA, call. = FALSE)
332
                       else
330
                       else
333
                           assign(varName, symbols[[origVarName]], envir = env)
331
                           env[[varName]] <- symbols[[origVarName]]
334
332
335
                   })
333
                   })
336
            symbols
334
            symbols
Lines 426-432 Link Here
426
424
427
        env <- asNamespace(ns)
425
        env <- asNamespace(ns)
428
        ## save the package name in the environment
426
        ## save the package name in the environment
429
        assign(".packageName", package, envir = env)
427
        env[[".packageName"]] <- package
430
428
431
        ## load the code
429
        ## load the code
432
        codename <- strsplit(package, "_", fixed = TRUE)[[1L]][1L]
430
        codename <- strsplit(package, "_", fixed = TRUE)[[1L]][1L]
Lines 473-479 Link Here
473
            ## dynlibs vector.
471
            ## dynlibs vector.
474
            if(!is.null(names(nsInfo$dynlibs))
472
            if(!is.null(names(nsInfo$dynlibs))
475
               && nzchar(names(nsInfo$dynlibs)[i]))
473
               && nzchar(names(nsInfo$dynlibs)[i]))
476
                assign(names(nsInfo$dynlibs)[i], dlls[[lib]], envir = env)
474
                env[[names(nsInfo$dynlibs)[i]]] <- dlls[[lib]]
477
            setNamespaceInfo(env, "DLLs", dlls)
475
            setNamespaceInfo(env, "DLLs", dlls)
478
        }
476
        }
479
        addNamespaceDynLibs(env, nsInfo$dynlibs)
477
        addNamespaceDynLibs(env, nsInfo$dynlibs)
Lines 609-619 Link Here
609
                ## the internal table.
607
                ## the internal table.
610
                pm <- allGenerics[!(allGenerics %in% expMethods)]
608
                pm <- allGenerics[!(allGenerics %in% expMethods)]
611
                if(length(pm)) {
609
                if(length(pm)) {
612
                    prim <- logical(length(pm))
610
                    prim <- vapply(pm, function(x) {
613
                    for(i in seq_along(prim)) {
611
                                       is.primitive(methods::getFunction(x, FALSE, FALSE, ns))
614
                        f <- methods::getFunction(pm[[i]], FALSE, FALSE, ns)
612
                                   }, logical(1))
615
                        prim[[i]] <- is.primitive(f)
616
                    }
617
                    expMethods <- c(expMethods, pm[prim])
613
                    expMethods <- c(expMethods, pm[prim])
618
                }
614
                }
619
                for(i in seq_along(expMethods)) {
615
                for(i in seq_along(expMethods)) {
Lines 691-710 Link Here
691
687
692
topenv <- function(envir = parent.frame(),
688
topenv <- function(envir = parent.frame(),
693
                   matchThisEnv = getOption("topLevelEnvironment")) {
689
                   matchThisEnv = getOption("topLevelEnvironment")) {
694
    ## while (! identical(envir, emptyenv())) {
695
    ##     nm <- attributes(envir)[["names", exact = TRUE]]
696
    ##     if ((is.character(nm) && length(grep("^package:" , nm))) ||
697
    ##         ## matchThisEnv is used in sys.source
698
    ##         identical(envir, matchThisEnv) ||
699
    ##         identical(envir, .GlobalEnv) ||
700
    ##         identical(envir, baseenv()) ||
701
    ##         .Internal(isNamespaceEnv(envir)) ||
702
    ##         ## packages except base and those with a separate namespace have .packageName
703
    ##         exists(".packageName", envir = envir, inherits = FALSE))
704
    ##         return(envir)
705
    ##     else envir <- parent.env(envir)
706
    ## }
707
    ## return(.GlobalEnv)
708
    .Internal(topenv(envir, matchThisEnv))
690
    .Internal(topenv(envir, matchThisEnv))
709
}
691
}
710
692
Lines 712-718 Link Here
712
{
694
{
713
    ## only used to run .onUnload
695
    ## only used to run .onUnload
714
    runHook <- function(hookname, env, ...) {
696
    runHook <- function(hookname, env, ...) {
715
	if (!is.null(fun <- get0(hookname, envir = env, inherits = FALSE))) {
697
	if (!is.null(fun <- env[[hookname]])) {
716
            res <- tryCatch(fun(...), error=identity)
698
            res <- tryCatch(fun(...), error=identity)
717
            if (inherits(res, "error")) {
699
            if (inherits(res, "error")) {
718
                warning(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
700
                warning(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s",
Lines 881-887 Link Here
881
	}
863
	}
882
    }
864
    }
883
    for (n in impnames)
865
    for (n in impnames)
884
	if (!is.null(genImp <- get0(n, envir = impenv, inherits = FALSE))) {
866
	if (!is.null(genImp <- impenv[[n]])) {
885
	    if (.isMethodsDispatchOn() && methods::isGeneric(n, ns)) {
867
	    if (.isMethodsDispatchOn() && methods::isGeneric(n, ns)) {
886
		## warn only if generic overwrites a function which
868
		## warn only if generic overwrites a function which
887
		## it was not derived from
869
		## it was not derived from
Lines 1017-1023 Link Here
1017
                                paste(sQuote(expnames[ex]), collapse = ", ")),
999
                                paste(sQuote(expnames[ex]), collapse = ", ")),
1018
                        call. = FALSE, domain = NA)
1000
                        call. = FALSE, domain = NA)
1019
            for (i in seq_along(new))
1001
            for (i in seq_along(new))
1020
                assign(expnames[i], intnames[i], envir = exports)
1002
                exports[[expnames[i]]] <- intnames[i]
1021
        }
1003
        }
1022
        makeImportExportNames <- function(spec) {
1004
        makeImportExportNames <- function(spec) {
1023
            old <- as.character(spec)
1005
            old <- as.character(spec)
Lines 1051-1059 Link Here
1051
    newMethods <- new[substr(new, 1L, nchar(mm, type = "c")) == mm]
1033
    newMethods <- new[substr(new, 1L, nchar(mm, type = "c")) == mm]
1052
    nsimports <- parent.env(ns)
1034
    nsimports <- parent.env(ns)
1053
    for(what in newMethods) {
1035
    for(what in newMethods) {
1054
	if(!is.null(m1 <- get0(what, envir = nsimports, inherits = FALSE))) {
1036
	if(!is.null(m1 <- nsimports[[what]])) {
1055
            m2 <- get(what, envir = ns)
1037
            m2 <- get(what, envir = ns)
1056
            assign(what, envir = ns, methods::mergeMethods(m1, m2))
1038
            ns[[what]] <- methods::mergeMethods(m1, m2)
1057
        }
1039
        }
1058
    }
1040
    }
1059
}
1041
}
Lines 1334-1342 Link Here
1334
        if (typeof(genfun) == "closure") environment(genfun)
1316
        if (typeof(genfun) == "closure") environment(genfun)
1335
	else .BaseNamespaceEnv
1317
	else .BaseNamespaceEnv
1336
    }
1318
    }
1337
    if (is.null(table <- get0(".__S3MethodsTable__.", envir = defenv, inherits = FALSE))) {
1319
    if (is.null(table <- defenv[[".__S3MethodsTable__."]])) {
1338
	table <- new.env(hash = TRUE, parent = baseenv())
1320
	table <- 
1339
	assign(".__S3MethodsTable__.", table, envir = defenv)
1321
	defenv[[".__S3MethodsTable__."]] <- table
1340
    }
1322
    }
1341
1323
1342
    if (is.character(method)) {
1324
    if (is.character(method)) {
Lines 1392-1400 Link Here
1392
            if (typeof(genfun) == "closure") environment(genfun)
1374
            if (typeof(genfun) == "closure") environment(genfun)
1393
            else .BaseNamespaceEnv
1375
            else .BaseNamespaceEnv
1394
        }
1376
        }
1395
	if (is.null(table <- get0(".__S3MethodsTable__.", envir = defenv, inherits = FALSE))) {
1377
	if (is.null(table <- defenv[[".__S3MethodsTable__."]])) {
1396
	    table <- new.env(hash = TRUE, parent = baseenv())
1378
	    table <- new.env(hash = TRUE, parent = baseenv())
1397
	    assign(".__S3MethodsTable__.", table, envir = defenv)
1379
	    defenv[[".__S3MethodsTable__."]] <- table
1398
	}
1380
	}
1399
        if(!is.null(e <- table[[nm]])) {
1381
        if(!is.null(e <- table[[nm]])) {
1400
            current <- environmentName(environment(e))
1382
            current <- environmentName(environment(e))
Lines 1432-1439 Link Here
1432
        }
1414
        }
1433
    if(any(localGeneric)) {
1415
    if(any(localGeneric)) {
1434
        lin <- Info[localGeneric, , drop = FALSE]
1416
        lin <- Info[localGeneric, , drop = FALSE]
1435
        S3MethodsTable <-
1417
        S3MethodsTable <- env[[".__S3MethodsTable__."]]
1436
            get(".__S3MethodsTable__.", envir = env, inherits = FALSE)
1437
        ## we needed to move this to C for speed.
1418
        ## we needed to move this to C for speed.
1438
        ## for(i in seq_len(nrow(lin)))
1419
        ## for(i in seq_len(nrow(lin)))
1439
        ##    assign(lin[i,4], get(lin[i,3], envir = env),
1420
        ##    assign(lin[i,4], get(lin[i,3], envir = env),
(-)src/library/methods/R/RMethodUtils.R (-3 / +1 lines)
Lines 1534-1543 Link Here
1534
    value
1534
    value
1535
}
1535
}
1536
1536
1537
1538
.hasS4MetaData <- function(env)
1537
.hasS4MetaData <- function(env)
1539
  (length(objects(env, all.names = TRUE,
1538
    any(grepl("^[.]__[CTA]_", names(env)))
1540
                          pattern = "^[.]__[CTA]_")))
1541
1539
1542
## turn ordinary generic into one that dispatches on "..."
1540
## turn ordinary generic into one that dispatches on "..."
1543
## currently only called in one place from setGeneric()
1541
## currently only called in one place from setGeneric()

Return to bug 16490