Skip to content

Commit

Permalink
minitest v0.0.1
Browse files Browse the repository at this point in the history
  • Loading branch information
@shikokuchuo
shikokuchuo committed Sep 30, 2024
1 parent 98c3008 commit c4974c3
Showing 1 changed file with 29 additions and 30 deletions.
59 changes: 29 additions & 30 deletions tests/tests.R
View file
Original file line number Diff line number Diff line change
@@ -1,16 +1,15 @@
# minitest - a minimal testing framework ---------------------------------------
# minitest - a minimal testing framework v0.0.1 --------------------------------
test_library <- function(package) library(package = package, character.only = TRUE)
test_true <- function(x) invisible(isTRUE(x) || {print(x); stop("the above was returned instead of TRUE")})
test_truew <- function(x) invisible(suppressWarnings(isTRUE(x)) || {print(x); stop("the above was returned instead of TRUE")})
test_null <- function(x) invisible(is.null(x) || {print(x); stop("the above was returned instead of NULL")})
test_notnull <- function(x) invisible(!is.null(x) || stop("is NULL when expected to be not NULL"))
test_notnull <- function(x) invisible(!is.null(x) || stop("returns NULL when expected to be not NULL"))
test_zero <- function(x) invisible(x == 0L || {print(x); stop("the above was returned instead of 0L")})
test_type <- function(type, x) invisible(typeof(x) == type || {stop("object of type '", typeof(x), "' was returned instead of '", type, "'")})
test_class <- function(class, x) invisible(inherits(x, class) || {stop("object of class '", paste(class(x), collapse = ", "), "' was returned instead of '", class, "'")})
test_equal <- function(a, b) invisible(a == b || {print(a); print(b); stop("the above expressions were not equal")})
test_identical <- function(a, b) invisible(identical(a, b) || {print(a); print(b); stop("the above expressions were not identical")})
test_print <- function(x) invisible(is.character(capture.output(print(x))) || stop("print output of expression cannot be captured as a character value"))
test_error <- function(x, containing = "") inherits(x <- tryCatch(x, error = identity), "error") && grepl(containing, x[["message"]], fixed = TRUE) || stop("expected error message containing '", containing, "' was not generated")
test_error <- function(x, containing = "") invisible(inherits(x <- tryCatch(x, error = identity), "error") && grepl(containing, x[["message"]], fixed = TRUE) || stop("expected error message containing '", containing, "' was not generated"))
# ------------------------------------------------------------------------------

test_library("nanonext")
Expand Down Expand Up @@ -39,7 +38,7 @@ test_class("nano", n$opt("socket-name", "nano"))
test_equal(n$opt("socket-name"), "nano")
test_error(n$opt("socket-name", NULL), "argument")
test_print(n$listener[[1]])
test_true(inherits(n$listener[[1]], "nanoListener"))
test_class("nanoListener", n$listener[[1]])
test_equal(n$listener[[1]]$url, "inproc://nanonext")
test_equal(n$listener[[1]]$state, "not started")
test_class("nano", n$listener_opt("recv-size-max", 1024)[[1L]])
Expand All @@ -53,7 +52,7 @@ test_error(n$listener_opt("false", list()), "type")
test_zero(n$listener_start())
test_equal(n$listener[[1]]$state, "started")
test_print(n1$dialer[[1]])
test_true(inherits(n1$dialer[[1]], "nanoDialer"))
test_class("nanoDialer", n1$dialer[[1]])
test_equal(n1$dialer[[1]]$url, "inproc://nanonext")
test_equal(n1$dialer[[1]]$state, "not started")
test_class("nano", n1$dialer_opt("reconnect-time-min", 1000)[[1L]])
Expand Down Expand Up @@ -135,40 +134,40 @@ test_class("recvAio", rraio <- n1$recv_aio(mode = "int", timeout = 500))
test_type("raw", call_aio(rraio)$data)
test_class("sendAio", sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500))
test_class("recvAio", rraio <- n1$recv_aio(mode = "logical", timeout = 500))
test_truew(is.raw(collect_aio(rraio)))
test_type("raw", collect_aio(rraio))
test_class("sendAio", sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500))
test_class("recvAio", rraio <- n1$recv_aio(mode = "numeric", timeout = 500))
test_type("raw", rraio[])
test_class("sendAio", sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500))
test_class("recvAio", rraio <- n1$recv_aio(mode = "complex", timeout = 500))
test_type("raw", collect_aio_(rraio))
test_type("raw", suppressWarnings(collect_aio_(rraio)))
test_error(opt(rraio[["aio"]], "false") <- 0L, "valid")
test_error(subscribe(rraio[["aio"]], "false"), "valid")
test_error(opt(rraio[["aio"]], "false"), "valid")
test_error(stat(rraio[["aio"]], "pipes"), "valid")

