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"
# system2() with captured output runs via /bin/sh, so shell-quote the git args
# (refs contain "^{}" and ":" that the shell would otherwise mangle).
ref_ok <- suppressWarnings(system2(
  "git",
  shQuote(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",
  shQuote(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",
  shQuote(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))
    # bincraft::build_binary_package() catches build failures internally and
    # RETURNS "error" for the failed tag rather than throwing, so a green gate
    # must inspect the return value -- checking only for a thrown exception
    # reports a broken build as passing.
    res <- tryCatch(
      bincraft::build_binary_package(
        pkg,
        tag_limit = 1L,
        patches = patches_dir,
        archive = FALSE,
        upload = FALSE,
        store_build_metadata = FALSE
      ),
      error = function(e) {
        cat(sprintf("FAILED %s (threw): %s\n", pkg, conditionMessage(e)))
        "error"
      }
    )
    flat <- as.character(unlist(res))
    ok <- length(flat) > 0L && !("error" %in% flat)
    if (!ok) {
      cat(sprintf(
        "FAILED %s: build did not succeed (result: %s)\n",
        pkg,
        if (length(flat) > 0L) toString(flat) else "<empty>"
      ))
    }
    ok
  },
  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)