R version 4.4.0 alpha (2024-03-26 r86209 ucrt)
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(codetools)
> assert <- function(e)
+     if (! e) stop(paste("assertion failed:", deparse(substitute(e))))
> local({
+     st <- function(e) {
+         v <- NULL
+         write <- function(x)
+             v <<- paste(v, as.character(x), sep = "")
+         showTree(e, write = write)
+         v
+     }
+     assert(identical(st(quote(f(x))), "(f x)\n"))
+     assert(identical(st(quote((x+y)*z)), "(* (\"(\" (+ x y)) z)\n"))
+     assert(identical(st(quote(-3)), "(- 3)\n"))
+ })
> assert(identical(constantFold(quote(3)), 3))
> assert(identical(constantFold(quote(1+2)), 3))
> assert(identical(constantFold(quote(1+2+x)), NULL))
> assert(identical(constantFold(quote(pi)), pi))
> assert(identical(constantFold(quote(pi), "pi"), NULL))
> assert(identical(constantFold(quote(pi), "pi", FALSE), FALSE))
> assert(identical(getAssignedVar(quote("v"<-x)), "v"))
> assert(identical(getAssignedVar(quote(v<-x)), "v"))
> assert(identical(getAssignedVar(quote(f(v)<-x)), "v"))
> assert(identical(getAssignedVar(quote(f(g(v,2),1)<-x)), "v"))
> assert(identical(findLocals(quote(x<-1)), "x"))
> assert(identical(findLocals(quote(f(x)<-1)), "x"))
> assert(identical(findLocals(quote(f(g(x,2),1)<-1)), "x"))
> assert(identical(findLocals(quote(x<-y<-1)), c("x","y")))
> assert(identical(findLocals(quote(local(x<-1,e))), "x"))
> assert(identical(findLocals(quote(local(x<-1))), character(0)))
> assert(identical(findLocals(quote({local<-1;local(x<-1)})), c("local", "x")))
> assert(identical(findLocals(quote(local(x<-1,e)), "local"), "x"))
> local({
+     f <- function (f, x, y) {
+         local <- f
+         local(x <- y)
+         x
+     }
+     assert(identical(findLocals(body(f)), c("local","x")))
+ })
> local({
+     env <- new.env()
+     assign("local", 1, env)
+     assert(identical(findLocals(quote(local(x<-1,e)), env), "x"))
+ })
> assert(identical(findLocals(quote(assign(x, 3))), character(0)))
> assert(identical(findLocals(quote(assign("x", 3))), "x"))
> assert(identical(findLocals(quote(assign("x", 3, 4))), character(0)))
> local({
+     f<-function() { x <- 1; y <- 2}
+     assert(identical(sort(findFuncLocals(formals(f),body(f))), c("x","y")))
+     f<-function(u = x <- 1) y <- 2
+     assert(identical(sort(findFuncLocals(formals(f),body(f))), c("x","y")))
+ })
> assert(identical(flattenAssignment(quote(x)), list(NULL, NULL)))
> assert(identical(flattenAssignment(quote(f(x, 1))),
+                  list(list(quote(x)),
+                       list(quote("f<-"(x, 1, value = `*tmpv*`))))))
> assert(identical(flattenAssignment(quote(f(g(x, 2), 1))),
+                  list(list(quote(x), quote(g(`*tmp*`, 2))),
+                      list(quote("f<-"(`*tmp*`, 1, value = `*tmpv*`)),
+                           quote("g<-"(x, 2, value = `*tmpv*`))))))
> assert(identical(flattenAssignment(quote(f(g(h(x, 3), 2), 1))),
+                  list(list(quote(x),
+                            quote(h(`*tmp*`, 3)),
+                            quote(g(`*tmp*`, 2))),
+                      list(quote("f<-"(`*tmp*`, 1, value = `*tmpv*`)),
+                           quote("g<-"(`*tmp*`, 2, value = `*tmpv*`)),
+                           quote("h<-"(x, 3, value = `*tmpv*`))))))
> assert(identical(flattenAssignment(quote(f(g(h(k(x, 4), 3), 2), 1))),
+                  list(list(quote(x),
+                            quote(k(`*tmp*`, 4)),
+                            quote(h(`*tmp*`, 3)),
+                            quote(g(`*tmp*`, 2))),
+                      list(quote("f<-"(`*tmp*`, 1, value = `*tmpv*`)),
+                           quote("g<-"(`*tmp*`, 2, value = `*tmpv*`)),
+                           quote("h<-"(`*tmp*`, 3, value = `*tmpv*`)),
+                           quote("k<-"(x, 4, value = `*tmpv*`))))))
> if (getRversion() >= "2.13.0")
+     assert(identical(flattenAssignment(quote(base::diag(x))),
+                      list(list(quote(x)),
+                           list(quote(base::`diag<-`(x, value = `*tmpv*`))))))
> assert(identical(findGlobals(function() if (FALSE) x), "if"))
> # **** need more test cases here
> assert(identical(sort(findGlobals(function(x) { z <- 1; x + y + z})),
+                  sort(c("<-", "{",  "+",  "y"))))
> 
> assert(identical(findGlobals(function() Quote(x)), "Quote"))
> ## bquote test cases (from Dirk Schumacher)
> checkUsage(function() {
+     s <- as.symbol("y")
+     bquote(
+         `for`(.(s), 1, x)
+     )
+ }, report = stop)
> 
> checkUsage(function() {
+     x <- 1
+     bquote(.(x) * y)
+ }, report = stop)
> 
> checkUsage(function() {
+     x <- 1
+     bquote(.(x * 1) * y)
+ }, report = stop)
> 
> 
> ## more bquote tests
> checkUsage(function(x) bquote(.(x) + y), report = stop)
> tools::assertError(checkUsage(function() bquote(.(x)), report = stop))
> 
> ## ensure within is skipped under skipWith=TRUE
> col_edit <- function(x) {
+     x <- within(x, key <- val + 1)
+     x
+ }
> # NB: suppressLocal=TRUE needed to ignore 'key' being "unused". TODO: Fix this.
> checkUsage(col_edit, skipWith = TRUE, suppressLocal = TRUE, report = stop)
> # now with suppressLocal=FALSE, fail
> tools::assertError(checkUsage(col_edit, skipWith = TRUE, report = stop))
> 
> proc.time()
   user  system elapsed 
   0.15    0.07    0.21