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