Fix stubbing for functions which contain assignment functions

The parsing was failing because `foo::bar<-` is not parse-able, however

    foo::`bar<-`

Is parse-able, so that is what we do now. A related issue was the
mangling was creating names like `fooXXXbar<-`, which again is not
parse-able, so that was changed to quote the whole name with backticks.

Fixes #23

NEWS

@@ -1,3 +1,7 @@
+v dev
+
+`stub()` now works if the function being stubbed contains assignment functions (@jimhester, #23).
+
 v 0.4.1
 
 Fix bug whereby functions that begin with `.` don't have things mocked out in

R/stub.R

@@ -98,6 +98,10 @@ override_seperators = function(name, env) {
     return(if (exists('mangled_name')) mangled_name else name)
 }
 
+backtick <- function(x) {
+    encodeString(x, quote = "`", na.encode = FALSE)
+}
+
 create_create_new_name_function <- function(stub_list, env, sep)
 {
     force(stub_list)
@@ -110,15 +114,15 @@ create_create_new_name_function <- function(stub_list, env, sep)
         func_name <- deparse(substitute(func))
         for(stub in stub_list) {
             if (paste(pkg_name, func_name, sep='XXX') == stub) {
-                return(eval(parse(text = stub), env))
+                return(eval(parse(text = backtick(stub)), env))
             }
         }
 
         # used to avoid recursively calling the replacement function
         eval_env = new.env(parent=parent.frame())
         assign(sep, eval(parse(text=paste0('`', sep, '`'))), eval_env)
 
-        code = paste(pkg_name, func_name, sep=sep)
+        code = paste(pkg_name, backtick(func_name), sep=sep)
         return(eval(parse(text=code), eval_env))
     }
     attributes(create_new_name) <- list(stub_list=stub_list)

tests/testthat/test_stub.R

@@ -330,3 +330,16 @@ test_that('mocks hidden functions', {
     stub(.a, 'h', stub_string, depth=4)
     expect_equal(f(1), 'called stub!called stub!called stub!called stub!called stub!')
 })
+
+test_that("Does not error if function contains double quoted assignment functions", {
+    f <- function(x, nms) {
+      base::names(x) <- base::tolower(nms)
+      x
+    }
+
+    stub(f, "base::tolower", toupper)
+    expect_equal(f(1, "b"), c(B = 1))
+
+    stub(f, "base::names<-", function(x, value) stats::setNames(x, "d"))
+    expect_equal(f(1, "b"), c(d = 1))
+})