tests/testthat/helper-dev.R

In r-dbi/DBItest: Testing DBI Backends

if (Sys.getenv("CI") == "" && dir.exists("../../../RSQLite")) {
  writeLines(
    c(
      # Avoid warning
      paste0("# Generated by helper-dev.R, do not edit", " by hand"),
      "",
      "skip_if_not_installed(\"RSQLite\")",
      "skip_if_not_installed(\"nanoarrow\")",
      "",
      "# helper-DBItest.R",
      readLines("../../../RSQLite/tests/testthat/helper-DBItest.R"),
      "",
      "# test-DBItest.R",
      readLines("../../../RSQLite/tests/testthat/test-DBItest.R"),
      # gsub("test_all", "test_meta", readLines("../../../RSQLite/tests/testthat/test-DBItest.R")),
      "",
      "# Cleanup",
      "set_default_context(NULL)"
    ),
    "test-DBItest.R"
  )
}

flatten_braces <- function(x, in_brace = FALSE, caller = "") {
  if (is.call(x)) {
    if (x[[1]] == "{") {
      if (in_brace) {
        return(compact(map(x[-1], flatten_braces, in_brace = TRUE, caller = "{")))
      } else {
        args <- unlist(map(x[-1], flatten_braces, in_brace = TRUE, caller = "{"))
        if (length(args) == 1 && caller != "if") {
          x <- args[[1]]
        } else {
          x <- call2("{", !!!args)
        }
      }
    } else {
      x[-1] <- map(x[-1], flatten_braces, caller = x[[1]])
    }
  }

  x
}

inline_meta_tests <- function(arrow, bind, path) {
  test_exprs <- map(compact(spec_meta_bind_expr(arrow = arrow, bind = bind)), ~ if (!is.null(.x)) .x())
  test_exprs_flat <- map(test_exprs, flatten_braces)

  env <- environment(inline_meta_tests)
  args <- pairlist2(ctx = , con = )

  test_funs <- map(test_exprs_flat, ~ if (!is.null(.x)) {
    new_function(args, .x, env)
  })

  cs <- constructive::construct(
    c(test_funs, list(NULL)),
    constructive::opts_function(environment = FALSE),
    check = FALSE
  )

  infix <- get_bind_arrow_infix(arrow, bind)

  text <- trimws(format(cs$code), "right")
  text[[1]] <- paste0("spec_meta_", infix, "bind <- ", text[[1]])
  # FIXME: Why does constructive not handle this?
  text <- gsub('r"[\\]"', '"\\\\"', text, fixed = TRUE)
  text <- gsub('^( *)"(.*)"$', "\\1# \\2", text)
  text <- c(
    "# Generated by helper-dev.R, do not edit by hand",
    "# Sources: R/spec-meta-bind-.R, R/spec-meta-bind-expr.R, R/spec-meta-bind-runner.R",
    "",
    "# This file is generated during load_all() if it's older than the sources",
    "",
    text
  )

  writeLines(text, path)
}

times <- file.mtime(c(
  # Targets
  "../../R/spec-meta-bind.R",
  "../../R/spec-meta-bind-arrow.R",
  "../../R/spec-meta-bind-stream.R",
  "../../R/spec-meta-bind-arrow-stream.R",

  # Sources
  "../../R/spec-meta-bind-.R",
  # Reason for two input files: order of topics in the generated help file
  "../../R/spec-meta-bind-expr.R",
  "../../R/spec-meta-bind-runner.R",
  "helper-dev.R",
  NULL
))

if (Sys.getenv("CI") == "" && which.max(times) > 4) {
  message("Generating spec-meta-bind.R")
  inline_meta_tests("none", "df", "../../R/spec-meta-bind.R")
  inline_meta_tests("query", "df", "../../R/spec-meta-bind-arrow.R")
  inline_meta_tests("none", "stream", "../../R/spec-meta-bind-stream.R")
  inline_meta_tests("query", "stream", "../../R/spec-meta-bind-arrow-stream.R")
}