build-cran-binaries/local/failing-builds-classify.R

# Pure, side-effect-free helpers for triaging `single_builds` failures:
# normalise a raw `error_text` into a stable fingerprint, and classify it
# against a seed set of known failure signatures (issue #115, steps 1 + 2).
#
# Kept free of DB/IO so it can be sourced by both `failing-builds-report.R`
# and the unit tests in `local/tests/`.

# ---------------------------------------------------------------------------
# Signature table
# ---------------------------------------------------------------------------
# Each rule maps a recurring compile/link/load error to a suggested fix tier.
# `pattern` is a case-insensitive regex matched against the raw `error_text`.
# `auto` marks whether the fix is a *known lever* safe to auto-propose as a PR
# (env / makevars / an already-curated package-specific patch). Rules that
# would require a brand-new source diff for a previously-unseen package stay
# `auto = FALSE` -> classified, but always routed to human triage, per the
# issue's guardrail against shipping autonomous novel source diffs.
#
# Seeded from the existing registry entries and known recurring failures; add
# a row here as new signatures are confirmed. Order matters: the first match
# wins, so keep more specific patterns above broader ones.
build_signatures <- function() {
  list(
    list(
      id = "tbb-stddef-removed",
      label = "removed TBB header tbb/tbb_stddef.h",
      pattern = "tbb/tbb_stddef\\.h.*No such file",
      tier = "makevars",
      confidence = "high",
      auto = TRUE,
      fix = "add CPPFLAGS += -DTBB_INTERFACE_NEW so the source stops including the removed tbb/tbb_stddef.h header",
      example = "StanHeaders / rstan (#114)",
      registry = list(
        env = NULL,
        configure_args = NULL,
        makevars = list(CPPFLAGS = "-DTBB_INTERFACE_NEW"),
        patch = NULL,
        reason = "package includes the removed tbb/tbb_stddef.h; -DTBB_INTERFACE_NEW selects the new oneTBB interface path"
      )
    ),
    list(
      id = "rcppparallel-bundled-tbb",
      label = "bundled Intel TBB build fails/hangs (musl / new g++)",
      pattern = "USE_TBB[^\\n]*(not supported|unsupported)|RcppParallel[^\\n]*TBB|tbb[^\\n]*(Alpine|musl)",
      tier = "patch",
      confidence = "high",
      auto = TRUE,
      fix = "apply the curated RcppParallel/disable-tbb.patch so the bundled TBB build is skipped and the TinyThread backend is used",
      example = "RcppParallel",
      registry = list(
        env = NULL,
        configure_args = NULL,
        makevars = NULL,
        patch = "RcppParallel/disable-tbb.patch",
        reason = "bundled Intel TBB build hangs/fails on musl (Alpine) and newer toolchains; patch forces the TinyThread backend"
      )
    ),
    list(
      id = "system-libuv-link-leak",
      label = "binary links system libuv (NEEDED libuv.so.1)",
      pattern = "libuv\\.so",
      tier = "patch",
      confidence = "medium",
      # A novel per-package source diff is required to force the vendored lib;
      # never auto-propose, only surface for a human (guardrail).
      auto = FALSE,
      fix = "force the vendored/static library instead of the system one via a human-authored source patch (see fs/force-vendored-libuv.patch as precedent)",
      example = "fs",
      registry = list(
        env = NULL,
        configure_args = NULL,
        makevars = NULL,
        patch = "<package>/force-vendored-<lib>.patch",
        reason = "binary links the system library and fails to dyn.load on consumer machines; force the vendored/static build"
      )
    )
  )
}

