tests/testthat/test-backend.R

In powerly: Sample Size Analysis for Psychological Networks and More

# Test 'Backend' class.

test_that("'Backend' aborts on machines with only one core", {
    # Create backend instance.
    backend <- BackendTester$new()

    # Suppose the machine has only one core.
    backend$mock_machine_available_cores(cores = 1)

    # The expected error message.
    error_message <- "Not enough cores available on the machine."

    # Expect to abort regardless of the requested cores.
    expect_error(backend$set_cores(cores = 1), error_message)
    expect_error(backend$set_cores(cores = 2), error_message)
    expect_error(backend$set_cores(cores = 7), error_message)
})


test_that("'Backend' sets the number of cores correctly", {
    # Create backend instance.
    backend <- BackendTester$new()

    # Suppose the machine has two cores.
    backend$mock_machine_available_cores(cores = 2)

    # Expectations based on the number of cores requested.

    # When 1 core is requested.
    expect_warning(backend$set_cores(cores = 1), "Argument `cores` must be greater than 1. Setting to 2.")
    expect_equal(backend$cores, 2)

    # When two cores are requested.
    backend$set_cores(cores = 2)
    expect_equal(backend$cores, 2)

    # When more than two cores are requested.
    expect_warning(backend$set_cores(cores = 7), "Argument `cores` cannot be larger than 2. Setting to 2.")
    expect_equal(backend$cores, 2)

    # Suppose the machine has 8 cores.
    backend$mock_machine_available_cores(cores = 8)

    # When 1 core is requested.
    expect_warning(backend$set_cores(cores = 1), "Argument `cores` must be greater than 1. Setting to 2.")
    expect_equal(backend$cores, 2)

    # When two cores are requested.
    backend$set_cores(cores = 2)
    expect_equal(backend$cores, 2)

    # When seven cores are requested.
    backend$set_cores(cores = 7)
    expect_equal(backend$cores, 7)

    # When seven cores are requested.
    expect_warning(backend$set_cores(cores = 8), "Argument `cores` cannot be larger than 7. Setting to 7.")
    expect_equal(backend$cores, 7)
})


test_that("'Backend' performs operations on the cluster correctly", {
    # Create a backend.
    backend <- Backend$new()

    # Start the cluster.
    backend$start(2)

    # Expect the cluster is empty upon creation.
    expect_true(all(sapply(backend$inspect(), length) == 0))

    # Create a variable in a new environment.
    env <- new.env()
    env$test_variable <- rnorm(1)

    # Export variable to the cluster from an environment.
    backend$export("test_variable", env)

    # Expect the cluster to contain the exported variable.
    expect_true(all(backend$inspect() == "test_variable"))

    # Expect the cluster to hold the correct value for the exported variable.
    expect_true(all(parallel::clusterEvalQ(backend$cluster, test_variable) == env$test_variable))

    # Expect that clearing the cluster leaves it empty.
    backend$clear()
    expect_true(all(sapply(backend$inspect(), length) == 0))

    # Create test data for the cluster `sapply` and `apply operations`.
    data <- matrix(rnorm(100), 10, 10)
    test_function <- function(x, add = 1) x + add

    # Expect that the parallel `sapply` is executed correctly.
    expect_equal(backend$sapply(data[, 1], test_function, add = 3), sapply(data[, 1], test_function, add = 3))

    # Expect that the parallel `apply` is executed correctly.
    expect_equal(backend$apply(data, 1, test_function, add = 10), apply(data, 1, test_function, add = 10))

    # Expect that the cluster is empty after performing operations on it.
    # Note, it will contain a `.Random.seed` placed there by `snow` which is loaded via bootnet.
    # To check that that is indeed the case, remove `bootnet` imports from `NAMESPACE`.
    # Also see:
    #   - https://stackoverflow.com/q/69866215/5252007
    #   - https://github.com/SachaEpskamp/bootnet/issues/82
    expect_equal(sum(sapply(backend$inspect(), function(x) { length(x[!x %in% ".Random.seed"]) })), 0)

    # Stop the cluster.
    backend$stop()
})


test_that("'Backend' manages the cluster correctly", {
    # Create a backend.
    backend <- Backend$new()

    # Start the cluster.
    backend$start(2)

    # Expect the correct type.
    if (.Platform$OS.type == "unix") {
       expect_equal(backend$type, c(unix = "FORK"))
    } else {
       expect_equal(backend$type, c(windows = "PSOCK"))
    }

    # Expect the correct number of cores.
    expect_equal(backend$cores, 2)
    expect_equal(length(backend$cluster), 2)

    # Expect an error if an attempt is made to start a cluster while one is already active.
    expect_error(backend$start(2), "A cluster is already active. Please stop it before starting a new one.")

    # Expect stopping the cluster works.
    backend$stop()
    expect_false(backend$active)
    expect_equal(backend$cluster, NULL)

    # Expect the cluster can be started again after being stop.
    backend$start(2)
    expect_equal(length(backend$cluster), 2)

    # Expect an error if an attempt is made to adopt a cluster while one is already active.
    expect_error(backend$adopt(backend$cluster), "Cannot adopt external cluster while there is another active cluster.")

    # Stop the current cluster.
    backend$stop()

    # Create a cluster manually.
    cluster <- parallel::makePSOCKcluster(2)

    # Expect the backend correctly adopts a cluster object.
    backend$adopt(cluster)
    expect_equal(backend$type, "adopted")
    expect_equal(length(backend$cluster), 2)
    expect_equal(backend$cores, 2)
    expect_equal(backend$.__enclos_env__$private$.available_cores, NULL)
    expect_equal(backend$.__enclos_env__$private$.allowed_cores, NULL)

    # Expect that the backend can stop the adopted cluster.
    backend$stop()
    # If the backend `stop()` worked, then attempting to close again will throw an error.
    expect_error(parallel::stopCluster(cluster))
})