test-user-api.R
In parabar: Progress Bar for Parallel Tasks

# Test user API functions.

test_that("'set_default_options' sets default options correctly", {
    # Remove any default options existing in the session.
    options(parabar = NULL)

    # Expect that the parabar options are not set.
    expect_null(getOption("parabar"))

    # Set the default options.
    set_default_options()

    # Get the parabar options
    session_options <- getOption("parabar")

    # Expect that the session options are an instance of the `Options` class.
    expect_equal(Helper$get_class_name(session_options), "Options")

    # Create an options instance.
    options <- Options$new()

    # Expect the session options to match the default options instance.
    expect_equal(session_options$progress_track, options$progress_track)
    expect_equal(session_options$progress_timeout, options$progress_timeout)
    expect_equal(session_options$progress_bar_type, options$progress_bar_type)
    expect_equal(session_options$progress_bar_config, options$progress_bar_config)

    # Expect the progress log path to differ since it is randomly generated.
    expect_false(session_options$progress_log_path == options$progress_log_path)

    # Pick a custom path for the progress log.
    log_path_custom <- "custom_path.log"

    # Fix the log paths on both the session options and the local instance.
    session_options$progress_log_path <- log_path_custom
    options$progress_log_path <- log_path_custom

    # Expect the paths for the progress log to match.
    expect_equal(session_options$progress_log_path, options$progress_log_path)

    # Restore the defaults.
    set_default_options()

    # Expect that the new session options do not match the old session options.
    expect_false(session_options$progress_log_path == getOption("parabar")$progress_log_path)
})


test_that("'get_option' retrieves option values correctly", {
    # Ensure the default options are set.
    set_default_options()

    # Create an options instance.
    options <- Options$new()

    # Expect the values retrieved to match the default field values.
    expect_equal(get_option("progress_track"), options$progress_track)
    expect_equal(get_option("progress_timeout"), options$progress_timeout)
    expect_equal(get_option("progress_bar_type"), options$progress_bar_type)
    expect_equal(get_option("progress_bar_config"), options$progress_bar_config)

    # Expect the progress log path to differ since it is randomly generated.
    expect_false(get_option("progress_log_path") == options$progress_log_path)

    # Pick an unknown `parabar` package option.
    unknown <- "unknown_parabar_option"

    # Expect retrieving an unknown option to throw an error.
    expect_error(
        get_option(unknown),
        as_text(Exception$unknown_package_option(unknown))
    )
})


test_that("'set_option' sets option values correctly", {
    # Ensure the default options are set.
    set_default_options()

    # Set known options and expect that values are correctly set.
    set_option("progress_track", FALSE)
    expect_equal(get_option("progress_track"), FALSE)

    set_option("progress_timeout", 0.002)
    expect_equal(get_option("progress_timeout"), 0.002)

    set_option("progress_bar_type", "basic")
    expect_equal(get_option("progress_bar_type"), "basic")

    set_option("progress_bar_config", list(test = "test"))
    expect_equal(get_option("progress_bar_config"), list(test = "test"))

    # Pick an unknown `parabar` package option.
    unknown <- "unknown_parabar_option"

    # Expect an error for attempting to set unknown options.
    expect_error(
        set_option(unknown, "unknown"),
        as_text(Exception$unknown_package_option(unknown))
    )

    # Restore default options.
    set_default_options()
})


test_that("`configure_bar` sets progress bar configurations correctly", {
    # Ensure the default options are set.
    set_default_options()

    # Set bar type and expect it to be correctly set.
    configure_bar(type = "modern")
    expect_equal(get_option("progress_bar_type"), "modern")

    # Set bar configuration and expect it to be correctly set.
    configure_bar(type = "modern", format = "[:bar] :percent")
    expect_equal(get_option("progress_bar_config")$modern$format, "[:bar] :percent")

    # Set bar type and expect it to be correctly set.
    configure_bar(type = "basic")
    expect_equal(get_option("progress_bar_type"), "basic")

    # Set bar configuration and expect it to be correctly set.
    configure_bar(type = "basic", style = 3)
    expect_equal(get_option("progress_bar_config")$basic$style, 3)

    # Expect an error for attempting to configure unsupported bar types.
    expect_error(
        configure_bar(type = "unsupported"),
        as_text(Exception$feature_not_developed())
    )

    # Restore default options
    set_default_options()
})