# ---------------------------------------------------------------------------
# Normalisation
# ---------------------------------------------------------------------------
# Collapse build-specific noise (temp paths, version numbers, hex addresses,
# the package name) so the same root cause across packages/platforms/versions
# maps to one fingerprint bucket.
normalise_error <- function(error_text, package = NULL) {
  if (length(error_text) == 0L || is.na(error_text) || !nzchar(error_text)) {
    return("")
  }
  x <- as.character(error_text)
  # Package-specific token first (before version/number stripping mangles it).
  if (!is.null(package) && length(package) == 1L && nzchar(package)) {
    # \Q..\E quotes the name literally so metachars (e.g. data.table's dot)
    # are matched verbatim rather than as regex.
    x <- gsub(paste0("\\b\\Q", package, "\\E\\b"), "<pkg>", x, perl = TRUE)
  }
  # R temp dirs/files: /tmp/RtmpAbC123, RtmpXXXX, /tmp/Rtmp.../file123.
  x <- gsub("/tmp/[^ \t\n]*", "<tmp>", x, perl = TRUE)
  x <- gsub("\\bRtmp[A-Za-z0-9]+", "Rtmp<x>", x, perl = TRUE)
  # Hex addresses and version-like number runs.
  x <- gsub("0x[0-9a-fA-F]+", "0x<addr>", x, perl = TRUE)
  x <- gsub("[0-9]+(\\.[0-9]+)+", "<v>", x, perl = TRUE)
  x <- gsub("\\b[0-9]{2,}\\b", "<n>", x, perl = TRUE)
  # Whitespace and case.
  x <- tolower(x)
  x <- gsub("[ \t\r\n]+", " ", x, perl = TRUE)
  trimws(x)
}

# Extract the single most informative line from a multi-line error, then
# normalise it. This is the grouping key; a short salient line groups far
# better than the whole (often huge) transcript.
fingerprint_error <- function(error_text, package = NULL, max_chars = 200L) {
  if (length(error_text) == 0L || is.na(error_text) || !nzchar(error_text)) {
    return("<empty>")
  }
  lines <- strsplit(as.character(error_text), "\n", fixed = TRUE)[[1L]]
  lines <- trimws(lines)
  lines <- lines[nzchar(lines)]
  if (length(lines) == 0L) {
    return("<empty>")
  }
  salient_re <- paste(
    "error:",
    "fatal error:",
    "no such file",
    "undefined reference",
    "cannot find -l",
    "cannot open shared object",
    "configuration failed",
    "non-zero exit",
    "installation of package",
    "compilation failed",
    sep = "|"
  )
  hit <- lines[grepl(salient_re, lines, ignore.case = TRUE)]
  chosen <- if (length(hit) > 0L) hit[[1L]] else lines[[length(lines)]]
  fp <- normalise_error(chosen, package)
  if (nchar(fp) > max_chars) {
    fp <- paste0(substr(fp, 1L, max_chars), "...")
  }
  fp
}

# ---------------------------------------------------------------------------
# Classification
# ---------------------------------------------------------------------------
# Return the first matching signature (as a list) enriched with `matched`, or
# the unclassified fallback. Never guesses: an unmatched error is routed to a
# human, not assigned a fix.
classify_error <- function(error_text, signatures = build_signatures()) {
  txt <- if (length(error_text) == 0L || is.na(error_text)) {
    ""
  } else {
    as.character(error_text)
  }
  for (sig in signatures) {
    if (
      nzchar(txt) && grepl(sig$pattern, txt, ignore.case = TRUE, perl = TRUE)
    ) {
      sig$matched <- TRUE
      return(sig)
    }
  }
  list(
    id = "unclassified",
    label = "unknown signature",
    tier = NA_character_,
    confidence = NA_character_,
    auto = FALSE,
    fix = "no known signature; flag for human triage",
    example = NA_character_,
    registry = NULL,
    matched = FALSE
  )
}

# Build a suggested registry.json entry (as an R list) for a classified group,
# filling package/versions/platforms from the observed failures. Only
# meaningful when the signature carries a `registry` template.
propose_registry_entry_list <- function(
  signature,
  package,
  platforms,
  versions = "*"
) {
  if (is.null(signature$registry)) {
    return(NULL)
  }
  tmpl <- signature$registry
  entry <- list(
    package = package,
    versions = versions,
    # I() keeps this a JSON array even when a single platform is affected.
    platforms = I(sort(unique(as.character(platforms))))
  )
  for (k in c("env", "configure_args", "makevars", "patch")) {
    if (!is.null(tmpl[[k]])) {
      entry[[k]] <- tmpl[[k]]
    }
  }
  entry$reason <- tmpl$reason
  entry
}

