Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

249 remove check for datanames parameter being a subset of datanames(teal_data) in get_code(teal_data) #250

Merged
merged 3 commits into from
Jan 16, 2024
Merged

249 remove check for datanames parameter being a subset of datanames(teal_data) in get_code(teal_data) #250

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f4faf0d
remove check for datanames being a subset of dartanames(teal_data) in…
m7pr Jan 16, 2024
a350011
Update tests/testthat/test-get_code.R
m7pr Jan 16, 2024
060248c
Update tests/testthat/test-get_code.R
m7pr Jan 16, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions R/teal_data-get_code.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,6 @@
#' c <- list(x = 2)
#' })
#' get_code(tdata1)
#' datanames(tdata1) <- c("a", "b", "c")
#' get_code(tdata1, datanames = "a")
#' get_code(tdata1, datanames = "b")
#'
Expand All @@ -39,7 +38,6 @@
#' @export
setMethod("get_code", signature = "teal_data", definition = function(object, deparse = TRUE, datanames = NULL) {
checkmate::assert_character(datanames, min.len = 1L, null.ok = TRUE)
checkmate::assert_subset(datanames, datanames(object))
checkmate::assert_flag(deparse)

code <- if (!is.null(datanames)) {
Expand Down
1 change: 0 additions & 1 deletion man/get_code-teal_data-method.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

40 changes: 3 additions & 37 deletions tests/testthat/test-get_code.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,6 @@ testthat::test_that("get_code with datanames extracts code of a binding from cha
"b <- 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "a"),
"a <- 1"
Expand All @@ -47,23 +46,18 @@ testthat::test_that("get_code works for datanames of length > 1", {
"b <- 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = c("a", "b")),
paste("a <- 1", "b <- 2", sep = "\n")
m7pr marked this conversation as resolved.
Show resolved Hide resolved
)
})

testthat::test_that("get_code with datanames warns if binding doesn't exist in code", {
code <- c(
"a <- 1",
"b <- 2"
)
code <- c("a <- 1")
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_error(
testthat::expect_warning(
get_code(tdata, datanames = "c"),
"Assertion on 'datanames' failed"
"Object\\(s\\) not found in code: c"
)
})

Expand All @@ -75,7 +69,6 @@ testthat::test_that("get_code with datanames does not fall into a loop", {
"a <- c"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b", "c")
testthat::expect_identical(
get_code(tdata, datanames = "a"),
paste(code, collapse = "\n")
Expand All @@ -100,7 +93,6 @@ testthat::test_that(
"a <- 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- a", sep = "\n")
Expand All @@ -115,7 +107,6 @@ testthat::test_that("get_code with datanames extracts code of a parent binding i
"a <- 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- identity(x = a)", sep = "\n")
Expand All @@ -129,7 +120,6 @@ testthat::test_that("get_code with datanames is possible to output the code for
"c <- 3"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b", "c")
testthat::expect_identical(
get_code(tdata, datanames = c("a", "b")),
paste("a <- 1", "b <- 2", sep = "\n")
m7pr marked this conversation as resolved.
Show resolved Hide resolved
Expand All @@ -145,7 +135,6 @@ testthat::test_that("get_code with datanames can extract the code for assign fun
"c <- b"
)
tdata <- eval_code(teal_data(), code)
chlebowa marked this conversation as resolved.
Show resolved Hide resolved
datanames(tdata) <- c("a", "b", "c")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("assign(\"b\", 5)", "b <- b + 2", sep = "\n")
Expand All @@ -172,7 +161,6 @@ testthat::test_that(
"b <- a"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("x", "a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste(code, sep = "\n")
Expand All @@ -188,7 +176,6 @@ testthat::test_that("@linksto tag indicate affected object if object is assigned
"b <- b + 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("assign(\"b\", 5)", "b <- b + 2", sep = "\n")
Expand All @@ -203,7 +190,6 @@ testthat::test_that(
"iris2 <- head(iris)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("iris2")
testthat::expect_identical(
get_code(tdata, datanames = "iris2"),
paste("data(iris)", "iris2 <- head(iris)", sep = "\n")
Expand All @@ -218,7 +204,6 @@ testthat::test_that("get_code with datanames can extract the code when using <<-
"b <<- b + 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- a", "b <<- b + 2", sep = "\n")
Expand All @@ -232,7 +217,6 @@ testthat::test_that("get_code with datanames detects every assign calls even if
"eval(expression({b <- b + 2}))"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("b <- 2", "eval(expression({\n b <- b + 2\n}))", sep = "\n")
Expand Down Expand Up @@ -260,7 +244,6 @@ testthat::test_that("@linksto cause to return this line for affected binding", {
b <- 2
"
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- 2", sep = "\n")
Expand All @@ -276,7 +259,6 @@ testthat::test_that(
"b <- 2"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- 2", sep = "\n")
Expand All @@ -293,7 +275,6 @@ testthat::test_that(
"b <- 2 # @linksto a"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "a"),
paste("a <- 1", "b <- 2", sep = "\n")
Expand All @@ -310,7 +291,6 @@ testthat::test_that(
"a <- 3"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- a", sep = "\n")
Expand All @@ -329,7 +309,6 @@ testthat::test_that(
"b <- b + 1"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "a"),
paste("a <- 1", "b <- 2", "a <- a + 1", sep = "\n")
Expand All @@ -350,7 +329,6 @@ testthat::test_that(
classes <- lapply(iris2, class)
"
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("iris2", "iris_head", "classes")
testthat::expect_identical(
get_code(tdata, datanames = "classes"),
paste("iris2 <- iris[1:5, ]", "iris_head <- head(iris)", "classes <- lapply(iris2, class)", sep = "\n")
Expand All @@ -368,7 +346,6 @@ testthat::test_that(
classes <- lapply(iris2, class)
"
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("iris2", "iris_head", "iris3", "classes")
testthat::expect_identical(
get_code(tdata, datanames = "classes"),
paste("iris2 <- iris[1:5, ]",
Expand All @@ -389,7 +366,6 @@ testthat::test_that("get_code with datanames ignores occurrence in function defi
"foo <- function(b) { b <- b + 2 }"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("b", "foo")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
"b <- 2"
Expand All @@ -409,7 +385,6 @@ testthat::test_that("get_code with datanames ignores occurrence in function defi
"print(x)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b", "x")
testthat::expect_identical(
get_code(tdata, datanames = "x"),
paste("x <- 1", "print(x)", sep = "\n")
Expand All @@ -425,7 +400,6 @@ testthat::test_that("get_code with datanames does not ignore occurrence in funct
"b <- Filter(function(x) x > 2, b)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "p", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste(code, sep = "\n")
Expand All @@ -438,7 +412,6 @@ testthat::test_that("get_code with datanames ignores occurrence in function defi
"foo <- function(b) b <- b + 2 "
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("b", "foo")
testthat::expect_identical(
get_code(tdata, datanames = "foo"),
"foo <- function(b) b <- b + 2"
Expand All @@ -456,7 +429,6 @@ testthat::test_that("get_code with datanames returns custom function calls on ob
"foo(b)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("b", "foo")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("b <- 2", "foo <- function(b) {\n b <- b + 2\n}", "foo(b)", sep = "\n")
Expand All @@ -471,7 +443,6 @@ testthat::test_that("get_code with datanames detects occurrence of the function
"b <- foo(a)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b", "foo")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- 2", "foo <- function(b) {\n b <- b + 2\n}", "b <- foo(a)", sep = "\n")
Expand All @@ -487,7 +458,6 @@ testthat::test_that(
"a <- foo(x)"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("x", "foo", "a")
testthat::expect_identical(
get_code(tdata, datanames = "a"),
paste("x <- 1", "foo <- function(foo = 1) \"text\"", "a <- foo(x)", sep = "\n")
Expand All @@ -506,7 +476,6 @@ testthat::test_that("get_code with datanames understands $ usage and do not trea
"a$x <- x$a"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("x", "a")
testthat::expect_identical(
get_code(tdata, datanames = "x"),
"x <- data.frame(a = 1:3)"
Expand All @@ -530,7 +499,6 @@ testthat::test_that("get_code with datanames detects cooccurrence properly even
"b[[a]] <- 3"
)
tdata <- eval_code(teal_data(), code)
datanames(tdata) <- c("a", "b")
testthat::expect_identical(
get_code(tdata, datanames = "b"),
paste("a <- 1", "b <- list(c = 2)", "b[[a]] <- 3", sep = "\n")
Expand All @@ -550,7 +518,6 @@ testthat::test_that("get_code with datanames understands @ usage and do not trea
"a@x <- x@a"
)
tdata <- teal_data(x = 1, a = 1, code = code)
datanames(tdata) <- c("x", "a")
m7pr marked this conversation as resolved.
Show resolved Hide resolved
testthat::expect_identical(
get_code(tdata, datanames = "x"),
paste(
Expand Down Expand Up @@ -639,7 +606,6 @@ testthat::test_that("get_call data call is returned when data name is provided a
"z <- mtcars"
)
tdata <- teal_data(z = 1, code = code)
datanames(tdata) <- "z"
testthat::expect_identical(
get_code(tdata, datanames = "z"),
paste(
Expand Down