quickr/tests/testthat/test-compiler-cache.R at b682b91f54269d433b47abb76959c80de62f39ca · t-kalinowski/quickr · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
skip_on_cran()

test_that("quickr_cached_r_cmd_config_value retries failed lookups", {
  cache <- new.env(parent = emptyenv())
  calls <- 0L
  system2_stub <- function(command, args, stdout = "", stderr = "", ...) {
    calls <<- calls + 1L
    if (calls == 1L) {
      return(structure(" value ", status = 1L))
    }
    "gfortran"
  }

  local_mocked_bindings(system2 = system2_stub, .package = "base")

  expect_identical(quickr_cached_r_cmd_config_value("FC", cache = cache), "")
  expect_identical(
    quickr_cached_r_cmd_config_value("FC", cache = cache),
    "gfortran"
  )
  expect_identical(
    quickr_cached_r_cmd_config_value("FC", cache = cache),
    "gfortran"
  )
  expect_equal(calls, 2L)
})

test_that("quickr_cached_flang_available retries failed probes", {
  cache <- new.env(parent = emptyenv())
  calls <- 0L
  which_stub <- function(x) if (x == "flang-new") "/tmp/flang-new" else ""
  system2_stub <- function(...) {
    calls <<- calls + 1L
    if (calls == 1L) {
      return(structure("error", status = 1L))
    }
    "flang version"
  }

  local_mocked_bindings(
    Sys.which = which_stub,
    system2 = system2_stub,
    .package = "base"
  )

  result <- quickr_cached_flang_available(cache = cache)
  expect_identical(result$path, "/tmp/flang-new")
  expect_false(result$available)

  result <- quickr_cached_flang_available(cache = cache)
  expect_identical(result$path, "/tmp/flang-new")
  expect_true(result$available)
  expect_equal(calls, 2L)
})

test_that("quickr_cached_flang_available revalidates successful probes", {
  cache <- new.env(parent = emptyenv())
  calls <- 0L
  which_stub <- function(x) if (x == "flang-new") "/tmp/flang-new" else ""
  system2_stub <- function(...) {
    calls <<- calls + 1L
    if (calls == 1L) {
      return("flang version")
    }
    structure("error", status = 1L)
  }

  local_mocked_bindings(
    Sys.which = which_stub,
    system2 = system2_stub,
    .package = "base"
  )

  result <- quickr_cached_flang_available(cache = cache)
  expect_identical(result$path, "/tmp/flang-new")
  expect_true(result$available)

  result <- quickr_cached_flang_available(cache = cache)
  expect_identical(result$path, "/tmp/flang-new")
  expect_false(result$available)
  expect_equal(calls, 2L)
})