tests/testthat/test-url.R

In gson: Base Class and Methods for 'gson' Format

wp <- function() {
  read.gmt.wp(system.file("extdata", "wikipathways-20220310-gmt-Homo_sapiens.gmt",
                          package = "gson"), output = "GSON")
}

test_that("gson_url fills the token of the declared urlpattern", {
  x <- wp()
  urls <- gson_url(x)

  expect_identical(names(urls), names(x))
  expect_identical(unname(urls[["WP100"]]),
                   "https://www.wikipathways.org/pathways/WP100.html")
  expect_false(any(grepl("{gsid}", urls, fixed = TRUE)))
})

test_that("gson_url builds one URL per requested gene set ID", {
  x <- wp()
  urls <- gson_url(x, c("WP100", "WP106"))

  ## sub() does not vectorise over its replacement, and the old browseGS call
  ## passed the pattern as `x`, so a vector of IDs used to collapse to one URL
  expect_identical(urls,
                   c(WP100 = "https://www.wikipathways.org/pathways/WP100.html",
                     WP106 = "https://www.wikipathways.org/pathways/WP106.html"))
  expect_identical(length(gson_url(x, "WP100")), 1L)
})

test_that("gson_url reports the gene sets it cannot turn into URLs", {
  x <- gson(data.frame(gsid = c("A", "B"), gene = c("g1", "g2")))

  expect_warning(urls <- gson_url(x), "no 'urlpattern'")
  expect_identical(urls, c(A = NA_character_, B = NA_character_))
})

test_that("gson_url warns when the pattern holds no token", {
  x <- gson(data.frame(gsid = "A", gene = "g1"),
            urlpattern = "https://example.org/pathways.html")

  expect_warning(urls <- gson_url(x, "A"), "no \\{gsid\\} token")
  expect_identical(unname(urls), "https://example.org/pathways.html")
})

test_that("browseGS asks for a pattern instead of browsing nothing", {
  x <- gson(data.frame(gsid = "A", gene = "g1"))

  ## browseURL(character(0)) opens nothing at all, which is how the old
  ## browseGS failed silently on an object without a urlpattern
  expect_error(browseGS(x, "A"), "no 'urlpattern'")
})

test_that("browseGS hands the URLs it built to browseURL", {
  seen <- NULL
  local_mocked_bindings(browseURL = function(url, ...) seen <<- url)
  x <- wp()

  expect_invisible(browseGS(x, c("WP100", "WP106")))
  expect_identical(seen, gson_url(x, c("WP100", "WP106")) |> unname())
})