From 907c07872b24bf736fdc3000c941919055f98968 Mon Sep 17 00:00:00 2001
From: Jim Hester <james.f.hester@gmail.com>
Date: Thu, 29 Aug 2019 09:27:21 -0400
Subject: [PATCH] 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                       |  4 ++++
 R/stub.R                   |  8 ++++++--
 tests/testthat/test_stub.R | 13 +++++++++++++
 3 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 223c4ba..afd2b04 100644
--- a/NEWS
+++ b/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
diff --git a/R/stub.R b/R/stub.R
index f57dfa3..32402ff 100644
--- a/R/stub.R
+++ b/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,7 +114,7 @@ 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))
             }
         }
 
@@ -118,7 +122,7 @@ create_create_new_name_function <- function(stub_list, env, sep)
         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)
diff --git a/tests/testthat/test_stub.R b/tests/testthat/test_stub.R
index 43275b7..eb53ec4 100644
--- a/tests/testthat/test_stub.R
+++ b/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))
+})