test_zero(n$dial(url = "inproc://two", autostart = FALSE))
test_zero(n$dialer_start())
test_true(inherits(n$dialer[[1L]], "nanoDialer"))
test_class("nanoDialer", n$dialer[[1L]])
test_type("double", stat(n$dialer[[1L]], "id"))
test_zero(n$listen(url = "inproc://three", autostart = FALSE))
test_zero(n$listener_start())
test_true(inherits(n$listener[[2L]], "nanoListener"))
test_class("nanoListener", n$listener[[2L]])
test_type("double", stat(n$listener[[2L]], "id"))
test_zero(n$dial(url = "inproc://four"))
test_zero(close(n$listener[[1]]))
test_truew(close(n$listener[[1]]) == 12L)
test_equal(suppressWarnings(close(n$listener[[1]])), 12L)
test_zero(close(n1$dialer[[1]]))
test_truew(close(n1$dialer[[1]]) == 12L)
test_equal(suppressWarnings(close(n1$dialer[[1]])), 12L)
test_zero(reap(n$listener[[2]]))
test_zero(reap(n$dialer[[2]]))
test_zero(n$close())
test_zero(n1$close())
test_truew(n1$close() == 7L)
test_equal(suppressWarnings(n1$close()), 7L)
test_equal(n$socket[["state"]], "closed")
test_equal(n1$socket[state], "closed")

test_true(inherits(cv <- cv(), "conditionVariable"))
test_class("conditionVariable", cv <- cv())
test_print(cv)
test_type("externalptr", cv2 <- cv())
test_true(!until(cv, 10L))
Expand All @@ -189,8 +188,8 @@ test_class("nano", req$opt("req:resend-time", 1000))
test_equal(req$opt("req:resend-time"), 1000L)
test_error(req$opt("none"), "supported")
test_type("externalptr", req$context_open())
test_true(inherits(req$context, "nanoContext"))
test_true(inherits(req$context, "nano"))
test_class("nanoContext", req$context)
test_class("nano", req$context)
test_type("integer", req$context$id)
test_equal(req$context$state, "opened")
test_equal(req$context$protocol, "req")
Expand Down Expand Up @@ -311,7 +310,7 @@ rep$dialer <- NULL
test_type("externalptr", rep$dialer[[1L]])
test_zero(close(ctx))
if (is_nano(p)) test_equal(reap(p), 12L)
if (is_nano(p)) test_truew(close(p) == 12L)
if (is_nano(p)) test_equal(suppressWarnings(close(p)), 12L)

test_class("nanoObject", pub <- nano("pub", listen = "inproc://ps"))
test_class("nanoObject", sub <- nano("sub", dial = "inproc://ps", autostart = NA))
Expand Down Expand Up @@ -365,18 +364,18 @@ test_true(!wait(cv))
test_true(!wait(cv2))
test_class("errorValue", resp$recv())

