Reintroduce tests

NAMESPACE

@@ -94,12 +94,15 @@ S3method(report_finalize,reporter_basic_tty)
 S3method(report_sleep,default)
 S3method(report_sleep,reporter_ansi_tty)
 S3method(report_sleep,reporter_basic_tty)
+S3method(report_start_checks,"NULL")
 S3method(report_start_checks,reporter_ansi_tty)
+S3method(report_start_setup,"NULL")
 S3method(report_start_setup,reporter_ansi_tty)
 S3method(report_start_setup,reporter_basic_tty)
 S3method(report_status,"NULL")
 S3method(report_status,reporter_ansi_tty)
 S3method(report_status,reporter_basic_tty)
+S3method(report_step,"NULL")
 S3method(report_step,reporter_ansi_tty)
 S3method(report_step,reporter_basic_tty)
 S3method(report_task,reporter_ansi_tty)
@@ -119,7 +122,7 @@ S3method(start_task,igraph.vs)
 S3method(start_task,install_task)
 S3method(task_graph,task)
 S3method(task_graph,task_graph)
-export(check_dev_rev_deps)
+export(check_pkgs)
 export(check_rev_deps)
 export(check_task)
 export(checker)

R/check.R

@@ -70,29 +70,29 @@ check_rev_deps <- function(
     output = output,
     lib.loc = lib.loc,
     repos = repos,
+    restore = restore
   )
 
   run(checks, ...)
   checks
 }
 
-#' Run reverse dependency checks against a development version only
+#' Check packages
 #'
-#' [`check_dev_rev_deps()`] works similarly to [`check_rev_deps()`] but it runs
-#' R CMD check only once for each package, with the development version of the
-#' package installed. It is advantageous to check whether adding a new package
-#' into a repository breaks existing packages that possibly take said package
-#' as a `Suggests` dependency.
+#' Runs classical `R CMD check` for the given source package. It
+#' first identifies and installs, in parallel, all dependencies required
+#' to check the package. Then, it runs `R CMD check` for each specified package.
 #'
 #' @inheritParams check_functions
 #' @inheritParams run
+#' @inheritParams plan_local_checks
 #'
 #' @inherit check_functions return
 #'
 #' @family checks
 #' @export
