tools/05-duckdb-tests.R

In duckdblabs/duckplyr: A 'DuckDB'-Backed Version of 'dplyr'

source("tools/00-funs.R", echo = TRUE)

pkgload::load_all()

first_line <- paste0(
  "# Generated by duckplyr's 05-duckdb-tests.R, ",
  "do not edit by hand"
)

get_test_code <- function(name, code, oo) {
  withr::local_envvar(DUCKPLYR_FORCE = TRUE)

  formals <- formals(code)
  two_tables <- (length(formals) > 1) && (names(formals)[[2]] == "y")

  extra_args <- test_extra_arg_map[[name]] %||% c("")

  if (length(extra_args) == 1) {
    with_force <- test_force_override[name] %|% fs::file_exists(fs::path("patch", paste0(name, ".patch")))
    if (!with_force) {
      return("")
    }

    skip <- test_skip_map[name]
    if (!is.na(skip)) {
      return("")
    }

    out <- get_test_code_one(extra_args, pre_step = "", oo, name, two_tables, force, skip)
  } else {
    out <- paste(pmap_chr(
      list(extra_args, names2(extra_args), oo),
      get_test_code_one,
      name,
      two_tables
    ), collapse = "\n")
  }

  if (oo) {
    oo_desc <- "order-preserving"
  } else {
    oo_desc <- "order-enforcing"
  }

  desc <- paste0(name, " ", oo_desc)

  paste0(
    "# ", desc, " ", strrep("-", 85 - nchar(desc)), "\n\n", out
  )
}

get_test_code_one <- function(extra_arg, pre_step, oo, name, two_tables, force = "", skip = "") {
  post_coerce <- " %>% as.data.frame()"

  if (pre_step != "") {
    pre_step <- paste0(pre_step, " %>% ")
    pre_step <- gsub('"', '\\\\"', pre_step)
  }

  extra_arg_esc <- gsub('"', '\\\\"', extra_arg)

  if (oo) {
    arrange_all_code <- ""
    oo_desc <- "order-preserving"
  } else {
    arrange_all_code <- " %>% arrange_all()"
    oo_desc <- "order-enforcing"
  }

  test_code_pre <- c(
    'test_that(\"relational {{{pre_step}}}{{{name}}}({{{extra_arg_esc}}}) {{{oo_desc}}}", {',
    "  # Autogenerated"
  )

  if (two_tables) {
    if (extra_arg != "") {
      extra_arg <- paste0(", ", extra_arg)
    }

    test_fun_code <- c(
      "function(duck) {",
      test_df_xy_code,
      "  if (duck) test_df_x <- as_duckplyr_df(test_df_x)",
      paste0("  test_df_x %>% ", test_df_xy_op_code, "{{{arrange_all_code}}}"),
      "}"
    )
  } else {
    test_fun_code <- c(
      "function(duck) {",
      test_df_code,
      "  if (duck) test_df <- as_duckplyr_df(test_df)",
      paste0("  test_df %>% ", test_df_op_code, "{{{arrange_all_code}}}"),
      "}"
    )
  }

  test_fun <- eval(parse(text = whisker::whisker.render(test_fun_code))[[1]])

  withr::local_envvar(DUCKPLYR_OUTPUT_ORDER = oo)

  post <- test_fun(FALSE)
  meta_clear()
  test_fun(TRUE)

  meta_code <- utils::capture.output(meta_replay(add_pre_code = TRUE))
  meta_code[[length(meta_code)]] <- paste0("out <- ", meta_code[[length(meta_code)]])
  meta_code <- c(
    meta_code,
    "expect_identical(",
    "  out,",
    paste0("  ", utils::capture.output(constructive::construct(post))),
    ")",
    "DBI::dbDisconnect(con, shutdown = TRUE)"
  )

  test_code <- str_replace(paste0("  ", meta_code), " +$", "")

  test_code_post <- c(
    "})",
    ""
  )

  test_code <- whisker::whisker.render(c(test_code_pre, test_code, test_code_post))
}

old <-
  tibble(path = fs::dir_ls("tests/testthat", glob = "*.R")) %>%
  mutate(first_line = map_chr(path, brio::read_lines, 1)) %>%
  filter(first_line == !!first_line)

fs::file_delete(old$path)

tests <-
  df_methods %>%
  filter(is_tbl_return) %>%
  expand_grid(oo = c(TRUE, FALSE)) %>%
  mutate(sort = lengths(test_extra_arg_map[name])) %>%
  arrange(desc(sort)) %>%
  mutate(test_code = pmap_chr(list(name, code, oo), get_test_code, .progress = TRUE)) %>%
  filter(test_code != "") %>%
  arrange(name)

all_tests <-
  paste0(
    first_line, "\n\n",
    paste(tests$test_code, collapse = "\n")
  )

brio::write_file(all_tests, "tests/testthat/test-rel_api.R")