test_true(inherits(bus <- socket(protocol = "bus"), "nanoSocket"))
test_true(inherits(push <- socket(protocol = "push"), "nanoSocket"))
test_true(inherits(pull <- socket(protocol = "pull"), "nanoSocket"))
test_true(inherits(pair <- socket(protocol = "pair"), "nanoSocket"))
test_true(inherits(poly <- socket(protocol = "poly"), "nanoSocket"))
test_class("nanoSocket", bus <- socket(protocol = "bus"))
test_class("nanoSocket", push <- socket(protocol = "push"))
test_class("nanoSocket", pull <- socket(protocol = "pull"))
test_class("nanoSocket", pair <- socket(protocol = "pair"))
test_class("nanoSocket", poly <- socket(protocol = "poly"))
test_class("nano", bus)
test_truew(listen(bus, url = "test") == 3L)
test_truew(dial(bus, url = "test") == 3L)
test_equal(suppressWarnings(listen(bus, url = "test")), 3L)
test_equal(suppressWarnings(dial(bus, url = "test")), 3L)
test_error(listen(bus, url = "tls+tcp://localhost/:0", tls = "wrong"), "valid TLS")
test_error(dial(bus, url = "tls+tcp://localhost/:0", tls = "wrong"), "valid TLS")
test_zero(close(bus))
test_truew(close(bus) == 7L)
test_equal(suppressWarnings(close(bus)), 7L)
test_zero(close(push))
test_zero(close(pull))
test_zero(reap(pair))
Expand Down Expand Up @@ -412,13 +411,13 @@ sess <- ncurl_session("https://postman-echo.com/post", method = "POST", headers
test_true(is_ncurl_session(sess) || is_error_value(sess))
if (is_ncurl_session(sess)) test_equal(length(transact(sess)), 3L)
if (is_ncurl_session(sess)) test_zero(close(sess))
if (is_ncurl_session(sess)) test_truew(close(sess) == 7L)
if (is_ncurl_session(sess)) test_equal(suppressWarnings(close(sess)), 7L)
sess <- ncurl_session("https://postman-echo.com/post", convert = FALSE, method = "POST", headers = c(`Content-Type` = "text/plain"), timeout = 3000)
test_true(is_ncurl_session(sess) || is_error_value(sess))
if (is_ncurl_session(sess)) test_equal(length(transact(sess)), 3L)
if (is_ncurl_session(sess)) test_zero(close(sess))
if (is_ncurl_session(sess)) test_equal(transact(sess)$data, 7L)
test_truew(is_error_value(ncurl_session("https://i")))
test_class("errorValue", suppressWarnings(ncurl_session("https://i")))
test_error(ncurl_aio("https://", tls = "wrong"), "valid TLS")
test_error(ncurl("https://www.example.com/", tls = "wrong"), "valid TLS")
test_type("externalptr", etls <- tls_config())
Expand Down Expand Up @@ -603,7 +602,7 @@ test_equal(length(cert), 2L)
test_type("character", cert[[1L]])
test_identical(names(cert), c("server", "client"))
test_type("externalptr", tls <- tls_config(client = cert$client))
test_true(inherits(tls, "tlsConfig"))
test_class("tlsConfig", tls)
test_print(tls)
test_class("errorValue", ncurl("https://www.example.com/", tls = tls)$status)
test_class("errorValue", call_aio(ncurl_aio("https://www.example.com/", tls = tls))$data)
Expand All @@ -613,8 +612,8 @@ test_true(is_ncurl_session(sess) || is_error_value(sess))
if (is_ncurl_session(sess)) test_class("errorValue", transact(sess)[["headers"]])
test_type("externalptr", s <- socket(listen = "tls+tcp://127.0.0.1:5556", tls = tls_config(server = cert$server)))
test_type("externalptr", s1 <- socket(dial = "tls+tcp://127.0.0.1:5556", tls = tls))
test_truew(dial(s, url = "tls+tcp://.", tls = tls, error = FALSE) > 0)
test_truew(listen(s, url = "tls+tcp://.", tls = tls, error = FALSE) > 0)
test_true(suppressWarnings(dial(s, url = "tls+tcp://.", tls = tls, error = FALSE)) > 0)
test_true(suppressWarnings(listen(s, url = "tls+tcp://.", tls = tls, error = FALSE)) > 0)
test_zero(close(s1))
test_zero(close(s))
if (promises) test_class("nano", s <- socket(listen = "inproc://nanonext"))
Expand Down

0 comments on commit c4974c3

Please sign in to comment.