[rkward-cvs] SF.net SVN: rkward:[4270] trunk/rkward/rkward/rbackend/rpackages/ rkwardtests/R

[m-eik at users.sourceforge.net]

Revision: 4270
          http://rkward.svn.sourceforge.net/rkward/?rev=4270&view=rev
Author:   m-eik
Date:     2012-06-03 13:56:16 +0000 (Sun, 03 Jun 2012)
Log Message:
-----------
rkwardtests: fix some errors which were caused by volatile function replacements

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R
    trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R

Modified: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R	2012-06-03 13:53:36 UTC (rev 4269)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R	2012-06-03 13:56:16 UTC (rev 4270)
@@ -163,33 +163,47 @@
 }
 
 ## Convenience functions for replacing / restoring functions for the test runs
-rktest.replace <- function (name, replacement, envir=as.environment ("package:rkward"), backup.name=name) {
-	if (exists (backup.name, envir=.rktest.tmp.storage, inherits=FALSE)) {
+rktest.replace <- function (name, replacement, envir=as.environment ("package:rkward"), backup.name=name, targetEnv=.rktest.tmp.storage) {
+	if (exists (backup.name, envir=targetEnv, inherits=FALSE)) {
 		message ("It looks like ", name, " has already been replaced. Not replacing it again.")
 	} else {
 # 		# Apparently R 2.14.x starts forcing namespaces for all packages, which makes things a bit more difficult
 		if (identical (envir, as.environment ("package:rkward"))) {
-			try (rktest.replace (name, replacement, asNamespace ("rkward"), backup.name), silent=TRUE)
+			replacementWorked <- tryCatch(
+				rktest.replace (name, replacement, asNamespace ("rkward"), backup.name),
+				error=function(e) return(FALSE)
+			)
+			if(is.null(replacementWorked)){
+				return(invisible(NULL))
+			}
 		}
 
-		assign (backup.name, get (name, envir), envir=.rktest.tmp.storage)
+		assign (backup.name, get (name, envir), envir=targetEnv)
 
 		environment (replacement) <- envir
 		try (unlockBinding (name, envir))
 		assign (name, replacement, envir)
 	}
+	return(invisible(NULL))
 }
 
-rktest.restore <- function (name, envir=as.environment ("package:rkward"), backup.name=name) {
-	if (exists (backup.name, envir=.rktest.tmp.storage, inherits=FALSE)) {
-		assign (name, get (backup.name, envir=.rktest.tmp.storage), envir=envir)
+rktest.restore <- function (name, envir=as.environment ("package:rkward"), backup.name=name, targetEnv=.rktest.tmp.storage) {
+	if (exists (backup.name, envir=targetEnv, inherits=FALSE)) {
 		if (identical (envir, as.environment ("package:rkward"))) {
-			try (assign (name, get (backup.name, envir=.rktest.tmp.storage), envir=asNamespace ("rkward")), silent=TRUE)
+			replacementWorked <- tryCatch(
+				rktest.restore (name, envir=asNamespace ("rkward"), backup.name),
+				error=function(e) return(FALSE)
+			)
+			if(is.null(replacementWorked)){
+				return(invisible(NULL))
+			}
 		}
+		assign (name, get (backup.name, envir=targetEnv), envir=envir)
+		rm (list=backup.name, envir=targetEnv)
 	} else {
 		message ("No backup available for ", name, ". Already restored?")
 	}
-	rm (list=backup.name, envir=.rktest.tmp.storage)
+	return(invisible(NULL))
 }
 
 ## Initialize test environment
@@ -213,7 +227,10 @@
 
 	# Make sure i18n does not get in the way
 	invisible (Sys.setenv (LANGUAGE="C"))
-	if (.Platform$OS.type == "unix") invisible (Sys.setlocale ("LC_MESSAGES", "C"))
+	invisible (Sys.setenv (LANG="C"))
+	if (.Platform$OS.type == "unix"){
+		invisible (Sys.setlocale (category="LC_MESSAGES", locale="C"))
+	}
 	options (useFancyQuotes=FALSE)
 
 	# This version of rk.set.output.html.file does not notify the frontend of the change. Without this, you'll get lots of output windows.

Modified: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R	2012-06-03 13:53:36 UTC (rev 4269)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R	2012-06-03 13:56:16 UTC (rev 4270)
@@ -3,13 +3,13 @@
 #' \tabular{ll}{
 #' Package: \tab rkwardtests\cr
 #' Type: \tab Package\cr
-#' Version: \tab 0.5.5\cr
-#' Date: \tab 2010-10-14\cr
+#' Version: \tab 0.5.7\cr
+#' Date: \tab 2012-06-03\cr
 #' Depends: \tab R (>= 2.9.0),methods\cr
 #' Encoding: \tab UTF-8\cr
-#' License: \tab GPL (>= 3)\cr
+#' License: \tab GPL (>= 2)\cr
 #' LazyLoad: \tab yes\cr
-#' URL: \tab http://rkward.sourceforge.net \cr
+#' URL: \tab http://rkward.sourceforge.net\cr
 #' }
 #'
 #' A set of functions, classes and methods to test plugins that were written for RKWard.
@@ -18,8 +18,6 @@
 #' @name rkwardtests-package
 #' @docType package
 #' @title RKWard Plugin Test Suite Framework.
-#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}, Meik Michalke \email{meik.michalke@@uni-duesseldorf.de}
+#' @author Thomas Friedrichsmeier, Meik Michalke
 #' @keywords package
-#' @seealso \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}
-roxygen <- function() NULL
-roxygen()
+NULL

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.