+ test coverage

DESCRIPTION

@@ -20,4 +20,5 @@ Imports:
   utils
 RoxygenNote: 6.1.1
 Suggests: 
-    testthat
+    testthat,
+    mockery

R/Rdoc_class.R

@@ -43,7 +43,7 @@ Rdoc <- R6Class(
       }
 
       if (!private$by_section)
-        return(private$out_(s))
+        return(send_out(s))
 
       private$flow_by_section(s)
       invisible(self)
@@ -59,9 +59,7 @@ Rdoc <- R6Class(
     by_section = TRUE,
     include_header = TRUE,
     code_sections = c("examples", "example", "usage"),
-    get_help_file = getFromNamespace(".getHelpFile", "utils"),
-    out_ = function(s, file = "") cat(private$append_(s), file = file, sep = "\n"),
-    append_ = function(l) Reduce(append, l)
+    get_help_file = getFromNamespace(".getHelpFile", "utils")
   )
 )
 
@@ -77,27 +75,19 @@ Rdoc$set("public", "set_rd_sections", function() {
 })
 
 Rdoc$set("private", "show_file", function(s) {
-  less_ <- Sys.getenv("LESS")
-  Sys.setenv(LESS = "-R")
-  on.exit(Sys.setenv(LESS = less_))
-  tf <- tempfile(fileext = ".Rtxt")
-  conn <- file(tf, open = "w", encoding = "native.enc")
-  s <- enc2utf8(private$append_(s))
-  writeLines(s, con = conn, useBytes = TRUE)
-  close(conn)
-  file.show(tf)
+  show_file(append_list(s))
   invisible(NULL)
 })
 
 Rdoc$set("private", "flow_by_section", function(s) {
   i <- 3L
-  private$out_(s[1L:i])
+  send_out(s[1L:i])
   while (i < length(s)) {
     p <- readline("")
     if (tolower(substr(p, 1L, 1L)) == "q")
       break
     i <- i + 1
-    private$out_(s[i])
+    send_out(s[i])
   }
   invisible(NULL)
 })
