build-cran-binaries/local/tests/test-proposal-tracking-lib.R

source(file.path("..", "proposal-tracking-lib.R"))
source(file.path("..", "failing-builds-classify.R"))

mk_failures <- function() {
  data.frame(
    name = c("StanHeaders", "rstan", "RcppParallel", "somepkg"),
    platform = c("alpine-321", "alpine-321", "alpine-320", "redhat-9"),
    arch = c("amd64", "arm64", "amd64", "amd64"),
    error_text = c(
      "fatal error: tbb/tbb_stddef.h: No such file or directory",
      "In file: tbb/tbb_stddef.h: No such file or directory",
      "Error: USE_TBB=Linux is not supported; bundled TBB on musl",
      "some unmatched failure"
    ),
    stringsAsFactors = FALSE
  )
}

test_that("merge_ledger appends new proposals and preserves existing history", {
  existing <- list(list(
    package = "fs",
    signature = "system-libuv-link-leak",
    status = "merged"
  ))
  new <- list(
    list(
      package = "fs",
      signature = "system-libuv-link-leak",
      status = "proposed"
    ),
    list(
      package = "StanHeaders",
      signature = "tbb-stddef-removed",
      status = "proposed"
    )
  )
  merged <- merge_ledger(existing, new)
  expect_length(merged, 2L) # fs is deduped, StanHeaders added
  fs <- Filter(function(r) r$package == "fs", merged)[[1L]]
  expect_identical(fs$status, "merged") # existing status preserved, not clobbered
})

test_that("merge_ledger handles an empty/NULL starting ledger", {
  new <- list(list(package = "x", signature = "s"))
  expect_length(merge_ledger(NULL, new), 1L)
  expect_length(merge_ledger(list(), new), 1L)
})

test_that("dedupe_candidates keeps single-signature pkgs, routes conflicts to triage", {
  candidates <- list(
    list(package = "StanHeaders", signature = "tbb-stddef-removed"),
    list(package = "hmmTMB", signature = "tbb-stddef-removed"),
    list(package = "hmmTMB", signature = "rcppparallel-bundled-tbb") # conflict
  )
  out <- dedupe_candidates(candidates)
  kept <- vapply(out$keep, function(c) c$package, character(1L))
  expect_identical(sort(kept), "StanHeaders") # hmmTMB dropped as ambiguous
  expect_true("hmmTMB" %in% names(out$ambiguous))
  expect_setequal(
    out$ambiguous$hmmTMB,
    c("tbb-stddef-removed", "rcppparallel-bundled-tbb")
  )
})

test_that("dedupe_candidates collapses a package repeated under one signature", {
  candidates <- list(
    list(package = "rstan", signature = "tbb-stddef-removed"),
    list(package = "rstan", signature = "tbb-stddef-removed")
  )
  out <- dedupe_candidates(candidates)
  expect_length(out$keep, 1L)
  expect_length(out$ambiguous, 0L)
})

test_that("dedupe_candidates handles the empty list", {
  out <- dedupe_candidates(list())
  expect_length(out$keep, 0L)
  expect_length(out$ambiguous, 0L)
})

test_that("signature_hit_rate splits addressed vs open per signature", {
  report <- build_triage_report(mk_failures(), registered_pkgs = "RcppParallel")
  hit <- signature_hit_rate(report, registered_pkgs = "RcppParallel")
  tbb <- Filter(function(h) h$signature == "tbb-stddef-removed", hit)[[1L]]
  expect_identical(tbb$packages, 2L) # StanHeaders + rstan
  expect_identical(tbb$addressed, 0L)
  expect_identical(tbb$open, 2L)
  expect_true(tbb$auto_proposable)

  rcpp <- Filter(function(h) h$signature == "rcppparallel-bundled-tbb", hit)[[
    1L
  ]]
  expect_identical(rcpp$addressed, 1L) # already registered
  expect_identical(rcpp$open, 0L)

  # Unclassified failures never appear as a signature.
  expect_false(
    "unclassified" %in% vapply(hit, function(h) h$signature, character(1L))
  )
})

test_that("proposed_vs_merged marks a package merged once it is registered", {
  ledger <- list(
    list(
      package = "StanHeaders",
      signature = "tbb-stddef-removed",
      status = "proposed"
    ),
    list(
      package = "rstan",
      signature = "tbb-stddef-removed",
      status = "proposed"
    )
  )
  pvm <- proposed_vs_merged(ledger, registered_pkgs = "StanHeaders")
  expect_identical(pvm$total, 2L)
  expect_identical(pvm$merged, 1L)
  stan <- Filter(function(r) r$package == "StanHeaders", pvm$records)[[1L]]
  expect_identical(stan$status, "merged")
})

