1
2context("metadata cache 1/3")
3
4test_that("get_cache_files", {
5  dir.create(pri <- fs::path_norm(tempfile()))
6  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
7  dir.create(rep <- fs::path_norm(tempfile()))
8  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
9
10  cmc <- cranlike_metadata_cache$new(pri, rep, "source",  bioc = FALSE)
11
12  pri_files <- get_private(cmc)$get_cache_files("primary")
13  rep_files <- get_private(cmc)$get_cache_files("replica")
14
15  check <- function(files, root) {
16    expect_equal(files$root, root)
17    expect_true(all(c("meta", "lock", "rds") %in% names(files)))
18    expect_equal(
19      fs::path_common(c(files$rds, files$lock, files$rds, root)),
20      root)
21    expect_true(tibble::is_tibble(files$pkgs))
22    expect_equal(
23      sort(names(files$pkgs)),
24      sort(c("path", "etag", "basedir", "base", "mirror", "url",
25             "fallback_url", "platform", "r_version", "type",
26             "bioc_version", "meta_path", "meta_etag", "meta_url"
27      ))
28    )
29    expect_equal(
30      fs::path_common(c(files$pkgs$path, files$pkgs$etag, root)),
31      root)
32  }
33
34  check(pri_files, pri)
35  check(rep_files, rep)
36})
37
38test_that("get_current_data", {
39  dir.create(pri <- fs::path_norm(tempfile()))
40  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
41  dir.create(rep <- fs::path_norm(tempfile()))
42  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
43
44  cmc <- cranlike_metadata_cache$new(pri, rep, "source",  bioc = FALSE)
45
46  set_private(cmc, "data") <- "DATA"
47  set_private(cmc, "data_time") <- Sys.time()
48  expect_equal(get_private(cmc)$get_current_data(oneday()), "DATA")
49
50  set_private(cmc,  "data_time") <- Sys.time() - 2 * oneday()
51  expect_error(
52    get_private(cmc)$get_current_data(oneday()),
53    "Loaded data outdated")
54
55  set_private(cmc, "data_time") <- NULL
56  expect_error(
57    get_private(cmc)$get_current_data(oneday()),
58    "Loaded data outdated")
59
60  set_private(cmc, "data") <- NULL
61  expect_error(get_private(cmc)$get_current_data(oneday()), "No data loaded")
62})
63
64test_that("load_replica_rds", {
65  dir.create(pri <- fs::path_norm(tempfile()))
66  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
67  dir.create(rep <- fs::path_norm(tempfile()))
68  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
69
70  cmc <- cranlike_metadata_cache$new(pri, rep, "source",  bioc = FALSE)
71
72  expect_error(
73    get_private(cmc)$load_replica_rds(oneday()),
74    "No replica RDS file in cache"
75  )
76
77  rep_files <- get_private(cmc)$get_cache_files("replica")
78  mkdirp(dirname(rep_files$rds))
79  saveRDS("This is it", rep_files$rds)
80  file_set_time(rep_files$rds, Sys.time() - 2 * oneday())
81  expect_error(
82    get_private(cmc)$load_replica_rds(oneday()),
83    "Replica RDS cache file outdated"
84  )
85
86  file_set_time(rep_files$rds, Sys.time() - 1/2  * oneday())
87  expect_equal(
88    get_private(cmc)$load_replica_rds(oneday()),
89    "This is it")
90  expect_equal(get_private(cmc)$data, "This is it")
91  expect_true(Sys.time() - get_private(cmc)$data_time < oneday())
92})
93
94test_that("load_primary_rds", {
95  dir.create(pri <- fs::path_norm(tempfile()))
96  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
97  dir.create(rep <- fs::path_norm(tempfile()))
98  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
99
100  cmc <- cranlike_metadata_cache$new(pri, rep, "source",  bioc = FALSE)
101
102  expect_error(
103    get_private(cmc)$load_primary_rds(oneday()),
104    "No primary RDS file in cache"
105  )
106
107  pri_files <- get_private(cmc)$get_cache_files("primary")
108  mkdirp(dirname(pri_files$rds))
109  saveRDS("This is it", pri_files$rds)
110  file_set_time(pri_files$rds, Sys.time() - 2 * oneday())
111  expect_error(
112    get_private(cmc)$load_primary_rds(oneday()),
113    "Primary RDS cache file outdated"
114  )
115
116  file_set_time(pri_files$rds, Sys.time() - 1/2  * oneday())
117  for (f in pri_files$pkgs$path) { mkdirp(dirname(f)); cat("x", file = f) }
118  file_set_time(pri_files$pkgs$path, Sys.time() - 2  * oneday())
119  expect_equal(
120    get_private(cmc)$load_primary_rds(oneday()),
121    "This is it")
122  expect_equal(get_private(cmc)$data, "This is it")
123  expect_true(Sys.time() - get_private(cmc)$data_time < oneday())
124
125  ## Replica was also updated
126  expect_equal(
127    get_private(cmc)$load_replica_rds(oneday()),
128    "This is it")
129})
130
131test_that("locking failures", {
132  pri <- test_temp_dir()
133  rep <- test_temp_dir()
134
135  cmc <- cranlike_metadata_cache$new(pri, rep, "source", bioc = FALSE)
136
137  mockery::stub(cmc__load_primary_rds, "lock", function(...) NULL)
138  expect_error(
139    cmc__load_primary_rds(cmc, get_private(cmc), oneday()),
140    "Cannot acquire lock to copy RDS")
141
142  mockery::stub(cmc__load_primary_pkgs, "lock", function(...) NULL)
143  expect_error(
144    cmc__load_primary_pkgs(cmc, get_private(cmc), oneday()),
145    "Cannot acquire lock to copy PACKAGES")
146})
147
148test_that("load_primary_rds 3", {
149  pri <- test_temp_dir()
150  rep <- test_temp_dir()
151
152  cmc <- cranlike_metadata_cache$new(pri, rep, "source", bioc = FALSE)
153
154  pri_files <- get_private(cmc)$get_cache_files("primary")
155  touch(pri_files$rds)
156  expect_error(
157    cmc__load_primary_rds(cmc, get_private(cmc), oneday()),
158    "Primary PACKAGES missing")
159})
160
161test_that("load_primary_pkgs", {
162
163  withr::local_options(list(repos = NULL))
164
165  dir.create(pri <- fs::path_norm(tempfile()))
166  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
167  dir.create(rep <- fs::path_norm(tempfile()))
168  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
169
170  cmc <- cranlike_metadata_cache$new(pri, rep, c("macos", "source"),
171                                     bioc = FALSE)
172
173  expect_error(
174    get_private(cmc)$load_primary_pkgs(oneday()),
175    "Some primary PACKAGES files don't exist")
176
177  pri_files <- get_private(cmc)$get_cache_files("primary")
178  mkdirp(dirname(pri_files$pkgs$path))
179  fs::file_copy(get_fixture("PACKAGES-mac.gz"), pri_files$pkgs$path[1])
180  expect_error(
181    synchronise(get_private(cmc)$load_primary_pkgs(oneday())),
182    "Some primary PACKAGES files don't exist")
183
184  for (i in utils::tail(seq_len(nrow(pri_files$pkgs)), -1)) {
185    fs::file_copy(get_fixture("PACKAGES-src.gz"), pri_files$pkgs$path[i])
186  }
187  file_set_time(pri_files$pkgs$path, Sys.time() - 2 * oneday())
188  expect_error(
189    synchronise(get_private(cmc)$load_primary_pkgs(oneday())),
190    "Some primary PACKAGES files are outdated")
191
192  file_set_time(pri_files$pkgs$path, Sys.time() - 1/2 * oneday())
193  res <- synchronise(get_private(cmc)$load_primary_pkgs(oneday()))
194  check_packages_data(res)
195
196  ## RDS was updated as well
197  rep_files <- get_private(cmc)$get_cache_files("replica")
198  expect_true(file.exists(rep_files$rds))
199  expect_true(Sys.time() - file_get_time(rep_files$rds) < oneday())
200
201  ## Primary RDS was updated as well
202  expect_true(file.exists(pri_files$rds))
203  expect_true(Sys.time() - file_get_time(pri_files$rds) < oneminute())
204})
205
206test_that("update_replica_pkgs", {
207
208  skip_if_offline()
209  skip_on_cran()
210
211  dir.create(pri <- fs::path_norm(tempfile()))
212  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
213  dir.create(rep <- fs::path_norm(tempfile()))
214  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
215
216  cmc <- cranlike_metadata_cache$new(pri, rep, "source", bioc = FALSE)
217
218  synchronise(get_private(cmc)$update_replica_pkgs())
219  rep_files <- get_private(cmc)$get_cache_files("replica")
220  expect_true(all(file.exists(rep_files$pkgs$path)))
221  expect_true(all(file.exists(rep_files$pkgs$etag)))
222
223  data <- get_private(cmc)$update_replica_rds()
224  expect_identical(data, get_private(cmc)$data)
225  check_packages_data(data)
226})
227
228test_that("update_replica_rds", {
229  dir.create(pri <- fs::path_norm(tempfile()))
230  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
231  dir.create(rep <- fs::path_norm(tempfile()))
232  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
233
234  cmc <- cranlike_metadata_cache$new(pri, rep, c("macos", "source"),
235                                     bioc = FALSE)
236
237  rep_files <- get_private(cmc)$get_cache_files("replica")
238  mkdirp(dirname(rep_files$pkgs$path))
239  fs::file_copy(get_fixture("PACKAGES-mac.gz"), rep_files$pkgs$path[1])
240  for (i in utils::tail(seq_len(nrow(rep_files$pkgs)), -1)) {
241    fs::file_copy(get_fixture("PACKAGES-src.gz"), rep_files$pkgs$path[i])
242  }
243
244  data <- get_private(cmc)$update_replica_rds()
245  expect_identical(get_private(cmc)$data, data)
246  expect_true(get_private(cmc)$data_time > Sys.time() - oneminute())
247  check_packages_data(data)
248})
249
250test_that("update_primary", {
251  dir.create(pri <- fs::path_norm(tempfile()))
252  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
253  dir.create(rep <- fs::path_norm(tempfile()))
254  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
255
256  cmc <- cranlike_metadata_cache$new(pri, rep, c("macos", "source"),
257                                     bioc = FALSE)
258
259  pri_files <- get_private(cmc)$get_cache_files("primary")
260  rep_files <- get_private(cmc)$get_cache_files("replica")
261
262  mkdirp(dirname(rep_files$rds))
263  saveRDS("RDS", rep_files$rds)
264  get_private(cmc)$update_primary(rds = TRUE, packages = FALSE)
265  expect_true(file.exists(pri_files$rds))
266  expect_equal(readRDS(pri_files$rds), "RDS")
267
268  lapply_rows(rep_files$pkgs, function(pkg) {
269    mkdirp(dirname(pkg$path))
270    cat(basename(pkg$path), "\n", sep = "", file = pkg$path)
271    mkdirp(dirname(pkg$etag))
272    cat(pkg$url, "\n", sep = "", file = pkg$etag)
273  })
274  get_private(cmc)$update_primary(rds = FALSE, packages = TRUE)
275  expect_true(all(file.exists(pri_files$pkgs$path)))
276  expect_true(all(file.exists(pri_files$pkgs$etag)))
277
278  lapply_rows(pri_files$pkgs, function(pkg) {
279    expect_equal(readLines(pkg$path), basename(pkg$path))
280    expect_equal(readLines(pkg$etag), pkg$url)
281  })
282})
283
284test_that("update_primary 2", {
285
286  expect_null(cmc__update_primary(NULL, NULL, FALSE, FALSE, FALSE))
287
288  pri <- test_temp_dir()
289  rep <- test_temp_dir()
290
291  cmc <- cranlike_metadata_cache$new(pri, rep, c("macos", "source"),
292                                     bioc = FALSE)
293
294  mockery::stub(cmc__update_primary, "lock", function(...) NULL)
295  expect_error(
296    cmc__update_primary(cmc, get_private(cmc), TRUE, TRUE, TRUE),
297    "Cannot acquire lock to update primary cache")
298})
299
300test_that("update", {
301
302  skip_if_offline()
303  skip_on_cran()
304
305  dir.create(pri <- fs::path_norm(tempfile()))
306  on.exit(unlink(pri, recursive = TRUE), add = TRUE)
307  dir.create(rep <- fs::path_norm(tempfile()))
308  on.exit(unlink(rep, recursive = TRUE), add = TRUE)
309
310  cmc <- cranlike_metadata_cache$new(pri, rep, "source", bioc = FALSE)
311  data <- cmc$update()
312  check_packages_data(data)
313
314  ## Data is loaded
315  expect_identical(get_private(cmc)$data, data)
316  expect_true(Sys.time() - get_private(cmc)$data_time < oneminute())
317
318  ## There is a replica RDS
319  rep_files <- get_private(cmc)$get_cache_files("replica")
320  expect_true(file.exists(rep_files$rds))
321  expect_true(Sys.time() - file_get_time(rep_files$rds) < oneminute())
322
323  ## There is a primary RDS
324  pri_files <- get_private(cmc)$get_cache_files("primary")
325  expect_true(file.exists(pri_files$rds))
326  expect_true(Sys.time() - file_get_time(pri_files$rds) < oneminute())
327
328  ## There are replicate PACKAGES, with Etag files
329  expect_true(all(file.exists(rep_files$pkgs$path)))
330  expect_true(all(file.exists(rep_files$pkgs$etag)))
331
332  ## There are primary PACKAGES, with Etag files
333  expect_true(all(file.exists(pri_files$pkgs$path)))
334  expect_true(all(file.exists(pri_files$pkgs$etag)))
335
336  ## List
337  expect_equal(as.list(data$pkgs), as.list(cmc$list()))
338  lst <- cmc$list(c("igraph", "MASS"))
339  expect_equal(sort(c("igraph", "MASS")), sort(unique(lst$package)))
340
341  ## Revdeps
342  rdeps <- cmc$revdeps("MASS")
343  expect_true("abc" %in% rdeps$package)
344  expect_true("abd" %in% rdeps$package)
345
346  rdeps <- cmc$revdeps("MASS", recursive = FALSE)
347  expect_true("abc" %in% rdeps$package)
348  expect_false("abd" %in% rdeps$package)
349})
350