# Same, rendered as a pretty JSON string.
propose_registry_entry <- function(
  signature,
  package,
  platforms,
  versions = "*"
) {
  entry <- propose_registry_entry_list(signature, package, platforms, versions)
  if (is.null(entry)) {
    return(NULL)
  }
  jsonlite::toJSON(entry, auto_unbox = TRUE, pretty = TRUE, null = "null")
}

# Resolve the representative signature for a group by its id, re-attaching the
# `matched` flag the report/proposer rely on. Unknown ids -> unclassified.
resolve_signature <- function(sig_id, signatures = build_signatures()) {
  hit <- Filter(function(s) s$id == sig_id, signatures)
  if (length(hit) > 0L) {
    s <- hit[[1L]]
    s$matched <- TRUE
    s
  } else {
    classify_error("", signatures) # unclassified fallback (matched = FALSE)
  }
}

# ---------------------------------------------------------------------------
# Triage report (shared by the report printer and the patch proposer)
# ---------------------------------------------------------------------------
# `failures` is a data.frame with at least: name, platform, arch, error_text.
# `registered_pkgs` is the set of packages that already carry a registry entry.
# Returns a list of group records (one per root-cause bucket), ordered by
# number of affected builds descending. Pure: no IO, no printing.
build_triage_report <- function(
  failures,
  registered_pkgs = character(0L),
  signatures = build_signatures()
) {
  if (nrow(failures) == 0L) {
    return(list())
  }
  idx <- seq_len(nrow(failures))
  failures$fingerprint <- vapply(
    idx,
    function(i) fingerprint_error(failures$error_text[[i]], failures$name[[i]]),
    character(1L)
  )
  failures$sig_id <- vapply(
    idx,
    function(i) classify_error(failures$error_text[[i]], signatures)$id,
    character(1L)
  )
  # Group by root cause: classified failures collapse by signature id (same fix
  # candidate is one bucket regardless of log noise); unclassified failures fall
  # back to the fingerprint so distinct unknowns stay separate for discovery.
  failures$group_key <- ifelse(
    failures$sig_id == "unclassified",
    failures$fingerprint,
    failures$sig_id
  )
  groups <- split(failures, failures$group_key)
  groups <- groups[order(-vapply(groups, nrow, integer(1L)))]

  lapply(unname(groups), function(g) {
    sig_id <- names(sort(table(g$sig_id), decreasing = TRUE))[[1L]]
    sig <- resolve_signature(sig_id, signatures)

    fp_tab <- sort(table(g$fingerprint), decreasing = TRUE)
    pkgs <- sort(unique(g$name))
    plats <- sort(unique(g$platform))
    arches <- sort(unique(g$arch))
    unregistered <- setdiff(pkgs, registered_pkgs)
    auto_proposable <- isTRUE(sig$auto) && sig$matched

    proposed <- list()
    if (auto_proposable) {
      for (p in unregistered) {
        proposed[[p]] <- propose_registry_entry_list(
          sig,
          p,
          g$platform[g$name == p]
        )
      }
    }

    list(
      signature = sig$id,
      label = sig$label,
      matched = sig$matched,
      auto_proposable = auto_proposable,
      tier = sig$tier,
      confidence = sig$confidence,
      suggested_fix = sig$fix,
      fingerprint = names(fp_tab)[[1L]],
      fingerprint_variants = length(fp_tab),
      build_count = nrow(g),
      packages = pkgs,
      packages_without_entry = unregistered,
      platforms = plats,
      arches = arches,
      proposed_entries = if (length(proposed) > 0L) proposed else NULL
    )
  })
}