Skip to content

Commit

Permalink
Merge pull request #3466 from rstudio/wch-exprfunction-fix
Browse files Browse the repository at this point in the history
  • Loading branch information
@wch
wch authored Jul 16, 2021
2 parents aba6b2e + 30c0a2b commit ed3c676
Show file tree
Hide file tree
Showing 3 changed files with 212 additions and 13 deletions.
2 changes: 1 addition & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ shiny 1.6.0.9000

* All uses of `list(...)` have been replaced with `rlang::list2(...)`. This means that you can use trailing `,` without error and use rlang's `!!!` operator to "splice" a list of argument values into `...`. We think this'll be particularly useful for passing a list of `tabPanel()` to their consumers (i.e., `tabsetPanel()`, `navbarPage()`, etc). For example, `tabs <- list(tabPanel("A", "a"), tabPanel("B", "b")); navbarPage(!!!tabs)`. (#3315 and #3328)

* `installExprFunction()` and `exprToFunction()` are now able to handle quosures, so `render`-functions which call these functions can now understand quosures, when they are called using `rlang::inject()`. This also means that `render` function no longer need `env` and `quoted` parameters; that information can be embedded into a quosure which is then passed to the `render` function. Additionally, the `getQuosure()` function was added, which makes it easier for developers to create `render` functions which understand quosures. Better documentation was added for how to create `render` functions. (#3462)
* `installExprFunction()` and `exprToFunction()` are now able to handle quosures, so `render`-functions which call these functions can now understand quosures, when they are called using `rlang::inject()`. This also means that `render` function no longer need `env` and `quoted` parameters; that information can be embedded into a quosure which is then passed to the `render` function. Additionally, the `getQuosure()` function was added, which makes it easier for developers to create `render` functions which understand quosures. Better documentation was added for how to create `render` functions. (#3462, #3466)

* `icon(lib="fontawesome")` is now powered by the `{fontawesome}` package, which will make it easier to use the latest FA icons in the future (by updating the `{fontawesome}` package). (#3302)

Expand Down
32 changes: 26 additions & 6 deletions R/utils-lang.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -202,9 +202,19 @@ getQuosure <- function(x, env, quoted) {
# x <- new_quosure(x, env = parent.frame())
# }
# }
if (!eval(substitute(missing(env)), parent.frame()) ||
!eval(substitute(missing(quoted)), parent.frame()))
{

# TRUE if either the immediate caller (the renderXX function) or caller two
# frames back (the user's call to `renderXX()` passed in an environment.)
called_with_env <-
!missing(env) ||
!eval(substitute(missing(env)), parent.frame())

# Same as above, but with `quoted`
called_with_quoted <-
!missing(quoted) ||
!eval(substitute(missing(quoted)), parent.frame())

if (called_with_env || called_with_quoted) {
deprecatedEnvQuotedMessage()
if (!quoted) {
x <- eval(substitute(substitute(x)), parent.frame())
Expand Down Expand Up @@ -255,9 +265,19 @@ getQuosure3 <- function(x, env, quoted) {
# This code path is used when `getQuosure3(x, env, quoted)` is
# called.

if (!eval(eval(substitute(substitute(missing(env))), parent.frame()), parent.frame(2)) ||
!eval(eval(substitute(substitute(missing(quoted))), parent.frame()), parent.frame(2)))
{
# TRUE if either the immediate caller (exprToFunction or
# installExprFunction) or caller two frames back (the user's call to
# `renderXX()` passed in an environment.)
called_with_env <-
!eval(substitute(missing(env)), parent.frame()) ||
!eval(eval(substitute(substitute(missing(env))), parent.frame()), parent.frame(2))

# Same as above, but with `quoted`
called_with_quoted <-
!eval(substitute(missing(quoted)), parent.frame()) ||
!eval(eval(substitute(substitute(missing(quoted))), parent.frame()), parent.frame(2))

if (called_with_env || called_with_quoted) {
deprecatedEnvQuotedMessage()
if (!quoted) {
x <- eval(eval(substitute(substitute(substitute(x))), parent.frame()), parent.frame(2))
Expand Down
191 changes: 185 additions & 6 deletions tests/testthat/test-render-functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,20 +35,80 @@ test_that("Render functions correctly handle quosures", {


test_that("Custom render functions with correctly handle quosures", {
# Four ways to create custom render functions:
# - exprToFunction
# - installExprFunction
# Many ways to create custom render functions:
# - exprToFunction(expr, env, quoted)
# - exprToFunction(expr, env, TRUE)
# - installExprFunction(expr, env, quoted)
# - installExprFunction(expr, env, TRUE)
# - quoToFunction(expr, env, quoted) <-- For backward compatbility
# - quoToFunction(expr, env, TRUE) <-- For backward compatbility
# - quoToFunction(expr) <-- Recommended way going forward

# exprToFunction
# ==============================================
# exprToFunction(expr, env, quoted)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
func <- shiny::exprToFunction(expr, env, quoted)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
a <- 2
expect_identical(r1(), "1, 1")
expect_identical(r2(), "2, 2")


# ==============================================
# exprToFunction(expr, env, TRUE)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) expr <- substitute(expr)
func <- shiny::exprToFunction(expr, env, quoted = TRUE)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
Expand All @@ -57,14 +117,71 @@ test_that("Custom render functions with correctly handle quosures", {
expect_identical(r2(), "2, 2")


# installExprFunction
# ==============================================
# installExprFunction(expr, env, quoted)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
installExprFunction(expr, "func", env, quoted)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
a <- 2
expect_identical(r1(), "1, 1")
expect_identical(r2(), "2, 2")


# ==============================================
# installExprFunction(expr, env, TRUE)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) expr <- substitute(expr)
installExprFunction(expr, "func", env, quoted = TRUE)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
Expand All @@ -73,6 +190,7 @@ test_that("Custom render functions with correctly handle quosures", {
expect_identical(r2(), "2, 2")


# ==============================================
# quoToFunction(expr, env, quoted)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
q <- getQuosure(expr, env, quoted)
Expand All @@ -82,6 +200,25 @@ test_that("Custom render functions with correctly handle quosures", {
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
Expand All @@ -97,6 +234,45 @@ test_that("Custom render functions with correctly handle quosures", {
expect_identical(r2(), "2, 2")


# ==============================================
# quoToFunction(expr, env, TRUE)
renderDouble <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) expr <- substitute(expr)
q <- getQuosure(expr, env, TRUE)
func <- quoToFunction(q)
function() {
value <- func()
paste(rep(value, 2), collapse=", ")
}
}

# Different usages of env and quoted param
a <- 1
e <- new.env()
e$a <- 2
r <- renderDouble(a + 1)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, quoted = FALSE)
expect_identical(r(), "2, 2")
r <- renderDouble(quote(a + 1), quoted = TRUE)
expect_identical(r(), "2, 2")
r <- renderDouble(a + 1, env = e)
expect_identical(r(), "3, 3")
r <- renderDouble(a + 1, env = e, quoted = FALSE)
expect_identical(r(), "3, 3")
r <- renderDouble(quote(a + 1), env = e, quoted = TRUE)
expect_identical(r(), "3, 3")

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
a <- 2
expect_identical(r1(), "1, 1")
expect_identical(r2(), "2, 2")


# ==============================================
# quoToFunction(expr)
renderDouble <- function(expr) {
q <- getQuosure(expr)
Expand All @@ -106,9 +282,12 @@ test_that("Custom render functions with correctly handle quosures", {
paste(rep(value, 2), collapse=", ")
}
}

# Quosures
a <- 1
r1 <- inject(renderDouble({ !!a }))
r2 <- renderDouble({ eval_tidy(quo(!!a)) })
a <- 2
expect_identical(r1(), "1, 1")
expect_identical(r2(), "2, 2")})
expect_identical(r2(), "2, 2")
})

0 comments on commit ed3c676

Please sign in to comment.