1 2test_that("broken dll", { 3 if (.Platform$OS.type != "windows") { expect_true(TRUE); return() } 4 skip_on_cran() 5 6 ## To check this, we need a package with a dll. 7 ## We need to install it into some temporary library, and then mess 8 ## up the MD5 sum. We can use testhat itself to do this, as long as it 9 ## has compiled code. We also run package_info() in another process, 10 ## to avoid changing the current one. 11 12 dir.create(lib <- tempfile()) 13 on.exit(unlink(lib, recursive = TRUE), add = TRUE) 14 file.copy(system.file(package = "testthat"), lib, recursive = TRUE) 15 16 md5file <- file.path(lib, "testthat", "MD5") 17 if (!file.exists(md5file)) skip("Cannot test broken DLLs") 18 l <- readLines(md5file) 19 dllline <- grep("testthat.dll", l)[1] 20 substr(l[dllline], 2, 5) <- "xxxx" 21 writeLines(l, md5file) 22 23 pi <- callr::r( 24 function(lib) { 25 library(testthat, lib.loc = lib) 26 sessioninfo::package_info() 27 }, 28 args = list(lib = lib), 29 libpath = c(lib, .libPaths()), 30 timeout = 10) 31 32 expect_false(pi$md5ok[pi$package == "testthat"]) 33 expect_output(print(pi), "DLL MD5 mismatch, broken installation") 34}) 35 36test_that("loaded & on-disk path mismatch", { 37 skip_on_cran() 38 39 ## Copy testthat to another library, load it from there, and then 40 ## remove that lib from the library path. 41 42 dir.create(lib <- tempfile()) 43 on.exit(unlink(lib, recursive = TRUE), add = TRUE) 44 file.copy(system.file(package = "testthat"), lib, recursive = TRUE) 45 46 pi <- callr::r( 47 function(lib) { 48 library(testthat, lib.loc = lib) 49 .libPaths(.libPaths()[-1]) 50 sessioninfo::package_info() 51 }, 52 args = list(lib = lib), 53 libpath = c(lib, .libPaths()), 54 timeout = 10 55 ) 56 57 wh <- which(pi$package == "testthat") 58 expect_false(pi$path[wh] == pi$loadedpath[wh]) 59 expect_output(print(pi), "Loaded and on-disk path mismatch") 60}) 61 62test_that("loaded & on-disk version mismatch", { 63 skip_on_cran() 64 65 ## Copy testthat to another library and change the version, after 66 ## loading it. 67 68 dir.create(lib <- tempfile()) 69 on.exit(unlink(lib, recursive = TRUE), add = TRUE) 70 file.copy(system.file(package = "testthat"), lib, recursive = TRUE) 71 72 pi <- callr::r( 73 function(lib) { 74 library(testthat, lib.loc = lib) 75 desc_file <- file.path(lib, "testthat", "DESCRIPTION") 76 desc <- readLines(desc_file) 77 desc <- sub("^Version:.*$", "Version: 0.0.1", desc) 78 writeLines(desc, desc_file) 79 80 binary_desc <- file.path(lib, "testthat", "Meta", "package.rds") 81 if (file.exists(binary_desc)) { 82 pkg_desc <- readRDS(binary_desc) 83 desc <- as.list(pkg_desc$DESCRIPTION) 84 desc$Version <- "0.0.1" 85 pkg_desc$DESCRIPTION <- stats::setNames(as.character(desc), names(desc)) 86 saveRDS(pkg_desc, binary_desc) 87 } 88 sessioninfo::package_info() 89 }, 90 args = list(lib = lib), 91 libpath = c(lib, .libPaths()), 92 timeout = 10 93 ) 94 95 wh <- which(pi$package == "testthat") 96 expect_false(pi$ondiskversion[wh] == pi$loadedversion[wh]) 97 expect_output(print(pi), "Loaded and on-disk version mismatch") 98}) 99 100test_that("deleted package", { 101 skip_on_cran() 102 103 foo <- "fsdfgwetdhsdfhq4yqh" 104 105 dir.create(lib <- tempfile()) 106 on.exit(unlink(lib, recursive = TRUE), add = TRUE) 107 pkgfile <- normalizePath(paste0("fixtures/", foo, "_0.0.0.9000.tar.gz")) 108 install.packages(pkgfile, lib = lib, repos = NULL, type = "source", 109 quiet = TRUE) 110 111 pis <- callr::r( 112 function(lib, foo) { 113 library(foo, character.only = TRUE, lib.loc = lib) 114 unlink(file.path(lib, foo), recursive = TRUE) 115 list( 116 sessioninfo::session_info(), 117 sessioninfo::session_info(pkgs = foo) 118 ) 119 }, 120 args = list(lib = lib, foo = foo), 121 libpath = c(lib, .libPaths()), 122 timeout = 10, 123 error = "stack" 124 ) 125 126 expect_true(is.list(pis)) 127 expect_equal(length(pis), 2) 128 129 for (i in seq_along(pis)) { 130 pi <- pis[[i]]$packages 131 wh <- which(pi$package == foo) 132 expect_equal(pi$ondiskversion[wh], NA_character_) 133 expect_equal(pi$path[wh], NA_character_) 134 expect_equal(pi$date[wh], NA_character_) 135 expect_equal(pi$source[wh], NA_character_) 136 } 137}) 138