test_that("'start_backend' handles different backend and cluster types on Unix correctly", {
    # Skip test on Windows.
    skip_on_os("windows")

    # Expect that the backed is created correctly for different configurations.
    tests_set_for_backend_creation_via_user_api("psock", "sync")
    tests_set_for_backend_creation_via_user_api("fork", "sync")
    tests_set_for_backend_creation_via_user_api("psock", "async")
    tests_set_for_backend_creation_via_user_api("fork", "async")

    # Expect a warning if an incorrect cluster type is requested.
    expect_warning(
        tests_set_for_backend_creation_via_user_api("unknown", "sync"),
        as_text(Warning$requested_cluster_type_not_supported(Specification$new()$types))
    )

    # Expect an error if an incorrect backend type is requested.
    expect_error(
        start_backend(cores = 2, cluster_type = "psock", backend_type = "unknown"),
        as_text(Exception$feature_not_developed())
    )
})


test_that("'start_backend' handles different backend and cluster types on Windows correctly", {
    # Skip test on Unix and the like.
    skip_on_os(c("mac", "linux", "solaris"))

    # Expect that the backed is created correctly for different configurations.
    tests_set_for_backend_creation_via_user_api("psock", "sync")
    tests_set_for_backend_creation_via_user_api("psock", "async")

    # Expect warnings when `FORK` clusters are requested on Windows.
    expect_warning(
        tests_set_for_backend_creation_via_user_api("fork", "sync"),
        as_text(Warning$requested_cluster_type_not_compatible(Specification$new()$types))
    )

    expect_warning(
        tests_set_for_backend_creation_via_user_api("fork", "async"),
        as_text(Warning$requested_cluster_type_not_compatible(Specification$new()$types))
    )

    # Expect a warning if an incorrect cluster type is requested.
    expect_warning(
        tests_set_for_backend_creation_via_user_api("unknown", "sync"),
        as_text(Warning$requested_cluster_type_not_supported(Specification$new()$types))
    )

    # Expect an error if an incorrect backend type is requested.
    expect_error(
        start_backend(cores = 2, cluster_type = "psock", backend_type = "unknown"),
        as_text(Exception$feature_not_developed())
    )
})


test_that("user API functions handle incompatible input correctly", {
    # Create an obviously incorrect backend.
    backend <- "backend"

    # Expect an error passing this backend to the user API functions.
    expect_error(
        stop_backend(backend),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        clear(backend),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        peek(backend),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        export(backend),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        evaluate(backend),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        par_sapply(backend, NULL, NULL),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        par_lapply(backend, NULL, NULL),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )

    expect_error(
        par_apply(backend, NULL, NULL, NULL),
        as_text(Exception$type_not_assignable(class(backend), "Backend"))
    )
})


test_that("user API functions handle basic backend operations correctly", {
    # Select a cluster type.
    cluster_type <- pick_cluster_type(Specification$new()$types)

    # Select a backend type.
    backend_type <- pick_backend_type()

    # Create a backend.
    backend <- start_backend(
        cores = 2,
        cluster_type = cluster_type,
        backend_type = backend_type
    )

    # Expect the backend to be active.
    expect_true(backend$active)

    # Create a dummy variable.
    variable <- "dummy"

    # Export the variable to the backend.
    export(backend, "variable", environment())

    # Check that the variable has the correct name on the backend.
    expect_true(all(peek(backend) == "variable"))

    # Check that the variable has the correct value on the backend.
    expect_true(all(evaluate(backend, variable) == variable))

    # Clear the backend.
    clear(backend)

    # Expect the backend environment to be empty after clearing.
    expect_true(all(sapply(peek(backend), length) == 0))

    # Stop the backend.
    stop_backend(backend)

    # Expect the backend to be inactive after stopping.
    expect_false(backend$active)

    # Expect an error trying to stop an already stopped backend.
    expect_error(
        stop_backend(backend),
        as_text(Exception$cluster_not_active())
    )
})


