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