-check_dev_rev_deps <- function(
-  path,
+check_pkgs <- function(
+  package,
   n = 2L,
   output = tempfile(paste(utils::packageName(), Sys.Date(), sep = "-")),
   lib.loc = .libPaths(),
@@ -101,7 +101,7 @@ check_dev_rev_deps <- function(
   ...
 ) {
   checks <- checker$new(
-    plan_rev_dep_checks(path = path, repos = repos, versions = "dev"),
+    plan_local_checks(package = package, repos = repos),
     n = n,
     output = output,
     lib.loc = lib.loc,

R/check_process.R

@@ -1,17 +1,35 @@
 # Regular Expression for Parsing R CMD check checks
 # nolint start, styler: off
 RE_CHECK <- paste0(
-  "(?<=^|\n)",       # starts on a new line (or start of string)
-  "\\* checking ",   # literal "* checking "
-  "(?<check>.*?)",   # capture any check content as "check"
-  " \\.\\.\\.",      # until literal "..."
-  "(?:",             # ignore additional check details:
-    "[\\s\\*]{2,}",  #   any content starting with two or more of spaces or "*"
-    ".*?(?:\n|$)",   #   until a newline (or end of string)
-  ")*",              #   repeating until
-  "(?<status>.*?)",  # capturing a status as "status"
-  "(?=\n|$)"         # terminated by a new line (or end of string)
+  "(?<=^|\\n)",                   # must start at beginning of string OR right after a newline
+  "\\* checking ",                # literal "* checking "
+  "(?<check>.*?)",                # capture check name/content (non-greedy) as "check"
+  " \\.\\.\\.",                   # followed by literal " ..."
+  "(?:",                          # zero or more "detail" lines that belong to this check
+  "\\n[ \\t]*(?=\\n)",            #   a blank line (newline + optional spaces/tabs + next newline)
+  "|",
+  "\\n",                          #   or: a normal detail line starting on the next line
+  "(?:[ \\t]{2,}",                #     either indented (2+ spaces/tabs)
+  "|\\*(?! (?:DONE|checking )))", #     or a '*' line that is NOT "* DONE" and NOT "* checking ..."
+  "[^\\n]*(?:\\n|$)",             #     consume the rest of that detail line (to newline/end)
+  ")*",
+  "[ \\t]*",                      # allow extra spaces/tabs after "..." on the SAME line
+  "(?:",                          # position the engine right before a status token if one exists
+  # Case 1: status token is on the current line (possibly preceded by comment text)
+  "(?:[^\\n]*[ \\t]+)?(?=(?:[A-Z]{2}[A-Z0-9_-]*)\\s*(?:\\n|$))",
+  "|",
+  # Case 2: status token is on the next line:
+  # consume remainder of current line + newline + optional indent,
+  # but only if the next thing is a status token at end-of-line
+  "[^\\n]*\\n[ \\t]*(?=(?:[A-Z]{2}[A-Z0-9_-]*)\\s*(?:\\n|$))",
+  "|",
+  # Case 3: no status token (eat remainder/comment and stop here)
+  "[^\\n]*",
+  ")",
+  "(?<status>(?:[A-Z]{2}[A-Z0-9_-]*)|)", # capture status token, or capture empty string if absent
+  "(?=\\s*(?:\\n|$))"                    # must end at newline/end (allow trailing whitespace)
 )
+
 # nolint end, styler: on
 
 #' @importFrom R6 R6Class
@@ -46,9 +64,17 @@ check_process <- R6::R6Class(
       if (!self$is_alive()) callback(self)
     },
     finish = function() {
-      self$poll_output()
-      self$save_results()
-      if (is.function(f <- private$finish_callback)) f(self)
+      # self$checks active binding calls poll_output so there is not need
+      # to call it explicitly
+      checks <- self$checks
+      # In some cases, check subprocess might suffer from a race condition, when
+      # process itself finished, but the final results of the last subcheck
+      # are not yet available to parse. Therefore we allow the process to
+      # finalize only if the last subcheck has reported status.
+      if (checks[length(checks)] != "") {
+        self$save_results()
+        if (is.function(f <- private$finish_callback)) f(self)
+      }
     },
     get_time_last_check_start = function() {
       private$time_last_check_start

R/checker.R

@@ -151,7 +151,6 @@ checker <- R6::R6Class(
     #' @return A integer value, coercible to logical to indicate whether a new
     #'   process was spawned, or `-1` if all tasks have finished.
     start_next_task = function() {
-      # finish any finished processes
       for (process in private$active) {
         if (!process$is_alive()) {
           process$finish()

R/pkg_origin.R

@@ -212,14 +212,14 @@ pkg_deps.pkg_origin_local <- function(
     dependencies = dependencies,
     db = row
   )
-  direct_deps$depth <- "direct"
+  direct_deps$depth <- rep.int("direct", NROW(direct_deps))
 
   indirect_deps <- pkg_dependencies(
     packages = direct_deps$name,
     dependencies = dependencies,
     db = db
   )
-  indirect_deps$depth <- "indirect"
+  indirect_deps$depth <- rep.int("indirect", NROW(indirect_deps))
 
   rbind(direct_deps, indirect_deps)
 }

R/plan.R

@@ -7,22 +7,13 @@
 #'
 #' @param path path to the package source.
 #' @param repos repository used to identify reverse dependencies.
-#' @param versions character vector indicating against which versions of the
-#'   package reverse dependency should be checked. `c("dev", "release")`
-#'   (default) stands for the classical reverse dependency check. `"dev"`
-#'   checks only against development version of the package which is applicable
-#'   mostly when checking whether adding new package would break tests of
-#'   packages already in the repository and take the package as suggests
-#'   dependency.
 #'
 #' @family plan
 #' @export
 plan_rev_dep_checks <- function(
   path,
-  repos = getOption("repos"),
-  versions = c("dev", "release")
+  repos = getOption("repos")
 ) {
-  version_types <- match.arg(versions, c("dev", "release"), several.ok = TRUE)
   path <- check_path_is_pkg_source(path)
   ap <- available_packages(repos = repos)
 
@@ -35,22 +26,7 @@ plan_rev_dep_checks <- function(
   )[[1]]
 
   if (length(revdeps) == 0) {
-    return(igraph::make_empty_graph())
-  }
-
-  if ("release" %in% version_types && !package %in% ap[, "Package"]) {
-    msg <- sprintf(
-      "Skipping 'release' checks. Package `%s` not found in repositories: \n",
-      package,
-      paste0(" * ", repos, collapse = "\n")
-    )
-
-    warning(msg, immediate. = TRUE)
-    version_types <- setdiff(version_types, "release")
-  }
-
-  if (length(version_types) == 0) {
-    return(igraph::make_empty_graph())
+    return(task_graph_class(igraph::make_empty_graph()))
   }
 
   # root meta task, indicating a reverse-dependency check plan

R/reporter_ansi_tty.R

@@ -499,15 +499,24 @@ report_finalize.reporter_ansi_tty <- function(reporter, checker) {
     failed_tasks[vlapply(failed_tasks, function(x) is_install(x$task))]
 
   failures_output <- vcapply(failed_packages, function(x) {
-    paste0(cli_wrap_lines(cli::cli_fmt(cli::cli_alert_danger(
-      sprintf(
-        "%s package installation had non-zero exit status",
-        package(x$task[[1]])
-      ),
-    ))), "\n",
-    cli_wrap_lines(as.character(cli::style_dim(
-      sprintf("log: %s", x$process[[1]]$log)
-    ))))
+    msg <- paste0(
+      cli_wrap_lines(cli::cli_fmt(cli::cli_alert_danger(
+        sprintf(
+          "%s package installation had non-zero exit status",
+          package(x$task[[1]])
+        )
+      ))),
+      collapse = "\n"
+    )
+    log <- paste0(
+      cli_wrap_lines(cli::cli_fmt(cli::cli_alert_danger(
+        sprintf("log: %s", x$process[[1]]$log)
+      ))),
+      collapse = "\n"
+    )
+    paste0(
+      msg, "\n", log
+    )
   })
 
   cat(failures_output, "\n")

R/reporter_null.R

@@ -1,5 +1,19 @@
+#' @export
+report_start_setup.NULL <- function(...) {}
+
+#' @export
+report_start_checks.NULL <- function(...) {}
+
+#' @export
+report_finalize.NULL <- function(...) {}
+
 #' @export
 report_status.NULL <- function(...) {}
 
 #' @export
 report_finalize.NULL <- function(...) {}
+
+#' @export
+report_step.NULL <- function(reporter, checker) {
+  checker$start_next_task() >= 0
+}

R/results.R

@@ -227,7 +227,6 @@ filter_results <- function(x, keep, ...) {
   } else {
     x
   }
-
 }
 
 count <- function(d, ...) {

R/task_graph.R

@@ -201,7 +201,11 @@ task_graph_sort <- function(g) {
 
   # use only strong dependencies to prioritize by topology (leafs first)
   strong_edges <- dep_edges(E(g), check_dependencies("strong"))
-  g_strong <- igraph::subgraph.edges(g, strong_edges, delete.vertices = FALSE)
+  g_strong <- igraph::subgraph_from_edges(
+    g,
+    strong_edges,
+    delete.vertices = FALSE
+  )
   topo <- igraph::topo_sort(g_strong, mode = "out")
   priority_topo <- integer(length(g))
   priority_topo[match(topo$name, V(g)$name)] <- rev(seq_along(topo))

R/utils-deps.R

@@ -68,6 +68,7 @@ pkg_dependencies <- function(
   verbose = FALSE
 ) {
   dependencies <- as_pkg_dependencies(dependencies)
+
   na_version <- package_version(NA_character_, strict = FALSE)
   proto_df <- data.frame(
     package = character(0L),
@@ -78,9 +79,9 @@ pkg_dependencies <- function(
   )
 
   depth <- 0L
-  out <- list()
+  out <- list(list(proto_df))
   while (length(packages) > 0L) {
-    depth <- depth + 1L
+    depth <- depth + 2L
     deptypes <- if (depth == 1L) dependencies$direct else dependencies$indirect
     # db does not need to have all the dependencies types.
     deptypes <- intersect(colnames(db), deptypes)

R/utils-igraph.R

@@ -59,11 +59,11 @@ graph_dedup_attrs <- function(g) {
   for (i in seq_along(v_dup_attrs)) {
     attr_name <- names(v_dup_attrs[i])
     attr_value <- igraph::vertex_attr(g, v_dup_attrs[[i]][[1L]])
-    g <- igraph::remove.vertex.attribute(g, v_dup_attrs[[i]][[1L]])
+    g <- igraph::delete_vertex_attr(g, v_dup_attrs[[i]][[1L]])
     for (attr_dup_name in v_dup_attrs[[i]][-1L]) {
       is_na <- is.na(attr_value)
       attr_value[is_na] <- igraph::vertex_attr(g, attr_dup_name)[is_na]
-      g <- igraph::remove.vertex.attribute(g, attr_dup_name)
+      g <- igraph::delete_vertex_attr(g, attr_dup_name)
     }
     g <- igraph::set_vertex_attr(g, attr_name, value = attr_value)
   }
@@ -76,11 +76,11 @@ graph_dedup_attrs <- function(g) {
   for (i in seq_along(e_dup_attrs)) {
     attr_name <- names(e_dup_attrs[i])
     attr_value <- igraph::edge_attr(g, e_dup_attrs[[i]][[1L]])
-    g <- igraph::remove.edge.attribute(g, e_dup_attrs[[i]][[1L]])
+    g <- igraph::delete_edge_attr(g, e_dup_attrs[[i]][[1L]])
     for (attr_dup_name in e_dup_attrs[[i]][-1L]) {
       is_na <- is.na(attr_value)
       attr_value[is_na] <- igraph::edge_attr(g, attr_dup_name)[is_na]
-      g <- igraph::remove.edge.attribute(g, attr_dup_name)
+      g <- igraph::delete_edge_attr(g, attr_dup_name)
     }
     g <- igraph::set_edge_attr(g, attr_name, value = attr_value)
   }

R/utils-paths.R

@@ -25,9 +25,7 @@ format_simplify_path <- function(x, ..., full.path = FALSE) {
       parts <- "."
     }
     do.call(file.path, as.list(parts))
-  }
-
-  if (first_diff > min_len) {
+  } else if (first_diff > min_len) {
     parts <- utils::tail(xp, -first_diff + 1)
     do.call(file.path, as.list(parts))
   } else if (first_diff <= min_len) {