Use usethis::proj_get() instead of the base_path function argument for compatbility with usethis.

Author: s-fleck

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: testthis
 Type: Package
 Title: Utils and 'RStudio' Addins to Make Testing Even More Fun
-Version: 1.0.2
+Version: 1.0.1.9000
 Authors@R: person("Stefan", "Fleck", email = "[email protected]", role = c("aut", "cre"))
 Maintainer: Stefan Fleck <[email protected]>
 Description:

NEWS.md

@@ -1,6 +1,8 @@
 # testthis 1.0.2
 
 * added `test_all()` to run tests in all subdirectories
+* Use `usethis::proj_get()` instead of the `base_path` function argument for
+  compatbility with usethis.
 
 
 # testthis 1.0.1

R/Taglist.R

@@ -25,16 +25,16 @@ taglist <- function(dat){
 
 
 
-get_rdir_taglist <- function(base_path = '.'){
-  ttfiles  <- list_rdir_files(base_path, full_names = TRUE)
+get_rdir_taglist <- function(){
+  ttfiles  <- list_rdir_files(full_names = TRUE)
   lapply(ttfiles, get_taglist)
 }
 
 
 
 
-get_test_taglist <- function(base_path = '.'){
-  ttfiles  <- list_test_files(base_path, full_names = TRUE)
+get_test_taglist <- function(){
+  ttfiles  <- list_test_files(full_names = TRUE)
   taglists <- lapply(ttfiles, get_taglist)
 }
 

R/Test_coverage.R

@@ -6,7 +6,6 @@
 #' `test_that()` calls, or used test_this tags. If you want automatic
 #' analysis of test coverage, you must look in other packages such as `covr`.
 #'
-#' @template base_path
 #' @param from_tags Logical scalar. Checks the files if your test directory for
 #'   testthis tags. Specifically, if you have the comment `#* @testing myfunction`
 #'   in any of your test files, myfunction will be marked as tested.
@@ -34,29 +33,27 @@
 #' }
 #'
 get_test_coverage <- function(
-  base_path = '.',
   from_tags = TRUE,
   from_desc = TRUE
 ){
-  all  <- get_pkg_functions(base_path = base_path)
+  all  <- get_pkg_functions()
   tst  <- get_pkg_tested_functions(
-    base_path = base_path,
     from_tags = from_tags,
     from_desc = from_desc
   )
-  ign <- get_pkg_testignore(base_path = base_path)
+  ign <- get_pkg_testignore()
 
 
   res <- data.frame(
     fun    = all,
-    exp    = all %in% get_pkg_exports(base_path = base_path),
-    s3     = all %in% get_pkg_S3methods(base_path = base_path),
+    exp    = all %in% get_pkg_exports(),
+    s3     = all %in% get_pkg_S3methods(),
     tested = all %in% tst,
     ignore = all %in% ign,
     stringsAsFactors = FALSE
   )
 
-  attr(res, 'package') <- devtools::as.package(base_path)$package
+  attr(res, 'package') <- usethis::proj_get()
   test_coverage(res)
 }
 
@@ -170,15 +167,25 @@ print.Test_coverage <- function(x, ...){
 #' @inheritParams get_test_coverage
 #' @noRd
 #' @return `get_pkg_functions()` returns a character vector of *all* functions
-#'   defined in `base_path`.
+#'   defined in package.
 #'
-get_pkg_functions <- function(base_path = '.'){
-  base_path  <- devtools::as.package(base_path)
+get_pkg_functions <- function(){
+  pkg  <- devtools::as.package(usethis::proj_get())
+
+  ns <- tryCatch(
+    asNamespace(pkg$package),
+    error = function(e){
+    stop(
+      "Functions can only be detected for installed packages"
+    )
+  })
+
   res  <- as.character(unclass(
     utils::lsf.str(
-      envir = asNamespace(base_path$package),
+      envir = asNamespace(pkg$package),
       all = TRUE)
   ))
+
   return(res)
 }
 
@@ -187,29 +194,41 @@ get_pkg_functions <- function(base_path = '.'){
 
 #' @rdname get_pkg_functions
 #' @return `get_pkg_exports()` returns a character vector of functions *exported*
-#'   from `base_path`s NAMESPACE.
+#'   from the current packages NAMESPACE.
 #' @noRd
-get_pkg_exports <- function(base_path = '.'){
-  base_path %>%
+get_pkg_exports <- function(){
+  ns <- usethis::proj_get() %>%
     devtools::as.package() %>%
-    devtools::parse_ns_file() %>%
-    magrittr::extract2('exports')
+    devtools::parse_ns_file()
+
+  if (identical(ns$exportPatterns, "^[[:alpha:]]+")){
+    return(get_pkg_functions())
+  } else {
+    ns[["exports"]]
+  }
 }
 
 
 
 
 #' @rdname get_pkg_functions
 #' @return `get_pkg_S3methods()` returns a character vector of all *S3 methods*
-#'   exported from `base_path`s NAMESPACE.
+#'   exported from the current packages NAMESPACE.
 #' @noRd
-get_pkg_S3methods <- function(base_path = '.'){
-  dd <- base_path %>%
+get_pkg_S3methods <- function(){
+  ns <- usethis::proj_get() %>%
     devtools::as.package() %>%
-    devtools::parse_ns_file() %>%
-    magrittr::extract2('S3methods')
+    devtools::parse_ns_file()
+
+  if (identical(ns$exportPatterns, "^[[:alpha:]]+")){
+    warning(
+      "Detecting exported functions only works if all functions are ",
+      "explicitly exported in the NAMESPACE file (for example via Roxygen)"
+  )}
 
-  apply(dd, 1, function(x) paste(stats::na.omit(x), collapse = '.'))
+  ns %>%
+    magrittr::extract2('S3methods') %>%
+    apply(1, function(x) paste(stats::na.omit(x), collapse = '.'))
 }
 
 
@@ -219,15 +238,15 @@ get_pkg_S3methods <- function(base_path = '.'){
 #' @return  `get_pkg_tested_functions()` returns a character vector of all
 #'   *functions for which unit tests exist*.
 #' @noRd
-get_pkg_tested_functions <- function(base_path, from_tags, from_desc){
+get_pkg_tested_functions <- function(from_tags, from_desc){
   res <- vector()
 
   if(from_tags){
-    res <- c(res, get_pkg_tested_functions_from_tags(base_path))
+    res <- c(res, get_pkg_tested_functions_from_tags())
   }
 
   if(from_desc){
-    res <- c(res, get_pkg_tested_functions_from_desc(base_path))
+    res <- c(res, get_pkg_tested_functions_from_desc())
   }
 
   return(res)
@@ -240,9 +259,8 @@ get_pkg_tested_functions <- function(base_path, from_tags, from_desc){
 #' @return `get_pkg_testignore()` returns a character vector of all
 #'   functions listed in \file{tests/testthat/_testignore}.
 #' @noRd
-get_pkg_testignore <- function(base_path){
-  base_path <- devtools::as.package(base_path)
-  tfile <- file.path(base_path$path, 'tests', 'testthat', '_testignore')
+get_pkg_testignore <- function(){
+  tfile <- file.path(usethis::proj_get(), 'tests', 'testthat', '_testignore')
 
   if (file.exists(tfile)){
     return(readLines(tfile))
@@ -254,20 +272,20 @@ get_pkg_testignore <- function(base_path){
 
 
 
-get_pkg_tested_functions_from_tags <- function(base_path){
-  taglists <- get_test_taglist(base_path)
+get_pkg_tested_functions_from_tags <- function(){
+  taglists <- get_test_taglist()
   res      <- sort(unlist(unique(lapply(taglists, get_tag, 'testing'))))
   return(res)
 }
 
 
 
 
-get_pkg_tested_functions_from_desc <- function(base_path){
-  ttfiles <- list_test_files(base_path, full_names = TRUE)
+get_pkg_tested_functions_from_desc <- function(){
+  ttfiles <- list_test_files(full_names = TRUE)
   descs   <- extract_test_that_desc(ttfiles)
 
-  pkgfuns <- get_pkg_functions(base_path)
+  pkgfuns <- get_pkg_functions()
   res <- rep(NA, length(pkgfuns))
 
   for(i in seq_along(pkgfuns)){

R/list_test_files.R

@@ -1,11 +1,9 @@
 list_test_files <- function(
-  base_path,
   full_names = TRUE,
   skip = FALSE,
   recursive = TRUE
 ){
-  pkg   <- devtools::as.package(base_path)
-  tpath <- file.path(pkg$path, 'tests', 'testthat')
+  tpath <- file.path(usethis::proj_get(), 'tests', 'testthat')
   res   <- list.files(
     tpath,
     full.names = TRUE,
@@ -29,12 +27,10 @@ list_test_files <- function(
 
 
 list_rdir_files <- function(
-  base_path,
   full_names = TRUE,
   skip = FALSE
 ){
-  base_path     <- devtools::as.package(base_path)
-  tpath   <- file.path(base_path$path, 'R')
+  tpath   <- file.path(usethis::proj_get(), 'R')
   list.files(
     tpath,
     full.names = full_names

R/test_subdir.R

@@ -35,7 +35,6 @@
 #' own test subdirs instead.
 #'
 #' @inheritParams devtools::test
-#' @template base_path
 #' @param subdir subdir of `inst/tests/` or `tests/testthat` that contains the
 #'   tests
 #' @param ... passed on to `devtools::test()`
@@ -44,37 +43,23 @@
 #' @return A [testthat_results] object (invisibly)
 #'
 #' @export
-test_subdir <- function(subdir, base_path = '.', ...){
-
-  find_test_dir_mock <- function (path){
-    testthat <- file.path(path, "tests", "testthat", subdir)
-    if (dir.exists(testthat))
-      return(testthat)
-    inst <- file.path(path, "inst", "tests", subdir)
-    if (dir.exists(inst))
-      return(inst)
-    stop(
-      sprintf("%s not found in any of the test dirs of %s", subdir, path),
-      call. = FALSE
-    )
-  }
-
+test_subdir <- function(subdir, ...){
 
-  invisible(testthat::with_mock(
-    `devtools:::find_test_dir` = find_test_dir_mock,
-    devtools::test(pkg = base_path, ...)
+  browser()
+  testthat::test_dir(file.path(
+    usethis::proj_get(), testthat::test_path(), subdir
   ))
+
 }
 
 
 
 
 #' @rdname test_subdir
 #' @export
-test_integration <- function(base_path = '.', ...){
+test_integration <- function(...){
   test_subdir(
     subdir = options('testthis.integration_tests_path'),
-    base_path = base_path,
     ...)
 }
 
@@ -83,10 +68,9 @@ test_integration <- function(base_path = '.', ...){
 
 #' @rdname test_subdir
 #' @export
-test_acceptance <- function(base_path = '.', ...){
+test_acceptance <- function(...){
   test_subdir(
     subdir = options('testthis.acceptance_tests_path'),
-    base_path = base_path,
     ...)
 }
 
@@ -95,10 +79,9 @@ test_acceptance <- function(base_path = '.', ...){
 
 #' @rdname test_subdir
 #' @export
-test_manual <- function(base_path = '.', ...){
+test_manual <- function(...){
   test_subdir(
     subdir = options('testthis.manual_tests_path'),
-    base_path = base_path,
     ...)
 }
 
@@ -110,10 +93,9 @@ test_manual <- function(base_path = '.', ...){
 #' @rdname test_subdir
 #' @export
 test_all <- function(
-  base_path = ".",
   ...
 ){
-  pkg_dir <- devtools::as.package(base_path)$path
+  pkg_dir <- usethis::proj_get()
 
   dirs    <- basename(
     list.dirs(
@@ -133,6 +115,12 @@ test_all <- function(
 
 
 
+
+dir_mock <- function(path = ".", pattern = NULL, ...){
+  list.files(path  = path, pattern = pattern, recursive = TRUE)
+}
+
+
 find_test_scripts_mock <- function(
   path,
   filter = NULL,
@@ -152,5 +140,9 @@ find_test_scripts_mock <- function(
     invert = TRUE
   )
 
-  testthat:::filter_test_scripts(files, filter, invert, ...)
+  if(!is.null(filter)){
+    stop("filter not supported")
+  }
+
+  files
 }

R/test_with_skip.R

@@ -6,13 +6,11 @@
 #' See the devtools documentation for further info or
 #' `vignette("testthis")` for infos on testthis tags.
 #'
-#' @template base_path
 #' @inheritParams devtools::test
 #'
 #' @export
-test_with_skip <- function(base_path = '.', ...){
+test_with_skip <- function(...){
   fltr <- list_test_files(
-    base_path,
     full_names = FALSE,
     skip = TRUE
   )