test_that("user API functions run tasks in parallel correctly", {
    # Select task arguments.
    x <- sample(1:100, 100)
    y <- sample(1:100, 1)
    z <- sample(1:100, 1)
    sleep = sample(c(0, 0.001, 0.002), 1)

    # Compute the expected output for the `par_sapply` user API function.
    expected_output <- test_task(x, y, z)

    # Define the `par_sapply` parallel operation.
    parallel_sapply <- bquote(
        par_sapply(backend, x = .(x), fun = test_task, .(y), .(z), sleep = .(sleep))
    )

    # Define the `par_sapply` sequential operation.
    sequential_sapply <- bquote(
        par_sapply(backend = NULL, x = .(x), fun = test_task, .(y), .(z))
    )

    # Expect the `par_sapply` to run the task in parallel correctly.
    tests_set_for_user_api_task_execution(parallel_sapply, sequential_sapply, expected_output)

    # Compute the expected output for the `par_lapply` user API function.
    expected_output <- as.list(expected_output)

    # Define the `par_lapply` parallel operation.
    parallel_lapply <- bquote(
        par_lapply(backend, x = .(x), fun = test_task, .(y), .(z), sleep = .(sleep))
    )

    # Define the `par_lapply` sequential operation.
    sequential_lapply <- bquote(
        par_lapply(backend = NULL, x = .(x), fun = test_task, .(y), .(z))
    )

    # Expect the `par_lapply` to run the task in parallel correctly.
    tests_set_for_user_api_task_execution(parallel_lapply, sequential_lapply, expected_output)

    # Redefine `x` as a matrix for the `apply` operation.
    x <- matrix(rnorm(100^2), nrow = 100, ncol = 100)

    # Select a random margin for the matrix.
    margin <- sample(1:2, 1)

    # Compute the expected output for the `par_apply` user API function.
    expected_output <- base::apply(x, margin, test_task, y = y, z = z)

    # Define the `par_apply` parallel operation.
    parallel_apply <- bquote(
        par_apply(backend, x = .(x), margin = .(margin), fun = test_task, .(y), .(z), sleep = .(sleep))
    )

    # Define the `par_apply` sequential operation.
    sequential_apply <- bquote(
        par_apply(backend = NULL, x = .(x), margin = .(margin), fun = test_task, .(y), .(z))
    )

    # Expect the `par_apply` to run the task in parallel correctly.
    tests_set_for_user_api_task_execution(parallel_apply, sequential_apply, expected_output)
})


test_that("user API functions track progress correctly", {
    # Run the test only in interactive contexts.
    if (interactive()) {
        # Expect progress tracking is displayed correctly via `par_sapply`.
        tests_set_for_user_api_progress_tracking(bquote(
            par_sapply(backend, x = 1:100, fun = test_task, 1, 2)
        ))

        # Expect progress tracking is displayed correctly via `par_lapply`.
        tests_set_for_user_api_progress_tracking(bquote(
            par_lapply(backend, x = 1:100, fun = test_task, 1, 2)
        ))

        # Create a matrix for the `apply` operation.
        x <- matrix(rnorm(50^2), nrow = 50, ncol = 50)

        # Select a random margin for the matrix.
        margin <- sample(1:2, sample(1:2, 1))

        # Expect progress tracking is displayed correctly via `par_apply`.
        tests_set_for_user_api_progress_tracking(bquote(
            par_apply(backend, x = .(x), margin = .(margin), fun = test_task, 1, 2)
        ))

    } else {
        skip("Test only runs in interactive contexts.")
    }
})