File: check-devtools.R

package info (click to toggle)
r-cran-devtools 2.4.5-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 1,328 kB
  • sloc: sh: 15; makefile: 5
file content (144 lines) | stat: -rw-r--r-- 3,564 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#' Custom devtools release checks.
#'
#' This function performs additional checks prior to release. It is called
#' automatically by [release()].
#'
#' @template devtools
#' @keywords internal
#' @export
release_checks <- function(pkg = ".", built_path = NULL) {
  pkg <- as.package(pkg)
  cat_rule(paste0("Running additional devtools checks for ", pkg$package))

  check_version(pkg)
  check_dev_versions(pkg)
  check_vignette_titles(pkg)
  check_news_md(pkg)
  check_remotes(pkg)

  cat_rule()
}

check_dev_versions <- function(pkg = ".") {
  pkg <- as.package(pkg)

  dep_list <- pkg[tolower(remotes::standardise_dep(TRUE))]
  deps <- do.call("rbind", unname(compact(lapply(dep_list, parse_deps))))
  deps <- deps[!is.na(deps$version), , drop = FALSE]

  parsed <- lapply(deps$version, function(x) unlist(numeric_version(x)))

  lengths <- vapply(parsed, length, integer(1))
  last_ver <- vapply(parsed, function(x) x[[length(x)]], integer(1))

  is_dev <- lengths == 4 & last_ver >= 9000

  check_status(
    !any(is_dev),
    "dependencies don't rely on dev versions",
    paste(
      "depends on devel versions of: ",
      paste0(deps$name[is_dev], collapse = ", ")
    )
  )

  return(invisible(FALSE))
}

check_version <- function(pkg = ".") {
  pkg <- as.package(pkg)
  ver <- unlist(numeric_version(pkg$version))

  check_status(
    length(ver) == 3,
    "version number has three components",
    paste0("version (", pkg$version, ") should have exactly three components")
  )
}

check_vignette_titles <- function(pkg = ".") {
  pkg <- as.package(pkg)
  vigns <- tools::pkgVignettes(dir = pkg$path)
  if (length(vigns$docs) == 0) return()

  has_vignette_title <- function(v, n) {
    h <- readLines(v, n = n)
    any(grepl("Vignette Title", h))
  }
  v <- stats::setNames(vigns$docs, path_file(vigns$docs))
  has_vt <- vapply(v, has_vignette_title, logical(1), n = 30)

  check_status(
    !any(has_vt),
    "vignette titles are not placeholders",
    paste0(
      "placeholder 'Vignette Title' detected in 'title' field and/or ",
      "'VignetteIndexEntry' for: ",
      paste(names(has_vt)[has_vt], collapse = ",")
    )
  )
}

check_news_md <- function(pkg) {
  pkg <- as.package(pkg)

  news_path <- path(pkg$path, "NEWS.md")
  if (!file_exists(news_path)) {
    return()
  }

  ignore_path <- path(pkg$path, ".Rbuildignore")
  if (!file_exists(ignore_path)) {
    ignore_lines <- character()
  } else {
    ignore_lines <- readLines(ignore_path)
  }

  has_news <- grepl("NEWS\\.md", ignore_lines, fixed = TRUE) |
    grepl("NEWS.md", ignore_lines, fixed = TRUE)

  check_status(
    !any(has_news),
    "NEWS.md is not ignored",
    "NEWS.md now supported by CRAN and doesn't need to be ignored."
  )

  news_rd_path <- path(pkg$path, "inst/NEWS.Rd")
  check_status(
    !file_exists(news_rd_path),
    "NEWS.Rd does not exist",
    "NEWS.md now supported by CRAN, NEWS.Rd can be removed."
  )
}

check_remotes <- function(pkg) {
  check_status(
    !has_dev_remotes(pkg),
    "DESCRIPTION doesn't have Remotes field",
    "Remotes field should be removed before CRAN submission."
  )
}

has_dev_remotes <- function(pkg) {
  !is.null(pkg[["remotes"]])
}

check_status <- function(status, name, warning) {
  cat("Checking ", name, "...", sep = "")

  status <- tryCatch(
    if (status) {
      cat(" OK\n")
    } else {
      cat("\n")
      cli::cli_inform(c(x = "WARNING: {warning}"))
    },
    error = function(e) {
      cat("\n")
      cli::cli_inform(c(x = "ERROR: {conditionMessage(e)}"))
      FALSE
    }
  )

  invisible(status)
}