tools/03-tests.R

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

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

first_line <- '# Generated by 03-tests.R\n\nwithr::local_envvar(DUCKPLYR_FORCE = "TRUE")\n\nmeta <- testthat::is_parallel() # Slow!\n# meta <- TRUE'

get_test_code <- function(name, code, is_tbl_return) {
  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) {
    stopifnot(identical(names2(extra_args), ""))

    with_force <- test_force_override[name] %|% fs::file_exists(fs::path("patch", paste0(name, ".patch")))
    if (with_force) {
      force <- ""
    } else {
      force <- '  withr::local_envvar(DUCKPLYR_FORCE = "FALSE")\n\n'
    }

    skip <- test_skip_map[name]
    if (is.na(skip)) {
      skip <- ""
    } else {
      skip <- paste0('  skip("', skip, '")\n\n')
    }

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

  if (skip == "") {
    with_force_fallback <- paste0(
      get_test_code_one(
        extra_args[[1]],
        names2(extra_args)[[1]],
        name,
        two_tables,
        force = '  withr::local_envvar(DUCKPLYR_FALLBACK_FORCE = "TRUE")\n\n',
        is_tbl_return = is_tbl_return
      ),
      "\n\n"
    )
  } else {
    with_force_fallback <- ""
  }

  paste0(with_force_fallback, out)
}

get_test_code_one <- function(extra_arg, pre_step, name, two_tables, force = "", skip = "", is_tbl_return = TRUE) {
  if (is_tbl_return) {
    post_coerce <- " %>% as_duckplyr_df()"
  } else {
    post_coerce <- ""
  }

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

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

  test_code_pre <- c(
    'test_that("as_duckplyr_df() and {{{pre_step}}}{{{name}}}({{{extra_arg_esc}}})", {',
    "{{{force}}}{{{skip}}}  # Data"
  )

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

    test_code <- c(
      test_df_xy_code,
      "",
      "  # Run",
      paste0("  pre <- test_df_x %>% as_duckplyr_df() %>% ", test_df_xy_op_code),
      paste0("  post <- test_df_x %>% ", test_df_xy_op_code, "{{{post_coerce}}}")
    )
  } else {
    test_code <- c(
      test_df_code,
      "",
      "  # Run",
      paste0("  pre <- test_df %>% as_duckplyr_df() %>% ", test_df_op_code),
      paste0("  post <- test_df %>% ", test_df_op_code, "{{{post_coerce}}}")
    )
  }

  test_code_post <- c(
    "",
    "  # Compare",
    "  expect_identical(pre, post)",
    "})",
    ""
  )

  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 %>%
  mutate(test_code = pmap_chr(list(name, code, is_tbl_return), get_test_code))

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

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