1
2new_rcmdcheck <- function(stdout,
3                          stderr,
4                          description,
5                          status = 0L,
6                          duration = 0L,
7                          timeout = FALSE,
8                          test_fail = NULL,
9                          session_info = NULL) {
10
11  stopifnot(inherits(description, "description"))
12
13  # Make sure we don't have \r on windows
14  stdout <- win2unix(stdout)
15  stderr <- win2unix(stderr)
16
17  entries <- strsplit(paste0("\n", stdout), "\n\\*+[ ]")[[1]][-1]
18  checkdir <- parse_checkdir(entries)
19
20  notdone <- function(x) grep("^DONE", x, invert = TRUE, value = TRUE)
21
22  res <- structure(
23    list(
24      stdout      = stdout,
25      stderr      = stderr,
26      status      = status,
27      duration    = duration,
28      timeout     = timeout,
29
30      rversion    = parse_rversion(entries),
31      platform    = parse_platform(entries),
32      errors      = notdone(grep("ERROR\n",   entries, value = TRUE)),
33      warnings    = notdone(grep("WARNING\n", entries, value = TRUE)),
34      notes       = notdone(grep("NOTE\n",    entries, value = TRUE)),
35
36      description = description$str(normalize = FALSE),
37      package     = description$get("Package")[[1]],
38      version     = description$get("Version")[[1]],
39      cran        = description$get_field("Repository", "") == "CRAN",
40      bioc        = description$has_fields("biocViews"),
41
42      checkdir    = checkdir,
43      test_fail   = test_fail %||% get_test_fail(checkdir),
44      install_out = get_install_out(checkdir)
45    ),
46    class = "rcmdcheck"
47  )
48
49  res$session_info <- get_session_info(res$package, session_info)
50
51  if (isTRUE(timeout)) {
52    res$errors <- c(res$errors, "R CMD check timed out")
53  }
54
55  res
56}
57
58parse_rversion <- function(entries) {
59  line <- grep("^using R version", entries, value = TRUE)
60  sub("^using R version ([^\\s]+)\\s.*$", "\\1", line, perl = TRUE)
61}
62
63parse_platform <- function(entries) {
64  line <- grep("^using platform:", entries, value = TRUE)
65  sub("^using platform: ([^\\s]+)\\s.*$", "\\1", line, perl = TRUE)
66}
67
68parse_checkdir <- function(entries) {
69  quotes <- "\\x91\\x92\u2018\u2019`'"
70
71  line <- grep("^using log directory", entries, value = TRUE)
72  sub(
73    paste0("^using log directory [", quotes, "]([^", quotes, "]+)[", quotes, "]$"),
74    "\\1",
75    line,
76    perl = TRUE
77  )
78}
79
80get_test_fail <- function(path) {
81  test_path <- file.path(path, dir(path, pattern = "^tests"))
82  paths <- dir(test_path, pattern = "\\.Rout\\.fail$", full.names = TRUE)
83
84  test_dirs <- basename(dirname(paths))
85  rel_paths <- ifelse(
86    test_dirs == "tests",
87    basename(paths),
88    paste0(basename(paths), " (", sub("^tests_", "", test_dirs), ")"))
89  names(paths) <- gsub("\\.Rout.fail", "", rel_paths)
90
91  trim_header <- function(x) {
92    first_gt <- regexpr(">", x)
93    substr(x, first_gt, nchar(x))
94  }
95
96  tests <- lapply(paths, read_char)
97  tests <- lapply(tests, win2unix)
98  lapply(tests, trim_header)
99}
100
101#' @export
102as.data.frame.rcmdcheck <- function(x,
103                                    row.names = NULL,
104                                    optional = FALSE,
105                                    ...,
106                                    which) {
107
108  entries <- list(
109    type = c(
110      rep("error", length(x$errors)),
111      rep("warning", length(x$warnings)),
112      rep("note", length(x$notes))
113    ),
114    output = c(x$errors, x$warnings, x$notes)
115  )
116
117  data_frame(
118    which = which,
119    platform = x$platform %||% NA_character_,
120    rversion = x$rversion %||% NA_character_,
121    package = x$package %||% NA_character_,
122    version = x$version %||% NA_character_,
123    type = entries$type,
124    output = entries$output,
125    hash = hash_check(entries$output)
126  )
127}
128
129#' @importFrom digest digest
130
131hash_check <- function(check) {
132  cleancheck <- gsub("[^a-zA-Z0-9]", "", first_line(check))
133  vapply(cleancheck, digest, "")
134}
135
136#' Parse \code{R CMD check} results from a file or string
137#'
138#' At most one of \code{file} or \code{text} can be given.
139#' If both are \code{NULL}, then the current working directory
140#' is checked for a \code{00check.log} file.
141#'
142#' @param file The \code{00check.log} file, or a directory that
143#'   contains that file. It can also be a connection object.
144#' @param text The contentst of a \code{00check.log} file.
145#' @param ... Other arguments passed onto the constructor.
146#'   Used for testing.
147#' @return An \code{rcmdcheck} object, the check results.
148#'
149#' @seealso \code{\link{parse_check_url}}
150#' @export
151#' @importFrom desc description
152
153parse_check <- function(file = NULL, text = NULL, ...) {
154
155  ## If no text, then find the file, and read it in
156  if (is.null(text)) {
157    file <- find_check_file(file)
158    text <- readLines(file, encoding = "bytes")
159  }
160  stdout <- paste(reencode_log(text), collapse = "\n")
161
162  # Simulate minimal description from info in log
163  entries <- strsplit(paste0("\n", stdout), "\n* ", fixed = TRUE)[[1]][-1]
164  desc <- desc::description$new("!new")
165  desc$set(
166    Package = parse_package(entries),
167    Version = parse_version(entries)
168  )
169
170  new_rcmdcheck(
171    stdout = stdout,
172    stderr = "",
173    description = desc,
174    ...
175  )
176}
177
178validEnc <- function(x) {
179  ## We just don't do this on older R, because the functionality is
180  ## not available
181  if (getRversion() >= "3.3.0") {
182    asNamespace("base")$validEnc(x)
183  } else {
184    rep(TRUE, length(x))
185  }
186}
187
188reencode_log <- function(log) {
189  csline <- head(grep("^\\* using session charset: ",
190                      log, perl = TRUE, useBytes = TRUE, value = TRUE), 1)
191  if (length(csline)) {
192    cs <- strsplit(csline, ": ")[[1]][2]
193    log <- iconv(log, cs, "UTF-8", sub = "byte")
194    if (any(bad <- !validEnc(log))) {
195      log[bad] <- iconv(log[bad], to = "ASCII", sub = "byte")
196    }
197  } else {
198    log <- iconv(log, to = "ASCII", sub = "byte")
199  }
200  log
201}
202
203parse_package <- function(entries) {
204  line <- grep("^this is package .* version", entries, value = TRUE)
205  sub(
206    "^this is package .([a-zA-Z0-9\\.]+)[^a-zA-Z0-9\\.].*$",
207    "\\1",
208    line,
209    perl = TRUE
210  )
211}
212
213parse_version <- function(entries) {
214  line <- grep("^this is package .* version", entries, value = TRUE)
215  sub(
216    "^this is package .[a-zA-Z0-9\\.]+. version .([-0-9\\.]+)[^-0-9\\.].*$",
217    "\\1",
218    line,
219    perl = TRUE
220  )
221}
222
223
224#' Shorthand to parse R CMD check results from a URL
225#'
226#' @param url URL to parse the results from. Note that it should
227#'   not contain HTML markup, just the text output.
228#' @param quiet Passed to \code{download.file}.
229#' @return An \code{rcmdcheck} object, the check results.
230#'
231#' @seealso \code{\link{parse_check}}
232#' @export
233
234parse_check_url <- function(url, quiet = TRUE) {
235  parse_check(text = download_file(url, quiet = quiet))
236}
237
238find_check_file <- function(file) {
239
240  if (is.null(file)) file <- "."
241
242  if (file.exists(file) && file.info(file)$isdir) {
243    find_check_file_indir(file)
244  } else if (file.exists(file)) {
245    file
246  } else {
247    stop("Cannot find R CMD check output file")
248  }
249}
250
251find_check_file_indir <- function(dir) {
252  if (file.exists(logfile <- file.path(dir, "00check.log"))) {
253    logfile
254  } else {
255    stop("Cannot find R CMD check output file")
256  }
257}
258