tests/testthat/test-knit_functions.R

In rqti: Create Tests According to QTI 2.1 Standard

# test-knit_functions
library(testthat)
library(callr)
library(chromote)

test_that("servr responds", {
    testthat::skip_on_cran()
    testthat::skip_on_ci()

    # we need to test it in temp directory, otherwise we cannot copy files
    # which is necessary for rendering
    src <- fs::path_package("QTIJS", package = "rqti")
    dst <- file.path(tempdir(), "QTIJS")
    dir.create(dst, showWarnings = FALSE)
    qtijs_path <- dst
    # Copy *contents* of src into dst
    file.copy(
        list.files(src, full.names = TRUE),
        dst,
        recursive = TRUE
    )

    # start server in background process, otherwise it will block? see servr
    # config doc parameter daemon
    p <- callr::r_bg(function(qtijs_path,
                              running_check = nzchar(Sys.getenv("_R_CHECK_PACKAGE_NAME_"))) {
        Sys.setenv(R_SERVR_PORT = 4321)
        # for dev version
        if (!running_check) {
            pkgload::load_all()
            # hard code to use later, otherwise random port could be chosen
            # and we cannot access it.
            # must turn off daemon in this case?
            start_server(qtijs_path, daemon = F)
        } else { # for non-dev version

            rqti::start_server(qtijs_path, daemon = F)
        }
    }, supervise = TRUE, args = list(qtijs_path = qtijs_path))

    # ensure cleanup even if later on.exit() calls are added
    on.exit(p$kill(), add = TRUE)

    # Sys.sleep(3)  # give server time to start
    url <- "http://127.0.0.1:4321/index.html"

    Sys.setenv(RQTI_URL="http://127.0.0.1:4321")
    render_qtijs(fs::path_package("exercises", "sc1d.Rmd",
                                  package = "rqti"),
                 qtijs_path = qtijs_path)

    # now we can simply use chromote
    b <- ChromoteSession$new()
    on.exit(b$close(), add = TRUE)

    b$go_to(url)

    # wait until the title is exactly "sc1d" or 10s are over
    js <- "
    (function() {
    var el = document.querySelector('title');
    return el ? el.textContent : null;
    })();
    "

    found_text <- NULL
    deadline <- Sys.time() + 10
    repeat {
        res <- b$Runtime$evaluate(js)
        found_text <- res$result$value
        if (identical(found_text, "sc1d")) break
        if (Sys.time() > deadline) break
        Sys.sleep(0.25)
    }

    expect_equal(found_text, "sc1d")
    p$kill()
})