build-cran-binaries/local/trial-build-registry.R

#!/usr/bin/env Rscript

# Merge gate for the auto-patch PR (issue #115, step 3): for every registry
# entry the PR ADDS that applies to this platform, trial-build the package with
# the registry applied, in this platform's own build-env image. Nothing is
# uploaded, archived, or written to the metadata DB.
#
# Exit 0 only if every new entry's package builds; exit 1 if any fails, so it
# gates the PR. A platform with no new entries is a fast no-op.
#
# Usage (inside a build-env image):
#   PLATFORM=ubuntu-2604 Rscript local/trial-build-registry.R [base_ref]
#     base_ref  git ref to diff the registry against (default: origin/main)

options(error = function() {
  cat("ERROR:", geterrmessage(), "\n", file = stdout())
  q(status = 1)
})

suppressPackageStartupMessages({
  library(jsonlite, quietly = TRUE)
  library(bincraft, quietly = TRUE)
})

script_path <- local({
  a <- commandArgs(trailingOnly = FALSE)
  f <- sub("^--file=", "", a[grepl("^--file=", a)])
  if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
script_dir <- if (is.na(script_path)) "local" else dirname(script_path)
source(file.path(script_dir, "proposal-tracking-lib.R"))

args <- commandArgs(trailingOnly = TRUE)
base_ref <- if (length(args) >= 1L) {
  args[[1L]]
} else {
  Sys.getenv("BASE_REF", "origin/main")
}
os <- Sys.getenv("PLATFORM", "")
if (!nzchar(os)) {
  stop("PLATFORM env var is not set (e.g. ubuntu-2604).")
}

patches_dir <- file.path(script_dir, "patches")
registry_file <- file.path(patches_dir, "registry.json")
current <- if (file.exists(registry_file)) {
  jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
} else {
  list()
}
# Read the registry at base_ref. Fail loud if the ref or file can't be read:
# silently treating the base as empty would trial-build the WHOLE registry
# instead of just the entries the branch adds.
registry_rel <- "local/patches/registry.json"
ref_ok <- suppressWarnings(system2(
  "git",
  c("rev-parse", "--verify", "--quiet", sprintf("%s^{commit}", base_ref)),
  stdout = TRUE,
  stderr = FALSE
))
if (!is.null(attr(ref_ok, "status"))) {
  stop(sprintf("base ref %s does not resolve to a commit.", base_ref))
}
in_base <- suppressWarnings(system2(
  "git",
  c("ls-tree", base_ref, "--", registry_rel),
  stdout = TRUE,
  stderr = FALSE
))
file_in_base <- length(in_base) > 0L && any(nzchar(in_base))
base_json <- suppressWarnings(system2(
  "git",
  c("show", sprintf("%s:%s", base_ref, registry_rel)),
  stdout = TRUE,
  stderr = FALSE
))
show_ok <- is.null(attr(base_json, "status"))
if (file_in_base && !show_ok) {
  stop(sprintf(
    "could not read %s at %s; refusing to build the whole registry.",
    registry_rel,
    base_ref
  ))
}
base <- if (show_ok && length(base_json) > 0L) {
  jsonlite::fromJSON(paste(base_json, collapse = "\n"), simplifyVector = FALSE)
} else {
  list() # file genuinely absent at base -> every entry is new
}

pkgs <- new_registry_packages(current, base, os = os)
if (length(pkgs) == 0L) {
  cat(sprintf(
    "No new registry entries apply to %s; nothing to trial-build.\n",
    os
  ))
  q(status = 0)
}

cat(sprintf(
  "Trial-building %d new registry %s on %s (vs %s):\n  %s\n",
  length(pkgs),
  if (length(pkgs) == 1L) "entry" else "entries",
  os,
  base_ref,
  toString(pkgs)
))

results <- vapply(
  pkgs,
  function(pkg) {
    cat(sprintf("\n=== trial build: %s ===\n", pkg))
    tryCatch(
      {
        bincraft::build_binary_package(
          pkg,
          tag_limit = 1L,
          patches = patches_dir,
          archive = FALSE,
          upload = FALSE,
          store_build_metadata = FALSE
        )
        TRUE
      },
      error = function(e) {
        cat(sprintf("FAILED %s: %s\n", pkg, conditionMessage(e)))
        FALSE
      }
    )
  },
  logical(1L)
)

failed <- pkgs[!results]
cat(sprintf(
  "\n%d/%d passed on %s.%s\n",
  sum(results),
  length(results),
  os,
  if (length(failed) > 0L) sprintf(" Failed: %s", toString(failed)) else ""
))
if (length(failed) > 0L) {
  q(status = 1)
}
q(status = 0)