test_that("unclassified_summary ranks unknown groups and caps output", {
  failures <- data.frame(
    name = c("a", "b", "c", "d", "solo"),
    platform = "ubuntu-2604",
    arch = "amd64",
    error_text = c(
      # 4 builds share one unknown fingerprint; 1 build a different unknown.
      rep("mystery linker meltdown at stage 3", 4L),
      "a totally different unknown boom"
    ),
    stringsAsFactors = FALSE
  )
  report <- build_triage_report(failures, registered_pkgs = character(0L))
  s <- unclassified_summary(report, max_groups = 30L, max_pkgs = 2L)
  expect_identical(s$total_groups, 2L)
  expect_identical(s$total_builds, 5L)
  # Largest group first, and its example packages are capped at max_pkgs.
  expect_identical(s$groups[[1L]]$build_count, 4L)
  expect_length(s$groups[[1L]]$packages, 2L)
  expect_true(s$groups[[1L]]$packages_truncated)

  # max_groups cap is reported, not silently dropped.
  capped <- unclassified_summary(report, max_groups = 1L)
  expect_length(capped$groups, 1L)
  expect_identical(capped$dropped_groups, 1L)
})

test_that("blocked_summary lists each dependency and its dependent count", {
  failures <- data.frame(
    name = c("ACEsimFit", "AovBay", "AdaptGauss"),
    platform = "ubuntu-2604",
    arch = "amd64",
    error_text = "Error: USE_TBB=Linux is not supported on this toolchain",
    stringsAsFactors = FALSE
  )
  report <- build_triage_report(failures, registered_pkgs = character(0L))
  b <- blocked_summary(report, max_pkgs = 2L)
  expect_length(b, 1L)
  expect_identical(b[[1L]]$blocked_on, "RcppParallel")
  expect_identical(b[[1L]]$n_packages, 3L)
  expect_true(b[[1L]]$packages_truncated)
})

test_that("entry_applies_to_os matches codename, family, and wildcard", {
  expect_true(entry_applies_to_os(list("ubuntu-2604"), "ubuntu-2604"))
  expect_true(entry_applies_to_os(list("ubuntu"), "ubuntu-2604")) # family
  expect_true(entry_applies_to_os(list("*"), "ubuntu-2604"))
  expect_true(entry_applies_to_os(list("alpine", "ubuntu-2604"), "ubuntu-2604"))
  expect_false(entry_applies_to_os(list("alpine-324"), "ubuntu-2604"))
  expect_false(entry_applies_to_os(list("ubuntu-2404"), "ubuntu-2604")) # other codename
})

test_that("new_registry_packages returns only added entries for the platform", {
  base <- list(
    list(
      package = "RcppParallel",
      platforms = list("alpine", "ubuntu-2604"),
      versions = "*"
    )
  )
  current <- list(
    base[[1L]], # unchanged -> not "new"
    list(package = "BFpack", platforms = list("ubuntu-2604"), versions = "*"),
    list(
      package = "someAlpinePkg",
      platforms = list("alpine-324"),
      versions = "*"
    )
  )
  # For ubuntu-2604: only the newly-added BFpack (RcppParallel is unchanged,
  # someAlpinePkg does not apply to this OS).
  expect_identical(
    new_registry_packages(current, base, os = "ubuntu-2604"),
    "BFpack"
  )
  # For alpine-324: the alpine package is new and applies.
  expect_identical(
    new_registry_packages(current, base, os = "alpine-324"),
    "someAlpinePkg"
  )
  # Without an OS filter, both additions are returned.
  expect_setequal(
    new_registry_packages(current, base),
    c("BFpack", "someAlpinePkg")
  )
  # A changed platform set on the same package counts as a new entry.
  widened <- list(list(
    package = "RcppParallel",
    platforms = list("*"),
    versions = "*"
  ))
  expect_identical(new_registry_packages(widened, base), "RcppParallel")
})

test_that("retirement_candidates flags entries whose package no longer fails", {
  entries <- list(
    list(package = "RcppParallel"),
    list(package = "oldpkg")
  )
  # RcppParallel still fails; oldpkg does not -> only oldpkg is retirable.
  out <- retirement_candidates(
    entries,
    failing_pkgs = c("RcppParallel", "StanHeaders")
  )
  expect_identical(out, "oldpkg")
  expect_length(
    retirement_candidates(entries, failing_pkgs = c("RcppParallel", "oldpkg")),
    0L
  )
})