diff --git a/.Rbuildignore b/.Rbuildignore index 17eb4a30..a2eeaba2 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -14,3 +14,4 @@ ^\.claude$ ^CRAN-SUBMISSION$ ^doc$ +^\.positai$ diff --git a/.gitignore b/.gitignore index dc0897a0..4b6bf6f5 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ roadmap.md /.quarto/ .tmp check/ +.positai diff --git a/R/compiler.R b/R/compiler.R index eecbc6de..50607fd4 100644 --- a/R/compiler.R +++ b/R/compiler.R @@ -1,28 +1,22 @@ -quickr_flang_path <- function(which = Sys.which) { - flang_new <- which("flang-new") +quickr_flang_path <- function() { + flang_new <- Sys.which("flang-new") if (nzchar(flang_new)) { return(flang_new) } - flang <- which("flang") + flang <- Sys.which("flang") if (nzchar(flang)) { return(flang) } "" } -quickr_flang_available <- function( - which = Sys.which, - system2 = base::system2 -) { - flang <- quickr_flang_path(which = which) - quickr_flang_available_at_path(flang, system2 = system2) +quickr_flang_available <- function() { + flang <- quickr_flang_path() + quickr_flang_available_at_path(flang) } -quickr_flang_available_at_path <- function( - flang, - system2 = base::system2 -) { - stopifnot(is_string(flang), is.function(system2)) +quickr_flang_available_at_path <- function(flang) { + stopifnot(is_string(flang)) if (!nzchar(flang)) { return(list(path = "", available = FALSE)) @@ -38,17 +32,11 @@ quickr_flang_available_at_path <- function( } quickr_cached_flang_available <- function( - which = Sys.which, - system2 = base::system2, cache = quickr_compiler_probe_cache ) { - stopifnot(is.function(which), is.function(system2), is.environment(cache)) - - flang <- quickr_flang_path(which = which) - if (!identical(system2, base::system2)) { - return(quickr_flang_available_at_path(flang, system2 = system2)) - } + stopifnot(is.environment(cache)) + flang <- quickr_flang_path() cache_key <- paste("flang_available", flang, sep = "\r") cached <- get0(cache_key, envir = cache, inherits = FALSE, ifnotfound = NULL) if (!is.null(cached)) { @@ -185,11 +173,7 @@ quickr_fortran_compiler_option <- function( ) } -quickr_prefer_flang <- function( - sysname = Sys.info()[["sysname"]], - which = Sys.which, - system2 = base::system2 -) { +quickr_prefer_flang <- function() { compiler_opt <- quickr_fortran_compiler_option() if (identical(compiler_opt, "flang")) { return(TRUE) @@ -202,8 +186,8 @@ quickr_prefer_flang <- function( } # Best-effort: on macOS, prefer flang if it is available. - if (sysname == "Darwin") { - info <- quickr_cached_flang_available(which = which, system2 = system2) + if (Sys.info()[["sysname"]] == "Darwin") { + info <- quickr_cached_flang_available() return(isTRUE(info$available)) } @@ -233,8 +217,6 @@ quickr_default_fortran_makevars_lines <- function( quickr_fcompiler_env <- function( build_dir, - which = Sys.which, - system2 = base::system2, write_lines = writeLines, sysname = Sys.info()[["sysname"]], use_openmp = FALSE, @@ -250,16 +232,9 @@ quickr_fcompiler_env <- function( flang <- "" flang_runtime <- character() - use_flang <- isTRUE(quickr_prefer_flang( - sysname = sysname, - which = which, - system2 = system2 - )) + use_flang <- quickr_prefer_flang() if (use_flang) { - flang_info <- quickr_cached_flang_available( - which = which, - system2 = system2 - ) + flang_info <- quickr_cached_flang_available() flang <- flang_info$path if (!isTRUE(flang_info$available)) { if (isTRUE(explicit_request)) { diff --git a/tests/testthat/test-compiler-cache.R b/tests/testthat/test-compiler-cache.R index c57686f6..30d1a47f 100644 --- a/tests/testthat/test-compiler-cache.R +++ b/tests/testthat/test-compiler-cache.R @@ -37,13 +37,17 @@ test_that("quickr_cached_flang_available retries failed probes", { "flang version" } - local_mocked_bindings(system2 = system2_stub, .package = "base") + local_mocked_bindings( + Sys.which = which_stub, + system2 = system2_stub, + .package = "base" + ) - result <- quickr_cached_flang_available(which = which_stub, cache = cache) + result <- quickr_cached_flang_available(cache = cache) expect_identical(result$path, "/tmp/flang-new") expect_false(result$available) - result <- quickr_cached_flang_available(which = which_stub, cache = cache) + result <- quickr_cached_flang_available(cache = cache) expect_identical(result$path, "/tmp/flang-new") expect_true(result$available) expect_equal(calls, 2L) @@ -61,13 +65,17 @@ test_that("quickr_cached_flang_available revalidates successful probes", { structure("error", status = 1L) } - local_mocked_bindings(system2 = system2_stub, .package = "base") + local_mocked_bindings( + Sys.which = which_stub, + system2 = system2_stub, + .package = "base" + ) - result <- quickr_cached_flang_available(which = which_stub, cache = cache) + result <- quickr_cached_flang_available(cache = cache) expect_identical(result$path, "/tmp/flang-new") expect_true(result$available) - result <- quickr_cached_flang_available(which = which_stub, cache = cache) + result <- quickr_cached_flang_available(cache = cache) expect_identical(result$path, "/tmp/flang-new") expect_false(result$available) expect_equal(calls, 2L) diff --git a/tests/testthat/test-compiler.R b/tests/testthat/test-compiler.R index ed4de553..26e7b4b2 100644 --- a/tests/testthat/test-compiler.R +++ b/tests/testthat/test-compiler.R @@ -49,8 +49,8 @@ test_that("quickr_r_cmd_config_value returns empty on command failure", { ) }) -test_that("quickr_flang_path and quickr_prefer_flang are deterministic with stubs", { - which <- function(x) { +test_that("quickr_flang_path prefers flang-new", { + which_stub <- function(x) { if (x == "flang-new") { "/tmp/flang-new" } else if (x == "flang") { @@ -59,28 +59,28 @@ test_that("quickr_flang_path and quickr_prefer_flang are deterministic with stub "" } } - system2_stub <- function(command, args, stdout = TRUE, stderr = TRUE, ...) { - "flang version" - } - expect_identical(quickr:::quickr_flang_path(which = which), "/tmp/flang-new") + local_mocked_bindings(Sys.which = which_stub, .package = "base") - withr::local_options(quickr.fortran_compiler = "auto") + expect_identical(quickr_flang_path(), "/tmp/flang-new") +}) - expect_true(quickr:::quickr_prefer_flang( - sysname = "Darwin", - which = which, - system2 = system2_stub - )) - expect_false(quickr:::quickr_prefer_flang(sysname = "Linux", which = which)) +test_that("flang probe helpers do not expose test-only process hooks", { + expect_false("which" %in% names(formals(quickr_flang_path))) + expect_false("which" %in% names(formals(quickr_flang_available))) + expect_false("system2" %in% names(formals(quickr_flang_available))) + expect_false("which" %in% names(formals(quickr_cached_flang_available))) + expect_false("system2" %in% names(formals(quickr_cached_flang_available))) + expect_false("which" %in% names(formals(quickr:::quickr_fcompiler_env))) + expect_false("system2" %in% names(formals(quickr:::quickr_fcompiler_env))) }) test_that("quickr_prefer_flang respects quickr.fortran_compiler", { withr::local_options(quickr.fortran_compiler = "flang") - expect_true(quickr:::quickr_prefer_flang(sysname = "Linux")) + expect_true(quickr_prefer_flang()) withr::local_options(quickr.fortran_compiler = "gfortran") - expect_false(quickr:::quickr_prefer_flang(sysname = "Darwin")) + expect_false(quickr_prefer_flang()) }) test_that("quickr_default_fortran_makevars_lines relaxes gfortran cost model", { @@ -131,11 +131,6 @@ test_that("quickr_fortran_compiler_option validates values", { }) test_that("quickr_fcompiler_env writes Makevars when flang is usable", { - rm( - list = ls(envir = quickr_compiler_probe_cache, all.names = TRUE), - envir = quickr_compiler_probe_cache - ) - temp <- withr::local_tempdir() prefix <- file.path(temp, "flang") dir.create(file.path(prefix, "bin"), recursive = TRUE) @@ -145,8 +140,6 @@ test_that("quickr_fcompiler_env writes Makevars when flang is usable", { file.create(flang) file.create(file.path(prefix, "lib", "libflang_rt.runtime.dylib")) - which <- function(x) if (x == "flang-new") flang else "" - cache_env <- environment(quickr:::quickr_flang_runtime_flags) old_cache <- cache_env$cache cache_env$cache <- NULL @@ -155,11 +148,15 @@ test_that("quickr_fcompiler_env writes Makevars when flang is usable", { build_dir <- file.path(temp, "build") dir.create(build_dir) + local_mocked_bindings( + Sys.which = function(x) if (x == "flang-new") flang else "", + system2 = function(...) "", + .package = "base" + ) + withr::local_options(quickr.fortran_compiler = "flang") env <- quickr:::quickr_fcompiler_env( build_dir = build_dir, - which = which, - system2 = function(...) "", sysname = "Darwin" ) expect_true(startsWith(env, "R_MAKEVARS_USER=")) @@ -172,8 +169,6 @@ test_that("quickr_fcompiler_env writes Makevars for default gfortran flags", { withr::local_options(quickr.fortran_compiler = "gfortran") env <- quickr:::quickr_fcompiler_env( build_dir = build_dir, - which = function(cmd) "", - system2 = function(...) "", sysname = "Linux", config_value = function(name) { if (identical(name, "FC")) "gfortran -m64" else "" @@ -191,12 +186,12 @@ test_that("quickr_fcompiler_env writes Makevars for default gfortran flags", { test_that("quickr_fcompiler_env errors when flang is explicitly requested but unavailable", { build_dir <- withr::local_tempdir() + local_mocked_bindings(Sys.which = function(cmd) "", .package = "base") + withr::local_options(quickr.fortran_compiler = "flang") expect_error( quickr:::quickr_fcompiler_env( - build_dir = build_dir, - which = function(cmd) "", - system2 = function(...) structure("", status = 1L) + build_dir = build_dir ), "configured to use flang", fixed = TRUE @@ -207,10 +202,12 @@ test_that("quickr_flang_available returns unavailable when system2 fails", { which_stub <- function(x) if (x == "flang-new") "/tmp/flang-new" else "" system2_fail <- function(...) structure("error", status = 1L) - result <- quickr:::quickr_flang_available( - which = which_stub, - system2 = system2_fail + local_mocked_bindings( + Sys.which = which_stub, + system2 = system2_fail, + .package = "base" ) + result <- quickr:::quickr_flang_available() expect_identical(result$path, "/tmp/flang-new") expect_false(result$available) }) @@ -322,7 +319,7 @@ test_that("quickr_prefer_flang returns FALSE when flang_auto_disabled", { .package = "quickr" ) - expect_false(quickr:::quickr_prefer_flang(sysname = "Darwin")) + expect_false(quickr_prefer_flang()) }) test_that("quickr_fcompiler_env handles flang unavailable for non-explicit request", { @@ -333,7 +330,7 @@ test_that("quickr_fcompiler_env handles flang unavailable for non-explicit reque # Mock flang as preferred but unavailable local_mocked_bindings( quickr_prefer_flang = function(...) TRUE, - quickr_flang_available = function(...) { + quickr_cached_flang_available = function(...) { list(path = "/tmp/flang", available = FALSE) }, .package = "quickr" @@ -342,8 +339,6 @@ test_that("quickr_fcompiler_env handles flang unavailable for non-explicit reque # Should return character() since not explicit and flang unavailable result <- quickr:::quickr_fcompiler_env( build_dir = build_dir, - which = function(x) "", - system2 = function(...) "", sysname = "Darwin", config_value = function(name) if (identical(name, "FC")) "clang" else "" ) @@ -366,12 +361,15 @@ test_that("quickr_fcompiler_env errors when flang runtime not found on Darwin ex dir.create(build_dir) withr::local_options(quickr.fortran_compiler = "flang") + local_mocked_bindings( + Sys.which = function(x) if (x == "flang-new") flang else "", + system2 = function(...) "", + .package = "base" + ) expect_error( quickr:::quickr_fcompiler_env( build_dir = build_dir, - which = function(x) if (x == "flang-new") flang else "", - system2 = function(...) "", sysname = "Darwin" ), "could not locate the flang runtime library" @@ -395,11 +393,16 @@ test_that("quickr_fcompiler_env falls back when flang runtime not found non-expl dir.create(build_dir) withr::local_options(quickr.fortran_compiler = "auto") + local_mocked_bindings( + quickr_prefer_flang = function(...) TRUE, + quickr_cached_flang_available = function(...) { + list(path = flang, available = TRUE) + }, + .package = "quickr" + ) result <- quickr:::quickr_fcompiler_env( build_dir = build_dir, - which = function(x) if (x == "flang-new") flang else "", - system2 = function(...) "", sysname = "Darwin", config_value = function(name) if (identical(name, "FC")) "clang" else "" ) diff --git a/tests/testthat/test-flang-preference.R b/tests/testthat/test-flang-preference.R index aff0b70c..8b5d3815 100644 --- a/tests/testthat/test-flang-preference.R +++ b/tests/testthat/test-flang-preference.R @@ -1,12 +1,17 @@ skip_on_cran() test_that("quickr_fcompiler_env prefers flang-new when requested", { - which <- function(cmd) { + which_stub <- function(cmd) { if (identical(cmd, "flang-new")) { return("/opt/bin/flang-new") } "" } + local_mocked_bindings( + Sys.which = which_stub, + system2 = function(...) "", + .package = "base" + ) withr::local_options(quickr.fortran_compiler = "flang") @@ -14,8 +19,6 @@ test_that("quickr_fcompiler_env prefers flang-new when requested", { dir.create(build_dir) env <- quickr:::quickr_fcompiler_env( build_dir, - system2 = function(...) "", - which = which, sysname = "Linux" ) @@ -29,12 +32,17 @@ test_that("quickr_fcompiler_env prefers flang-new when requested", { }) test_that("quickr_fcompiler_env falls back to flang when flang-new missing", { - which <- function(cmd) { + which_stub <- function(cmd) { if (identical(cmd, "flang")) { return("/opt/bin/flang") } "" } + local_mocked_bindings( + Sys.which = which_stub, + system2 = function(...) "", + .package = "base" + ) withr::local_options(quickr.fortran_compiler = "flang") @@ -42,8 +50,6 @@ test_that("quickr_fcompiler_env falls back to flang when flang-new missing", { dir.create(build_dir) env <- quickr:::quickr_fcompiler_env( build_dir, - system2 = function(...) "", - which = which, sysname = "Linux" ) @@ -57,15 +63,17 @@ test_that("quickr_fcompiler_env falls back to flang when flang-new missing", { }) test_that("quickr_fcompiler_env returns empty when disabled or unavailable", { - which <- function(cmd) "" build_dir <- tempfile("quickr-build-") dir.create(build_dir) + local_mocked_bindings( + quickr_prefer_flang = function(...) FALSE, + .package = "quickr" + ) withr::local_options(quickr.fortran_compiler = "gfortran") expect_equal( quickr:::quickr_fcompiler_env( build_dir, - which = which, config_value = function(name) if (identical(name, "FC")) "clang" else "" ), character() @@ -75,40 +83,14 @@ test_that("quickr_fcompiler_env returns empty when disabled or unavailable", { expect_equal( quickr:::quickr_fcompiler_env( build_dir, - which = which, config_value = function(name) if (identical(name, "FC")) "clang" else "" ), character() ) }) -test_that("quickr_prefer_flang defaults to TRUE on macOS when flang exists", { - which <- function(cmd) { - if (identical(cmd, "flang-new")) { - return("/opt/bin/flang-new") - } - "" - } - - withr::local_options(quickr.fortran_compiler = "auto") - - expect_true(quickr:::quickr_prefer_flang( - sysname = "Darwin", - which = which, - system2 = function(...) "" - )) - expect_false(quickr:::quickr_prefer_flang(sysname = "Linux", which = which)) -}) - test_that("quickr.fortran_compiler = \"gfortran\" disables auto preference", { - which <- function(cmd) { - if (identical(cmd, "flang-new")) { - return("/opt/bin/flang-new") - } - "" - } - withr::local_options(quickr.fortran_compiler = "gfortran") - expect_false(quickr:::quickr_prefer_flang(sysname = "Darwin", which = which)) + expect_false(quickr_prefer_flang()) })