191 lines
5.5 KiB
Markdown
191 lines
5.5 KiB
Markdown
### Task A4: Build a patched binary in isolation
|
|
|
|
**Files:**
|
|
- Modify: `R/patches.R`
|
|
- Test: `tests/testthat/test-patches.R`
|
|
|
|
**Interfaces:**
|
|
- Consumes: a normalized entry, a resolved `version`, a `dest_dir`.
|
|
- Produces: `download_cran_source(package, version, dest_dir, cran)` → path or `NULL`; `apply_source_patch(patch_path, pkg_src)` → logical; `configure_args_to_build_args(configure_args)` → character; `build_patched_binary(entry, version, dest_dir)` → path to built binary tarball or `NULL`.
|
|
|
|
- [ ] **Step 1: Write the failing test**
|
|
|
|
```r
|
|
test_that("configure_args_to_build_args formats configure args", {
|
|
expect_identical(configure_args_to_build_args(character(0L)), character(0L))
|
|
expect_identical(
|
|
configure_args_to_build_args(c("--with-foo", "--no-bar")),
|
|
"--configure-args=--with-foo --no-bar"
|
|
)
|
|
})
|
|
|
|
test_that("apply_source_patch returns FALSE when patch does not apply", {
|
|
src <- withr::local_tempdir()
|
|
writeLines("unrelated content", file.path(src, "file.txt"))
|
|
bad_patch <- tempfile(fileext = ".patch")
|
|
writeLines(c(
|
|
"--- a/missing.txt", "+++ b/missing.txt",
|
|
"@@ -1 +1 @@", "-nope", "+nope2"
|
|
), bad_patch)
|
|
expect_false(apply_source_patch(bad_patch, src))
|
|
})
|
|
|
|
test_that("build_patched_binary returns NULL when download fails", {
|
|
local_mocked_bindings(download_cran_source = function(...) NULL)
|
|
expect_null(
|
|
build_patched_binary(
|
|
list(package = "P", env = list(), configure_args = character(0L),
|
|
makevars = list(), patch_path = NULL),
|
|
"1.0", withr::local_tempdir()
|
|
)
|
|
)
|
|
})
|
|
```
|
|
|
|
- [ ] **Step 2: Run test to verify it fails**
|
|
|
|
Run: `Rscript -e 'devtools::load_all("."); testthat::test_file("tests/testthat/test-patches.R")'`
|
|
Expected: FAIL with "could not find function configure_args_to_build_args".
|
|
|
|
- [ ] **Step 3: Write minimal implementation (append to `R/patches.R`)**
|
|
|
|
```r
|
|
#' Download a CRAN source tarball for an exact version
|
|
#' @keywords internal
|
|
download_cran_source <- function(
|
|
package,
|
|
version,
|
|
dest_dir,
|
|
cran = "https://cloud.r-project.org"
|
|
) {
|
|
fname <- sprintf("%s_%s.tar.gz", package, version)
|
|
urls <- c(
|
|
sprintf("%s/src/contrib/%s", cran, fname),
|
|
sprintf("%s/src/contrib/Archive/%s/%s", cran, package, fname)
|
|
)
|
|
dest <- file.path(dest_dir, fname)
|
|
for (u in urls) {
|
|
ok <- tryCatch(
|
|
{
|
|
utils::download.file(u, dest, mode = "wb", quiet = TRUE)
|
|
file.exists(dest) && file.size(dest) > 0L
|
|
},
|
|
error = function(e) FALSE
|
|
)
|
|
if (isTRUE(ok)) {
|
|
return(dest)
|
|
}
|
|
}
|
|
log_warn(sprintf(
|
|
"Could not download CRAN source for {.pkg %s} %s.",
|
|
package, version
|
|
))
|
|
NULL
|
|
}
|
|
|
|
#' Apply a unified diff to an unpacked source tree
|
|
#'
|
|
#' Uses `patch -p1 --forward` so an already-applied or non-applying patch fails
|
|
#' cleanly (returns FALSE) instead of corrupting the tree.
|
|
#' @keywords internal
|
|
apply_source_patch <- function(patch_path, pkg_src) {
|
|
status <- system2(
|
|
"patch",
|
|
args = c(
|
|
"-p1", "--forward", "--batch",
|
|
"-d", shQuote(pkg_src),
|
|
"-i", shQuote(patch_path)
|
|
),
|
|
stdout = FALSE, stderr = FALSE
|
|
)
|
|
identical(status, 0L)
|
|
}
|
|
|
|
#' Format configure args for `pkgbuild::build(args = ...)`
|
|
#' @keywords internal
|
|
configure_args_to_build_args <- function(configure_args) {
|
|
if (length(configure_args) == 0L) {
|
|
return(character(0L))
|
|
}
|
|
sprintf("--configure-args=%s", paste(configure_args, collapse = " "))
|
|
}
|
|
|
|
#' Build a patched binary for one registry entry, in isolation
|
|
#'
|
|
#' Downloads CRAN source for `version`, applies the source patch (if any), and
|
|
#' builds a binary with the entry's env / configure / Makevars overrides scoped
|
|
#' to this build only. Returns the built tarball path, or `NULL` on any failure.
|
|
#' @keywords internal
|
|
build_patched_binary <- function(entry, version, dest_dir) {
|
|
workdir <- tempfile("patch_build_")
|
|
dir.create(workdir, recursive = TRUE, showWarnings = FALSE)
|
|
on.exit(unlink(workdir, recursive = TRUE, force = TRUE), add = TRUE)
|
|
|
|
src_tarball <- download_cran_source(entry$package, version, workdir)
|
|
if (is.null(src_tarball)) {
|
|
return(NULL)
|
|
}
|
|
|
|
utils::untar(src_tarball, exdir = workdir)
|
|
pkg_src <- file.path(workdir, entry$package)
|
|
|
|
if (!is.null(entry$patch_path)) {
|
|
if (!apply_source_patch(entry$patch_path, pkg_src)) {
|
|
log_warn(sprintf(
|
|
"Patch for {.pkg %s} %s did not apply cleanly; skipping patched build.",
|
|
entry$package, version
|
|
))
|
|
return(NULL)
|
|
}
|
|
}
|
|
|
|
build_env <- entry$env
|
|
if (length(entry$makevars) > 0L) {
|
|
mk <- tempfile(fileext = ".mk")
|
|
writeLines(
|
|
vapply(
|
|
names(entry$makevars),
|
|
function(k) sprintf("%s=%s", k, entry$makevars[[k]]),
|
|
character(1L)
|
|
),
|
|
mk
|
|
)
|
|
build_env$R_MAKEVARS_USER <- mk
|
|
}
|
|
|
|
tryCatch(
|
|
withr::with_envvar(build_env, {
|
|
pkgbuild::build(
|
|
path = pkg_src,
|
|
binary = TRUE,
|
|
vignettes = FALSE,
|
|
dest_path = dest_dir,
|
|
args = configure_args_to_build_args(entry$configure_args),
|
|
quiet = TRUE
|
|
)
|
|
}),
|
|
error = function(e) {
|
|
log_warn(sprintf(
|
|
"Isolated patched build of {.pkg %s} %s failed: %s",
|
|
entry$package, version, conditionMessage(e)
|
|
))
|
|
NULL
|
|
}
|
|
)
|
|
}
|
|
```
|
|
|
|
- [ ] **Step 4: Run test to verify it passes**
|
|
|
|
Run: `Rscript -e 'devtools::load_all("."); testthat::test_file("tests/testthat/test-patches.R")'`
|
|
Expected: PASS.
|
|
|
|
- [ ] **Step 5: Commit**
|
|
|
|
```bash
|
|
git add R/patches.R tests/testthat/test-patches.R
|
|
git commit -m "feat(patches): build a patched binary in isolation from CRAN source"
|
|
```
|
|
|
|
---
|
|
|