R/tex.r

In skranz/testexamples: Test a package by running and comparing examples

example = function() {
  f = function(x) {
    x
  }
  code = "f(1);f(2);f(3)"
  sources = example.sources(ex.in.fun.files = "../ex_fun.R", ex.text=code)
  et = create.example.tests(sources)

  f = function(x) {
    if (x==2) stop("Error")
    x*x
  }
  run.example.tests(et)


  ex.df = parse.example.files(files)
  res = eval.examples(ex.df)

  ex = ex.df[1,]
  eval.example(ex)
}

#' Run example tests
#'
#' Reruns all examples that have been originally evaluated and stored in an example test.
#'
#' Returns the number of calls that now return different values or throw an error and writes a detailed log as Rmd file.
#'
#' @param et An example test originally created with \code{\link{create.example.tests}}
#' @param log.file The file name of the log. Should be an Rmd file.
#' @param parent.env The parent environment in which examples are evaluated.
run.example.tests = function(et, log.file = "example_test_log.Rmd", parent.env = parent.frame()) {
  restore.point("run.example.tests")
  writeLines(paste0(
"# Comparison of examples

", Sys.time(), " (new) vs
", et$time, " (old)
"), log.file)

  num.issues = 0
  for (i in seq_len(NROW(et$ex.df))) {
    ex = et$ex.df[i,]
    write.log(log.file,"## ", ex$file, " ", ex$part,"\n")
    new.res = eval.example(ex,parent.env = parent.env)
    old.res = et$ex.res[[i]]
    res = compare.example.results(ex,old.res,new.res)
    num.issues = num.issues + res$num.issues
    write.log(log.file, res$log)
  }
  if (num.issues==0) {
    cat("\nNo issues found when testing examples.")
  } else {
    cat(paste0("\n",num.issues, " issues found when testing examples. See log in\n", log.file,"\n"))

  }
  invisible(num.issues)
}

compare.example.results = function(ex,old.res, new.res) {
  restore.point("compare.example.results")

  same = is.true(
    old.res$digest == new.res$digest &
    old.res$error == new.res$error
  )

  ok = TRUE
  num.issues = 0
  log = NULL
  if (all(same & !new.res$error)) {
    log = "Everything ok."
  } else {
    code = unlist(ex$code)
    rows = !same & !new.res$error &!old.res$error
    code[rows] = paste0(code[rows],"\n### RESULTS DIFFER")

    rows = !same & new.res$error
    code[rows] = paste0(code[rows],"\n### !! THROWS NEW ERROR !!")

    rows = !same & !new.res$error & old.res$error
    code[rows] = paste0(code[rows],"\n### previous error corrected.")

    rows = new.res$error & old.res$error
    code[rows] = paste0(code[rows],"\n### As before an error is thrown.")

    num.issues = sum((!same & !old.res$error) | new.res$error)
    ok = num.issues == 0
    log = paste0("```{r eval=FALSE}\n", paste0(code, collapse="\n"),"\n```")
  }
  list(ok=ok,num.issues=num.issues, log=log)
}


#' Create new example tests
#'
#' @param sources example sources defined by a call to \code{\link{example.sources}}
create.example.tests = function(sources, parent.env=parent.frame()) {
  restore.point("create.example.tests")
  ex.df = parse.examples(sources)
  ex.res = eval.examples(ex.df, parent.env=parent.env)
  list(
    time=Sys.time(),
    ex.df = ex.df,
    ex.res = ex.res
  )
}


eval.examples = function(ex.df, parent.env = parent.frame()) {
  ex.res = lapply(seq_len(NROW(ex.df)), function(i){
    eval.example(ex.df[i,], parent.env=parent.env)
  })
  ex.res
}


eval.example = function(ex, env=create.example.env(ex, parent.env), parent.env = parent.frame()) {
  restore.point("eval.example")

  call.name = unlist(ex$call.names)
  code = unlist(ex$code)
  df = ex %>%
    select(-extra.funs, -call.names,-code) %>%
    unnest(calls) %>%
    mutate(call.name = call.name, step = seq_len(n()), digest=NA, error=FALSE, class=NA, secs=NA_real_, code=code)
  df$value = vector("list",NROW(df))

  for (i in seq_len(NROW(df))) {
    call = df$calls[[i]]
    start = Sys.time()
    res = try(eval(call, env),silent = TRUE)
    stop = Sys.time()
    secs = as.double(stop-start)
    df$secs[i] = secs
    if (is(res,"try-error")) {
      df$error[i] = TRUE
    } else {
      df$digest[i] = digest(res)
      df$class[i] = class(res)[1]
      df$value[[i]] = get.short.value(res)
    }
  }
  df
}

get.short.value = function(x) {
  if (is.data.frame(x) | is.matrix(x)) {
    if (NROW(x)>1) {
      return(x[1,])
    } else {
      return(x)
    }
  }
  if (is.numeric(x) | is.character(x) | is.logical(x)) {
    if (NROW(x)>2) {
      return(x[1:3,])
    } else {
      return(x)
    }
  }
  return(NA)
}

create.example.env = function(ex, parent.env=globalenv()) {
  restore.point("create.example.env")

  extra.funs = ex$extra.funs[[1]]
  env = new.env(parent = parent.env)
  if (length(extra.funs)>0) {
    for (fn in names(extra.funs)) {
      fun = extra.funs[[fn]]
      environment(fun) = env
      env[[fn]] = fun
    }
  }
  env
}