From 74ec303d3cd4daf6e8ea396c8d4965ec0443a442 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Mon, 13 Apr 2015 15:27:34 -0400 Subject: [PATCH 1/7] Minor refactor and removes redundancy. --- R/pkg/R/RDD.R | 16 ++++------------ R/pkg/R/pairRDD.R | 4 ---- 2 files changed, 4 insertions(+), 16 deletions(-) diff --git a/R/pkg/R/RDD.R b/R/pkg/R/RDD.R index 604ad03c407b9..f47410a6b3c33 100644 --- a/R/pkg/R/RDD.R +++ b/R/pkg/R/RDD.R @@ -85,7 +85,7 @@ setMethod("initialize", "PipelinedRDD", function(.Object, prev, func, jrdd_val) if (!inherits(prev, "PipelinedRDD") || !isPipelinable(prev)) { # This transformation is the first in its stage: - .Object@func <- func + .Object@func <- cleanClosure(func) .Object@prev_jrdd <- getJRDD(prev) .Object@env$prev_serializedMode <- prev@env$serializedMode # NOTE: We use prev_serializedMode to track the serialization mode of prev_JRDD @@ -94,7 +94,7 @@ setMethod("initialize", "PipelinedRDD", function(.Object, prev, func, jrdd_val) pipelinedFunc <- function(split, iterator) { func(split, prev@func(split, iterator)) } - .Object@func <- pipelinedFunc + .Object@func <- cleanClosure(pipelinedFunc) .Object@prev_jrdd <- prev@prev_jrdd # maintain the pipeline # Get the serialization mode of the parent RDD .Object@env$prev_serializedMode <- prev@env$prev_serializedMode @@ -144,17 +144,13 @@ setMethod("getJRDD", signature(rdd = "PipelinedRDD"), return(rdd@env$jrdd_val) } - computeFunc <- function(split, part) { - rdd@func(split, part) - } - packageNamesArr <- serialize(.sparkREnv[[".packages"]], connection = NULL) broadcastArr <- lapply(ls(.broadcastNames), function(name) { get(name, .broadcastNames) }) - serializedFuncArr <- serialize(computeFunc, connection = NULL) + serializedFuncArr <- serialize(rdd@func, connection = NULL) prev_jrdd <- rdd@prev_jrdd @@ -551,11 +547,7 @@ setMethod("mapPartitions", setMethod("lapplyPartitionsWithIndex", signature(X = "RDD", FUN = "function"), function(X, FUN) { - FUN <- cleanClosure(FUN) - closureCapturingFunc <- function(split, part) { - FUN(split, part) - } - PipelinedRDD(X, closureCapturingFunc) + PipelinedRDD(X, FUN) }) #' @rdname lapplyPartitionsWithIndex diff --git a/R/pkg/R/pairRDD.R b/R/pkg/R/pairRDD.R index c2396c32a7548..739d399f0820f 100644 --- a/R/pkg/R/pairRDD.R +++ b/R/pkg/R/pairRDD.R @@ -694,10 +694,6 @@ setMethod("cogroup", for (i in 1:rddsLen) { rdds[[i]] <- lapply(rdds[[i]], function(x) { list(x[[1]], list(i, x[[2]])) }) - # TODO(hao): As issue [SparkR-142] mentions, the right value of i - # will not be captured into UDF if getJRDD is not invoked. - # It should be resolved together with that issue. - getJRDD(rdds[[i]]) # Capture the closure. } union.rdd <- Reduce(unionRDD, rdds) group.func <- function(vlist) { From 3d3481b2d35b5d788d91ec3bb1d0de4de60ffbf8 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Sat, 25 Apr 2015 23:32:08 -0400 Subject: [PATCH 2/7] Fix WAR order, and recursive function checks. --- R/pkg/R/utils.R | 36 +++++++++++++++++++++-------------- R/pkg/inst/tests/test_utils.R | 22 ++++++++++++++++----- 2 files changed, 39 insertions(+), 19 deletions(-) diff --git a/R/pkg/R/utils.R b/R/pkg/R/utils.R index 0e7b7bd5a5b34..bb77c853adcb6 100644 --- a/R/pkg/R/utils.R +++ b/R/pkg/R/utils.R @@ -359,6 +359,9 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { } } else if (nodeChar == "<-" || nodeChar == "=" || nodeChar == "<<-") { # Assignment Ops. + for (i in 3:nodeLen) { + processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + } defVar <- node[[2]] if (length(defVar) == 1 && typeof(defVar) == "symbol") { # Add the defined variable name into defVars. @@ -366,9 +369,6 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { } else { processClosure(node[[2]], oldEnv, defVars, checkedFuncs, newEnv) } - for (i in 3:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) - } } else if (nodeChar == "function") { # Function definition. # Add parameter names. newArgs <- names(node[[2]]) @@ -395,13 +395,14 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { topEnv <- parent.env(.GlobalEnv) # Search in function environment, and function's enclosing environments # up to global environment. There is no need to look into package environments - # above the global or namespace environment that is not SparkR below the global, - # as they are assumed to be loaded on workers. + # above the global, as they are assumed to be loaded on workers. while (!identical(func.env, topEnv)) { # Namespaces other than "SparkR" will not be searched. + # Only examine functions in non-namespace environments or private functions in + # package namespaces. if (!isNamespace(func.env) || - (getNamespaceName(func.env) == "SparkR" && - !(nodeChar %in% getNamespaceExports("SparkR")))) { # Only include SparkR internals. + !(nodeChar %in% getNamespaceExports(getNamespaceName(func.env))) + ) { # Set parameter 'inherits' to FALSE since we do not need to search in # attached package environments. if (tryCatch(exists(nodeChar, envir = func.env, inherits = FALSE), @@ -417,14 +418,21 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { break } # Function has not been examined, record it and recursively clean its closure. - assign(nodeChar, - if (is.null(funcList[[1]])) { - list(obj) - } else { - append(funcList, obj) - }, - envir = checkedFuncs) + newFuncList <- if (is.null(funcList[[1]])) { + list(obj) + } else { + append(funcList, obj) + } + assign(nodeChar, newFuncList, envir = checkedFuncs) obj <- cleanClosure(obj, checkedFuncs) + parent.env(environment(obj)) <- newEnv + # Remove examined functions. + newFuncList[[length(newFuncList)]] <- NULL + if (length(newFuncList) > 0) { + assign(nodeChar, newFuncList, envir = checkedFuncs) + } else { + remove(list = nodeChar, envir = checkedFuncs) + } } assign(nodeChar, obj, envir = newEnv) break diff --git a/R/pkg/inst/tests/test_utils.R b/R/pkg/inst/tests/test_utils.R index 9c5bb427932b4..179479020a261 100644 --- a/R/pkg/inst/tests/test_utils.R +++ b/R/pkg/inst/tests/test_utils.R @@ -83,35 +83,47 @@ test_that("cleanClosure on R functions", { field <- matrix(2) defUse <- 3 g <- function(x) { x + y } + h <- function(x) { f(x) } f <- function(x) { defUse <- base::as.integer(x) + 1 # Test for access operators `::`. lapply(x, g) + 1 # Test for capturing function call "g"'s closure as a argument of lapply. l$field[1,1] <- 3 # Test for access operators `$`. res <- defUse + l$field[1,] # Test for def-use chain of "defUse", and "" symbol. f(res) # Test for recursive calls. + h(res) # f should be examined again in h's env. More recursive call f -> h -> f ... } - newF <- cleanClosure(f) + newF <- SparkR:::cleanClosure(f) env <- environment(newF) - expect_equal(length(ls(env)), 3) # Only "g", "l" and "f". No "base", "field" or "defUse". + expect_equal(length(ls(env)), 4) # "g", "l", "f" and "h". No "base", "field" or "defUse". expect_true("g" %in% ls(env)) expect_true("l" %in% ls(env)) expect_true("f" %in% ls(env)) + expect_true("h" %in% ls(env)) expect_equal(get("l", envir = env, inherits = FALSE), l) - # "y" should be in the environemnt of g. newG <- get("g", envir = env, inherits = FALSE) + newH <- get("h", envir = env, inherits = FALSE) + # "y" should be in the environemnt of g. env <- environment(newG) - expect_equal(length(ls(env)), 1) + expect_equal(ls(env), "y") actual <- get("y", envir = env, inherits = FALSE) expect_equal(actual, y) + # "f" should be in h's env. + env <- environment(newH) + expect_equal(ls(env), "f") + actual <- get("f", envir = env, inherits = FALSE) + expect_equal(actual, f) # Test for function (and variable) definitions. + z <- c(1, 2) f <- function(x) { g <- function(y) { y * 2 } + z <- z * 2 # Write after read. g(x) } newF <- cleanClosure(f) env <- environment(newF) - expect_equal(length(ls(env)), 0) # "y" and "g" should not be included. + expect_equal(length(ls(env)), 1) # "z". No y" or "g". + expect_true("z" %in% ls(env)) # Test for overriding variables in base namespace (Issue: SparkR-196). nums <- as.list(1:10) From 7366b4da3f3cf65144a520bddd81b8f86de84338 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Mon, 27 Apr 2015 23:21:25 -0400 Subject: [PATCH 3/7] Fixes 6837 and 6840 with modification to plyrmr. --- R/pkg/NAMESPACE | 1 + R/pkg/R/utils.R | 36 +++++++++++++---------- R/pkg/inst/worker/worker.R | 7 ++++- R/pkg/src/Makefile | 4 +-- R/pkg/src/Makefile.win | 4 +-- R/pkg/src/{string_hash_code.c => utils.c} | 19 ++++++++---- 6 files changed, 45 insertions(+), 26 deletions(-) rename R/pkg/src/{string_hash_code.c => utils.c} (93%) diff --git a/R/pkg/NAMESPACE b/R/pkg/NAMESPACE index 80283643861ac..681352dfd4d27 100644 --- a/R/pkg/NAMESPACE +++ b/R/pkg/NAMESPACE @@ -91,6 +91,7 @@ export("sparkR.init") export("sparkR.stop") export("print.jobj") useDynLib(SparkR, stringHashCode) +useDynLib(SparkR, getMissingArg) importFrom(methods, setGeneric, setMethod, setOldClass) # SparkRSQL diff --git a/R/pkg/R/utils.R b/R/pkg/R/utils.R index bb77c853adcb6..f3f0527d27002 100644 --- a/R/pkg/R/utils.R +++ b/R/pkg/R/utils.R @@ -336,53 +336,55 @@ listToSeq <- function(l) { # if their values should be included in the new function environment. # param # node The current AST node in the traversal. +# newEnv A new function environment to store necessary function dependencies, an output argument. # oldEnv The original function environment. # defVars An Accumulator of variables names defined in the function's calling environment, # including function argument and local variable names. # checkedFunc An environment of function objects examined during cleanClosure. It can # be considered as a "name"-to-"list of functions" mapping. -# newEnv A new function environment to store necessary function dependencies, an output argument. -processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { +processClosure <- function(node, newEnv, oldEnv = environment(), defVars = initAccumulator(), + checkedFuncs = new.env()) { nodeLen <- length(node) if (nodeLen > 1 && typeof(node) == "language") { # Recursive case: current AST node is an internal node, check for its children. if (length(node[[1]]) > 1) { for (i in 1:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs) } } else { # if node[[1]] is length of 1, check for some R special functions. nodeChar <- as.character(node[[1]]) if (nodeChar == "{" || nodeChar == "(") { # Skip start symbol. for (i in 2:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs) } } else if (nodeChar == "<-" || nodeChar == "=" || nodeChar == "<<-") { # Assignment Ops. for (i in 3:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs) } defVar <- node[[2]] if (length(defVar) == 1 && typeof(defVar) == "symbol") { # Add the defined variable name into defVars. addItemToAccumulator(defVars, as.character(defVar)) } else { - processClosure(node[[2]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[2]], newEnv, oldEnv, defVars, checkedFuncs) } } else if (nodeChar == "function") { # Function definition. # Add parameter names. newArgs <- names(node[[2]]) lapply(newArgs, function(arg) { addItemToAccumulator(defVars, arg) }) for (i in 3:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs) } + defVars$counter <- defVars$counter - length(newArgs) } else if (nodeChar == "$") { # Skip the field. - processClosure(node[[2]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[2]], newEnv, oldEnv, defVars, checkedFuncs) } else if (nodeChar == "::" || nodeChar == ":::") { - processClosure(node[[3]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[3]], newEnv, oldEnv, defVars, checkedFuncs) } else { for (i in 1:nodeLen) { - processClosure(node[[i]], oldEnv, defVars, checkedFuncs, newEnv) + processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs) } } } @@ -390,14 +392,13 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { (typeof(node) == "symbol" || typeof(node) == "language")) { # Base case: current AST node is a leaf node and a symbol or a function call. nodeChar <- as.character(node) - if (!nodeChar %in% defVars$data) { # Not a function parameter or local variable. + if (!nodeChar %in% defVars$data[1:defVars$counter]) { # Not a function parameter or local variable. func.env <- oldEnv topEnv <- parent.env(.GlobalEnv) # Search in function environment, and function's enclosing environments # up to global environment. There is no need to look into package environments # above the global, as they are assumed to be loaded on workers. while (!identical(func.env, topEnv)) { - # Namespaces other than "SparkR" will not be searched. # Only examine functions in non-namespace environments or private functions in # package namespaces. if (!isNamespace(func.env) || @@ -407,7 +408,12 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { # attached package environments. if (tryCatch(exists(nodeChar, envir = func.env, inherits = FALSE), error = function(e) { FALSE })) { - obj <- get(nodeChar, envir = func.env, inherits = FALSE) + obj <- tryCatch(get(nodeChar, envir = func.env, inherits = FALSE), + error = function(e) { .Call("getMissingArg") }) + if (missing(obj)) { + assign(nodeChar, .Call("getMissingArg"), envir = newEnv) + break + } if (is.function(obj)) { # If the node is a function call. funcList <- mget(nodeChar, envir = checkedFuncs, inherits = F, ifnotfound = list(list(NULL)))[[1]] @@ -432,7 +438,7 @@ processClosure <- function(node, oldEnv, defVars, checkedFuncs, newEnv) { assign(nodeChar, newFuncList, envir = checkedFuncs) } else { remove(list = nodeChar, envir = checkedFuncs) - } + } } assign(nodeChar, obj, envir = newEnv) break @@ -468,7 +474,7 @@ cleanClosure <- function(func, checkedFuncs = new.env()) { addItemToAccumulator(defVars, argNames[i]) } # Recursively examine variables in the function body. - processClosure(func.body, oldEnv, defVars, checkedFuncs, newEnv) + processClosure(func.body, newEnv, oldEnv, defVars, checkedFuncs) environment(func) <- newEnv } func diff --git a/R/pkg/inst/worker/worker.R b/R/pkg/inst/worker/worker.R index 014bf7bd7b3fe..2e98cd38be4e4 100644 --- a/R/pkg/inst/worker/worker.R +++ b/R/pkg/inst/worker/worker.R @@ -61,7 +61,12 @@ for (pkg in packageNames) { funcLen <- SparkR:::readInt(inputCon) computeFunc <- unserialize(SparkR:::readRawLen(inputCon, funcLen)) env <- environment(computeFunc) -parent.env(env) <- .GlobalEnv # Attach under global environment. +# parent.env(env) <- .GlobalEnv # Attach under global environment. +if (length(packageNames) > 0) { + parent.env(env) <- getNamespace(packageNames[1]) # Attach under package namespace environment. +} else { + parent.env(env) <- .GlobalEnv # Attach under global environment. +} # Timing init envs for computing initElap <- elapsedSecs() diff --git a/R/pkg/src/Makefile b/R/pkg/src/Makefile index a55a56fe80e10..7d4d4d02f3c6f 100644 --- a/R/pkg/src/Makefile +++ b/R/pkg/src/Makefile @@ -17,8 +17,8 @@ all: sharelib -sharelib: string_hash_code.c - R CMD SHLIB -o SparkR.so string_hash_code.c +sharelib: utils.c + R CMD SHLIB -o SparkR.so utils.c clean: rm -f *.o diff --git a/R/pkg/src/Makefile.win b/R/pkg/src/Makefile.win index aa486d8228371..a1d115a56f480 100644 --- a/R/pkg/src/Makefile.win +++ b/R/pkg/src/Makefile.win @@ -17,8 +17,8 @@ all: sharelib -sharelib: string_hash_code.c - R CMD SHLIB -o SparkR.dll string_hash_code.c +sharelib: utils.c + R CMD SHLIB -o SparkR.dll utils.c clean: rm -f *.o diff --git a/R/pkg/src/string_hash_code.c b/R/pkg/src/utils.c similarity index 93% rename from R/pkg/src/string_hash_code.c rename to R/pkg/src/utils.c index e3274b9a0c547..6aa88502fb07b 100644 --- a/R/pkg/src/string_hash_code.c +++ b/R/pkg/src/utils.c @@ -15,12 +15,6 @@ limitations under the License. */ -/* - * A C function for R extension which implements the Java String hash algorithm. - * Refer to http://en.wikipedia.org/wiki/Java_hashCode%28%29#The_java.lang.String_hash_function - * - */ - #include #include @@ -29,6 +23,11 @@ #define IS_SCALAR(x, type) (TYPEOF(x) == (type) && XLENGTH(x) == 1) #endif +/* + * A C function for R extension which implements the Java String hash algorithm. + * Refer to http://en.wikipedia.org/wiki/Java_hashCode%28%29#The_java.lang.String_hash_function + * + */ SEXP stringHashCode(SEXP string) { const char* str; R_xlen_t len, i; @@ -47,3 +46,11 @@ SEXP stringHashCode(SEXP string) { return ScalarInteger(hashCode); } + +/* + * Get the value of missing argument symbol. + */ +SEXP getMissingArg() { + return R_MissingArg; +} + From d7b3ed95ff154e3af6609323184d5969839a09a9 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Wed, 13 May 2015 16:18:22 -0400 Subject: [PATCH 4/7] Adds private function tests. --- R/pkg/inst/tests/test_utils.R | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/R/pkg/inst/tests/test_utils.R b/R/pkg/inst/tests/test_utils.R index c09ffdf0310e1..a3300a9ffdbbb 100644 --- a/R/pkg/inst/tests/test_utils.R +++ b/R/pkg/inst/tests/test_utils.R @@ -92,13 +92,10 @@ test_that("cleanClosure on R functions", { f(res) # Test for recursive calls. h(res) # f should be examined again in h's env. More recursive call f -> h -> f ... } - newF <- SparkR:::cleanClosure(f) + newF <- cleanClosure(f) env <- environment(newF) - expect_equal(length(ls(env)), 4) # "g", "l", "f" and "h". No "base", "field" or "defUse". - # TODO(shivaram): length(ls(env)) is 4 here for some reason and `lapply` is included in `env`. - # Disabling this test till we debug this. - # - # expect_equal(length(ls(env)), 3) # Only "g", "l" and "f". No "base", "field" or "defUse". + # "g", "l", "f", "h" and "lapply" (private in SparkR). No "base", "field" or "defUse". + expect_equal(length(ls(env)), 5) expect_true("g" %in% ls(env)) expect_true("l" %in% ls(env)) expect_true("f" %in% ls(env)) @@ -117,17 +114,29 @@ test_that("cleanClosure on R functions", { actual <- get("f", envir = env, inherits = FALSE) expect_equal(actual, f) - # Test for function (and variable) definitions. + # Test for function (and variable) definitions and package private functions. z <- c(1, 2) - f <- function(x) { + f <- function(x, y) { + privateCallRes <- unlist(joinTaggedList(x, y)) g <- function(y) { y * 2 } z <- z * 2 # Write after read. - g(x) + g(privateCallRes) # Calls "g()" in enclosure, not local var "g". } newF <- cleanClosure(f) env <- environment(newF) - expect_equal(length(ls(env)), 1) # "z". No y" or "g". + expect_equal(length(ls(env)), 2) # "z" and "joinTaggedList". No y" or "g". + expect_true("joinTaggedList" %in% ls(env)) expect_true("z" %in% ls(env)) + actual <- get("joinTaggedList", envir = env, inherits = FALSE) + expect_equal(actual, joinTaggedList) + env <- environment(actual) + # Private "genCompactLists" and "mergeCompactLists" are called by "joinTaggedList". + expect_true("genCompactLists" %in% ls(env)) + expect_true("mergeCompactLists" %in% ls(env)) + actual <- get("genCompactLists", envir = env, inherits = FALSE) + expect_equal(actual, genCompactLists) + actual <- get("mergeCompactLists", envir = env, inherits = FALSE) + expect_equal(actual, mergeCompactLists) # Test for overriding variables in base namespace (Issue: SparkR-196). nums <- as.list(1:10) From 6c43f6e07e10c33ad96dcb6f7dfa7cc3d3e00d48 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Wed, 13 May 2015 16:43:41 -0400 Subject: [PATCH 5/7] Add test for missing arg. --- R/pkg/inst/tests/test_utils.R | 7 +++++-- R/pkg/inst/worker/worker.R | 7 +------ 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/R/pkg/inst/tests/test_utils.R b/R/pkg/inst/tests/test_utils.R index a3300a9ffdbbb..32d5234dbd30a 100644 --- a/R/pkg/inst/tests/test_utils.R +++ b/R/pkg/inst/tests/test_utils.R @@ -118,9 +118,12 @@ test_that("cleanClosure on R functions", { z <- c(1, 2) f <- function(x, y) { privateCallRes <- unlist(joinTaggedList(x, y)) - g <- function(y) { y * 2 } + g <- function(y, ...) { + list(...) + y * 2 + } z <- z * 2 # Write after read. - g(privateCallRes) # Calls "g()" in enclosure, not local var "g". + g(privateCallRes) # Missing arg. } newF <- cleanClosure(f) env <- environment(newF) diff --git a/R/pkg/inst/worker/worker.R b/R/pkg/inst/worker/worker.R index 9a020966757c4..7e3b5fc403b25 100644 --- a/R/pkg/inst/worker/worker.R +++ b/R/pkg/inst/worker/worker.R @@ -61,12 +61,7 @@ for (pkg in packageNames) { funcLen <- SparkR:::readInt(inputCon) computeFunc <- unserialize(SparkR:::readRawLen(inputCon, funcLen)) env <- environment(computeFunc) -# parent.env(env) <- .GlobalEnv # Attach under global environment. -if (length(packageNames) > 0) { - parent.env(env) <- getNamespace(packageNames[1]) # Attach under package namespace environment. -} else { - parent.env(env) <- .GlobalEnv # Attach under global environment. -} +parent.env(env) <- .GlobalEnv # Attach under global environment. # Timing init envs for computing initElap <- elapsedSecs() From 0addf88c65e6dcb34cac8cecffbad54ad251e710 Mon Sep 17 00:00:00 2001 From: hlin09 Date: Wed, 13 May 2015 17:27:37 -0400 Subject: [PATCH 6/7] Fixes test. --- R/pkg/inst/tests/test_utils.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/pkg/inst/tests/test_utils.R b/R/pkg/inst/tests/test_utils.R index 32d5234dbd30a..cbe356f7643b8 100644 --- a/R/pkg/inst/tests/test_utils.R +++ b/R/pkg/inst/tests/test_utils.R @@ -116,10 +116,11 @@ test_that("cleanClosure on R functions", { # Test for function (and variable) definitions and package private functions. z <- c(1, 2) + miss <- .Call("getMissingArg") # simulate a missing arg passing in by enclosing call. f <- function(x, y) { privateCallRes <- unlist(joinTaggedList(x, y)) - g <- function(y, ...) { - list(...) + g <- function(y) { + miss # access to missing arg. y * 2 } z <- z * 2 # Write after read. @@ -127,9 +128,10 @@ test_that("cleanClosure on R functions", { } newF <- cleanClosure(f) env <- environment(newF) - expect_equal(length(ls(env)), 2) # "z" and "joinTaggedList". No y" or "g". + expect_equal(length(ls(env)), 3) # "miss", z" and "joinTaggedList". No y" or "g". expect_true("joinTaggedList" %in% ls(env)) expect_true("z" %in% ls(env)) + expect_true("miss" %in% ls(env)) actual <- get("joinTaggedList", envir = env, inherits = FALSE) expect_equal(actual, joinTaggedList) env <- environment(actual) From 26a1743318fcfe64b96f7f036a788d4f7ea7396f Mon Sep 17 00:00:00 2001 From: hlin09 Date: Wed, 13 May 2015 17:38:37 -0400 Subject: [PATCH 7/7] Ignore the '::' case. --- R/pkg/R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/pkg/R/utils.R b/R/pkg/R/utils.R index f3f0527d27002..874ca8544d816 100644 --- a/R/pkg/R/utils.R +++ b/R/pkg/R/utils.R @@ -381,7 +381,7 @@ processClosure <- function(node, newEnv, oldEnv = environment(), defVars = initA } else if (nodeChar == "$") { # Skip the field. processClosure(node[[2]], newEnv, oldEnv, defVars, checkedFuncs) } else if (nodeChar == "::" || nodeChar == ":::") { - processClosure(node[[3]], newEnv, oldEnv, defVars, checkedFuncs) + # No need to process. Ignore. } else { for (i in 1:nodeLen) { processClosure(node[[i]], newEnv, oldEnv, defVars, checkedFuncs)