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))