@@ -173,7 +163,7 @@ Rdoc$set("private", "format_sections", function() {
 Rdoc$set("private", "reflow_sections", function(){
   if (!private$has_color)
     return(invisible(NULL))
-  txt <- !names(self$rd_sections) %in% private$code_sections
+  txt <- !names(self$rd_sections) %in% c(private$code_sections, "arguments")
   if (length(txt))
     self$rd_sections[txt] <-
       lapply(
@@ -229,25 +219,7 @@ Rdoc$set("private", "format_rdo", function() {
 })
 
 Rdoc$set("private", "select_path", function() {
-  if (interactive()) {
-    id <- 1:length(self$path)
-    p <- paste(id, get_pkg(self$path), sep = ": ")
-    msg <-
-      sprintf(
-        "multiple paths found for topic: %s\n%s\n%s\n",
-        self$topic,
-        paste(p, collapse = "\n"),
-        "enter number to select (or any key for first topic)"
-      )
-    cat(msg)
-    selection <- readline("")
-    s <- substr(selection, 1, 1)
-    if (!s %in% id)
-      s <- 1L
-    self$path <- self$path[s]
-  } else
-    self$path <- self$path[1L]
-
+  self$path <- select_path(self$path, self$topic)
   invisible(NULL)
 })
 
@@ -266,3 +238,37 @@ Rdoc$set("private", "pkg_header", function() {
   "")
 })
 
+show_file <- function(s){
+  less_ <- Sys.getenv("LESS")
+  Sys.setenv(LESS = "-R")
+  on.exit(Sys.setenv(LESS = less_))
+  tf <- tempfile(fileext = ".Rtxt")
+  conn <- file(tf, open = "w", encoding = "native.enc")
+  s <- enc2utf8(s)
+  writeLines(s, con = conn, useBytes = TRUE)
+  close(conn)
+  file.show(tf)
+}
+
+select_path <- function(path, topic){
+  s <- 1L
+  if (interactive()) {
+    id <- 1:length(path)
+    p <- paste(id, get_pkg(path), sep = ": ")
+    msg <-
+      sprintf(
+        "multiple paths found for topic: %s\n%s\n%s\n",
+        topic,
+        paste(p, collapse = "\n"),
+        "enter number to select (or any key for first topic)"
+      )
+    cat(msg)
+    selection <- readline("")
+    sl <- substr(selection, 1, 1)
+    if (sl %in% id)
+      s <- as.integer(sl)
+  }
+  path[s]
+}
+
+

R/utils.R

@@ -32,3 +32,8 @@ format_args <- function(x, f){
   x[arg] <- gsub(rx, paste0("\\1", f("\\2"), "\\3"), x[arg])
   x
 }
+
+append_list <- function(l) Reduce(append, l)
+
+send_out <- function(s, file = "")
+  cat(append_list(s), file = file, sep = "\n")

tests/testthat/test_Rdoc.R

@@ -0,0 +1,27 @@
+context("Rdoc")
+
+test_that("selecting paths", {
+
+  x <- c(
+    "~/Library/dplyr/help/filter",
+    "~/library/stats/help/filter"
+  )
+  mockery::stub(select_path, 'interactive', FALSE)
+  p <- select_path(x, "filter")
+  expect_equal(x[1], p)
+
+  mockery::stub(select_path, 'interactive', TRUE)
+  mockery::stub(select_path, 'readline', "2")
+  sink(file = tempfile())
+  p <- select_path(x, "filter")
+  sink()
+  expect_equal(x[2], p)
+})
+
+
+test_that("file show", {
+  mockery::stub(show_file, "file.show", function(x) readLines(x))
+  l <- Sys.getenv("LESS")
+  s <- show_file(LETTERS)
+  expect_equal(l, Sys.getenv("LESS"))
+})

tests/testthat/test_base.R

@@ -2,6 +2,7 @@ context("base R docs")
 get_help_file <- getFromNamespace(".getHelpFile", "utils")
 options(rdoc.header = FALSE)
 options(rdoc.by_section = FALSE)
+options(rdoc.text_formats = rdoc_text_formats(href = NULL, link = NULL))
 get_rdo <- function(topic, pkg){
   d <- as.call(list(utils::`help`, topic, pkg))
   d <- eval(d)[1]

tests/testthat/test_format.R

@@ -24,6 +24,27 @@ test_that("rdo formats", {
   f <- system.file("extdata/rdoc_test.Rd", package = "rdoc")
   x <- tools::parse_Rd(f)
   x <- rdoc:::format_rdo(x)
+  expect_true(is.list(x$rdo))
   expect_equal(length(x$tables), 1)
 
 })
+
+test_that("setting rd titles", {
+
+  ttl <- function(x) {
+    paste0("_\b", paste0(strsplit(x, "")[[1]]),
+           collapse = "")
+  }
+
+  o <- c(ttl("a long title"),
+         ttl("split into multiple lines"),
+         "",
+         ttl("first section"),
+         "",
+         "some text")
+  x <- set_rd_title(o)
+  x <- gsub("_\b", "", x)
+  expect_equal(x[1], "a long title split into multiple lines")
+  expect_equal(x[2], "")
+  expect_equal(x[3], "first section")
+})

tests/testthat/test_rd.R

@@ -11,6 +11,7 @@ test_ <- function(x){
 
 test_that("rd produces text output", {
 
+  expect_true(is.function(rd_()))
   x <- cap_(rdoc("min"))
   test_(x)
 
@@ -67,11 +68,11 @@ test_that("Rd files read", {
   expect_true(is.character(x))
 })
 
-# test_that("rdoc overrides ?", {
-#   use_rdoc()
-#   expect_true("rdoc" %in% searchpaths())
-#   x <- cap_(?min)
-#   test_(x)
-#   rm_rdoc()
-#   expect_true(!"rdoc" %in% searchpaths())
-# })
+test_that("rdoc overrides ?", {
+  use_rdoc()
+  expect_true("rdoc" %in% searchpaths())
+  expect_true(is.null(use_rdoc()))
+  rm_rdoc()
+  expect_true(!"rdoc" %in% searchpaths())
+  expect_true(is.null(rm_rdoc()))
+})

tests/testthat/test_rd_tags.R

@@ -58,6 +58,25 @@ test_that("format inline code", {
 
 })
 
+test_that("format links", {
+  x <- structure(list(structure("adist", Rd_tag = "TEXT")),
+            Rd_tag = "\\link",
+            Rd_option = structure("utils", Rd_tag = "TEXT"))
+  o <- format_link(x, function(x) x)
+  expect_equal(o[1], "[adist](utils)")
+
+  x <- structure(list(structure("range", Rd_tag = "TEXT")), Rd_tag = "\\link")
+  o <- format_link(x, function(x) x)
+  expect_equal(x, o)
+})
+
+test_that("format href", {
+  x <- structure(list(list(structure("http://rstudio.com", Rd_tag = "VERB")),
+                 list(structure("Rstudio", Rd_tag = "TEXT"))), Rd_tag = "\\href")
+  o <- format_href(x, function(x) x)
+  expect_equal(o[1], "[Rstudio](http://rstudio.com)")
+})
+
 test_that("format tables", {
 
   x <-
@@ -76,29 +95,17 @@ test_that("format tables", {
       )
     ), Rd_tag = "\\tabular")
 
-  xt <- format_table(x)
-  xt <- strsplit(xt, "\n")[[1]]
-  expect_equal(xt,
-               c("┌───────────┐",
-                 "│           │",
-                 "│   1   2   │",
-                 "│           │",
-                 "│   3   4   │",
-                 "│           │",
-                 "└───────────┘"
-               ))
-  xt <- format_table(x, list(border_style = "double-single"))
+
+  xt <- format_table(x, list(border_style = "none", width = 20))
   xt <- strsplit(xt, "\n")[[1]]
   expect_equal(xt,
-               c(
-                 "╒═══════════╕",
-                 "│           │",
-                 "│   1   2   │",
-                 "│           │",
-                 "│   3   4   │",
-                 "│           │",
-                 "╘═══════════╛"
-               ))
+               c("             ",
+                 "             ",
+                 "    1   2    ",
+                 "             ",
+                 "    3   4    ",
+                 "             ",
+                 "             "))
 
 })