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