library(nanonext) nanotest <- function(x) invisible(isTRUE(x) || {print(x); stop("the above was returned instead of TRUE")}) nanotestw <- function(x) invisible(suppressWarnings(isTRUE(x)) || {print(x); stop("the above was returned instead of TRUE")}) nanotestz <- function(x) invisible(x == 0L || {print(x); stop("the above was returned instead of 0L")}) nanotesti <- function(a, b) invisible(identical(a, b) || {print(a); print(b); stop("the above arguments were not identical")}) nanotestaio <- function(x) invisible(is_aio(x) || {print(x); stop("the above was returned instead of an Aio object")}) nanotestnano <- function(x) invisible(is_nano(x) || {print(x); stop("the above was returned instead of an object of class 'nano'")}) nanotestn <- function(x) invisible(is.null(x) || {print(x); stop("the above was returned instead of NULL")}) nanotestnn <- function(x) invisible(!is.null(x) || stop("is NULL when expected to be not NULL")) nanotestp <- function(x) invisible(is.character(capture.output(print(x))) || stop("print output of expression could not be captured as a character value")) nanotestxp <- function(x) invisible(typeof(x) == "externalptr" || {print(x); stop("the above was returned instead of an external pointer")}) nanotesterr <- function(x, e = "") { x <- tryCatch(x, error = identity) inherits(x, "error") && grepl(e, x[["message"]], fixed = TRUE) || stop("expected error message containing '", e, "' was not generated") invisible(TRUE) } later <- requireNamespace("later", quietly = TRUE) promises <- requireNamespace("promises", quietly = TRUE) nng_version() nanotestnano(n <- nano("req", listen = "inproc://nanonext", autostart = FALSE)) nanotestnano(n1 <- nano("rep", dial = "inproc://nanonext", autostart = FALSE)) nanotest(inherits(n, "nanoObject")) nanotest(inherits(n$socket, "nanoSocket")) nanotest(inherits(n$socket, "nano")) nanotestnano(n) n$newmethod <- "doesnotwork" nanotestn(n$newmethod) nanotest(is.integer(attr(n$socket, "id"))) nanotest(n$socket$state == "opened") nanotest(n$socket$protocol == "req") nanotest(n$send("not ready", mode = "serial") == 8L) nanotest(n$recv() == 11L) nanotestnano(n$opt("recv-size-max", 8192)) nanotest(n$opt("recv-size-max") == 8192L) nanotestnano(n$opt("recv-buffer", 8L)) nanotestnano(n$opt("req:resend-time", 0L)) nanotestnano(n$opt("socket-name", "nano")) nanotest(n$opt("socket-name") == "nano") nanotesterr(n$opt("socket-name", NULL), "argument") nanotestp(n$listener[[1]]) nanotest(inherits(n$listener[[1]], "nanoListener")) nanotest(n$listener[[1]]$url == "inproc://nanonext") nanotest(n$listener[[1]]$state == "not started") nanotestnano(n$listener_opt("recv-size-max", 1024)[[1L]]) nanotest(n$listener_opt("recv-size-max")[[1L]] == 1024L) nanotesterr(n$listener_opt("false", 100), "supported") nanotesterr(n$listener_opt("false"), "supported") nanotesterr(n$listener_opt("false", "false"), "supported") nanotesterr(n$listener_opt("false", NULL), "supported") nanotesterr(n$listener_opt("false", TRUE), "supported") nanotesterr(n$listener_opt("false", list()), "type") nanotestz(n$listener_start()) nanotest(n$listener[[1]]$state == "started") nanotestp(n1$dialer[[1]]) nanotest(inherits(n1$dialer[[1]], "nanoDialer")) nanotest(n1$dialer[[1]]$url == "inproc://nanonext") nanotest(n1$dialer[[1]]$state == "not started") nanotestnano(n1$dialer_opt("reconnect-time-min", 1000)[[1L]]) nanotest(n1$dialer_opt("reconnect-time-min")[[1L]] == 1000L) nanotestnano(n1$dialer_opt("recv-size-max", 8192)[[1L]]) nanotest(n1$dialer_opt("recv-size-max")[[1L]] == 8192L) nanotesterr(n1$dialer_opt("false", 100), "supported") nanotesterr(n1$dialer_opt("false"), "supported") nanotesterr(n1$dialer_opt("false", "false"), "supported") nanotesterr(n1$dialer_opt("false", NULL), "supported") nanotesterr(n1$dialer_opt("false", TRUE), "supported") nanotesterr(n1$dialer_opt("false", list()), "type") nanotestz(n1$dialer_start()) nanotest(n1$dialer[[1]]$state == "started") nanotesterr(n$send(list(), mode = "raw"), "atomic vector type") nanotesterr(n$recv(mode = "none"), "mode") nanotesterr(n$recv(mode = "c"), "mode") nanotestaio(raio <- n1$recv_aio(timeout = 1L)) nanotestp(raio) nanotest(is_error_value(call_aio(raio)$data)) nanotest(is_error_value(raio$data)) nanotestz(n$send(data.frame(), block = FALSE)) nanotest(is.data.frame(n1$recv(block = 500))) nanotestz(n1$send(c("test", "", "spec"), mode = "raw", block = 500)) nanotesti(n$recv("character", block = 500), c("test", "", "spec")) nanotestz(n$send(1:5, mode = "r")) nanotest(length(n1$recv("int", block = 500)) == 5L) nanotestaio(saio <- n1$send_aio(paste(replicate(5, random(1e3L)), collapse = ""), mode = 1L, timeout = 900)) nanotestp(saio) nanotestaio(call_aio(saio)) nanotestz(saio$result) nanotesterr(n$send("wrong mode", mode = "none"), "mode") nanotestaio(raio <- n$recv_aio(timeout = 500)) nanotestp(raio) nanotest(nchar(call_aio(raio)[["value"]]) == 10000L) raio$newfield <- "doesnotwork" raio[["newfield"]] <- "doesnotwork" nanotestn(raio$newfield) nanotestaio(saio <- n$send_aio(c(1.1, 2.2), mode = "raw", timeout = 500)) saio$newfield <- "doesnotwork" saio[["newfield"]] <- "doesnotwork" nanotestn(saio$newfield) nanotest(is.logical(unresolved(saio))) nanotest(is.logical(.unresolved(saio))) nanotestaio(msg <- n1$recv_aio(mode = "numer", timeout = 500)) nanotesti(call_aio(msg), msg) nanotestaio(msg <- n1$recv_aio(mode = "complex", timeout = 500)) nanotestn(stop_aio(msg)) nanotestn(stop_aio(n)) nanotesti(call_aio(msg), msg) nanotest(is_error_value(msg$data)) nanotesti(call_aio(n), n) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "r", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = 1L, timeout = 500)) nanotest(is_nul_byte(call_aio_(rraio)$data)) nanotestaio(sraio <- n$send_aio(as.raw(1L), mode = "ra", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "raw", timeout = 500)) nanotest(is.raw(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(c(1+2i, 4+3i), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "co", timeout = 500)) nanotest(is.complex(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(5, mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "d", timeout = 500)) nanotest(is.double(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(c(1, 2), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "n", timeout = 500)) nanotest(is.numeric(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(c(1L, 2L, 3L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "i", timeout = 500)) nanotest(is.integer(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "double", timeout = 500)) nanotest(is.raw(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "int", timeout = 500)) nanotest(is.raw(call_aio(rraio)$data)) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "logical", timeout = 500)) nanotestw(is.raw(collect_aio(rraio))) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "numeric", timeout = 500)) nanotest(is.raw(rraio[])) nanotestaio(sraio <- n$send_aio(as.raw(0L), mode = "raw", timeout = 500)) nanotestaio(rraio <- n1$recv_aio(mode = "complex", timeout = 500)) nanotest(is.raw(collect_aio_(rraio))) nanotesterr(opt(rraio[["aio"]], "false") <- 0L, "valid") nanotesterr(subscribe(rraio[["aio"]], "false"), "valid") nanotesterr(opt(rraio[["aio"]], "false"), "valid") nanotesterr(stat(rraio[["aio"]], "pipes"), "valid") nanotestz(n$dial(url = "inproc://two", autostart = FALSE)) nanotestz(n$dialer_start()) nanotest(inherits(n$dialer[[1L]], "nanoDialer")) nanotest(is.double(stat(n$dialer[[1L]], "id"))) nanotestz(n$listen(url = "inproc://three", autostart = FALSE)) nanotestz(n$listener_start()) nanotest(inherits(n$listener[[2L]], "nanoListener")) nanotest(is.double(stat(n$listener[[2L]], "id"))) nanotestz(n$dial(url = "inproc://four")) nanotestz(close(n$listener[[1]])) nanotestw(close(n$listener[[1]]) == 12L) nanotestz(close(n1$dialer[[1]])) nanotestw(close(n1$dialer[[1]]) == 12L) nanotestz(reap(n$listener[[2]])) nanotestz(reap(n$dialer[[2]])) nanotestz(n$close()) nanotestz(n1$close()) nanotestw(n1$close() == 7L) nanotest(n$socket[["state"]] == "closed") nanotest(n1$socket[state] == "closed") nanotest(inherits(cv <- cv(), "conditionVariable")) nanotestp(cv) nanotestxp(cv2 <- cv()) nanotest(!until(cv, 10L)) nanotest(!until(cv, 10)) nanotest(!until_(cv, 10L)) nanotest(!until_(cv, 10)) nanotest(!until_(cv, "test")) nanotestz(cv_reset(cv)) nanotestz(cv_value(cv)) nanotestnano(req <- nano("req", listen = "inproc://testing")) nanotestnano(rep <- socket("rep", dial = "inproc://testing", listen = "inproc://testing2")) nanotestp(rep) nanotest(stat(rep, "dialers") == 1) nanotest(stat(rep, "protocol") == "rep") nanotestn(stat(rep, "nonexistentstat")) nanotestnano(req$opt("req:resend-time", 1000)) nanotest(req$opt("req:resend-time") == 1000L) nanotesterr(req$opt("none"), "supported") nanotestxp(req$context_open()) nanotest(inherits(req$context, "nanoContext")) nanotest(inherits(req$context, "nano")) nanotest(is.integer(req$context$id)) nanotest(req$context$state == "opened") nanotest(req$context$protocol == "req") nanotestnano(req$opt("send-timeout", 1000)) nanotest(req$opt("send-timeout") == 1000L) nanotesterr(req$opt("false", 100), "supported") nanotesterr(req$opt("false"), "supported") nanotesterr(req$opt("false", "false"), "supported") nanotesterr(req$opt("false", NULL), "supported") nanotesterr(req$opt("false", TRUE), "supported") nanotesterr(req$opt("false", list()), "type") nanotestaio(r <- recv_aio(rep, timeout = 500)) nanotestz(req$send("", block = 500)) nanotestp(p <- tryCatch(collect_pipe(r), error = function(e) NULL)) nanotest(is_nano(p) || is.null(p)) nanotest(.mark()) nanotestaio(r <- send_aio(if (is.null(p)) rep else p, "", timeout = 500)) nanotesterr(collect_pipe(r), "valid") nanotest(req$recv(mode = 8L, block = 500)[4L] == 1L) nanotest(!.mark(FALSE)) nanotestnano(ctx <- context(rep)) nanotestp(ctx) nanotestaio(csaio <- req$send_aio(data.frame(), mode = "seria", timeout = 500)) nanotestz(call_aio_(csaio)$result) nanotestaio(craio <- recv_aio(ctx, timeout = 500)) nanotest(is.list(collect_aio(craio))) nanotestz(req$send("context test", mode ="raw", block = 500)) nanotest(recv(ctx, mode = "string", block = 500) == "context test") nanotestnn(req$send(data.frame(), mode = "seri", block = 500)) nanotestaio(msg <- recv_aio(ctx, mode = "ser", timeout = 500)) nanotest(is.logical(.unresolved(msg))) nanotest(is.logical(unresolved(msg))) nanotest(is.data.frame(call_aio(msg)$data)) nanotest(!unresolved(msg)) nanotestz(req$send(c(TRUE, FALSE, TRUE), mode = 2L, block = 500)) nanotestaio(msg <- recv_aio(ctx, mode = 6L, timeout = 500)) nanotest(is.logical(msg[])) nanotesti(collect_aio(msg), collect_aio_(msg)) nanotestaio(err <- send_aio(ctx, msg[["data"]], mode = "serial")) nanotestn(stop_aio(err)) nanotestaio(err <- send_aio(ctx, "test")) nanotest(is_error_value(call_aio(err)$result)) nanotest(is_error_value(call_aio(list(err))[[1L]][["result"]])) nanotest(is_error_value(call_aio_(err)$result)) nanotest(is_error_value(call_aio_(list(item = err))[["item"]][["result"]])) nanotest(is_error_value(collect_aio(err))) nanotest(is_error_value(collect_aio(list(item = err))[["item"]])) nanotest(is_error_value(collect_aio_(list(err))[[1L]])) nanotestz(req$send(serialize(NULL, NULL, ascii = TRUE), mode = 2L, block = 500)) nanotestn(call_aio(recv_aio(ctx, mode = 1L, timeout = 500))[["value"]]) nanotestaio(saio <- send_aio(ctx, as.raw(1L), mode = 2L, timeout = 500)) nanotesti(req$recv(mode = 8L, block = 500), as.raw(1L)) nanotestaio(rek <- request(req$context, c(1+3i, 4+2i), send_mode = 2L, recv_mode = "complex", timeout = 500)) nanotestz(reply(ctx, execute = identity, recv_mode = 3L, send_mode = "ra", timeout = 500)) nanotest(is.complex(call_aio(rek)[["data"]])) nanotestaio(rek <- request(req$context, c(1+3i, 4+2i), send_mode = "serial", recv_mode = "serial", timeout = 500)) nanotestz(reply(ctx, execute = identity, recv_mode = 1L, send_mode = 1L, timeout = 500)) nanotest(is.complex(call_aio(rek)[["data"]])) nanotest(is.list(cfg <- serial_config(class = "custom", sfunc = function(x) raw(1L), ufunc = as.integer, vec = FALSE))) nanotest(length(cfg) == 4L) nanotest(is.function(cfg[[2L]])) opt(req$socket, "serial") <- cfg opt(rep, "serial") <- cfg custom <- list(`class<-`(new.env(), "custom"), new.env()) nanotestz(send(req$socket, custom, mode = "serial", block = 500)) nanotest(is.integer(recv(rep, block = 500)[[1L]])) cfg <- serial_config("custom", function(x) as.raw(length(x)), function(x) lapply(seq_len(as.integer(x)), new.env), vec = TRUE) opt(req$socket, "serial") <- cfg opt(rep, "serial") <- cfg nanotestz(send(rep, custom, block = 500)) nanotest(is.list(recv(req$socket, mode = 1L, block = 500))) opt(req$socket, "serial") <- list() opt(rep, "serial") <- list() nanotesterr(serial_config("custom", "func1", "func2"), "must be functions") nanotesterr(opt(rep, "wrong") <- cfg, "not supported") nanotesterr(opt(rep, "serial") <- pairlist(a = 1L), "not supported") nanotesterr(opt(rep, "serial") <- list("wrong"), "Invalid argument") nanotestaio(cs <- request(req$context, "test", send_mode = "serial", cv = cv, timeout = 500)) if (later) nanotestaio(set_promise_context(cs, environment())) nanotestnn(cs$data) nanotest(typeof(ctxn <- .context(rep)) == "externalptr") nanotestaio(cr <- recv_aio(ctxn, cv = cv, timeout = 500)) nanotest(call_aio(cr)$data == "test") nanotest(is.integer(send(ctxn, TRUE, mode = 0L, block = FALSE))) nanotest(typeof(ctxn <- .context(rep)) == "externalptr") nanotestaio(cs <- request(.context(req$socket), data = TRUE, cv = NA)) nanotestnn(cs$data) nanotest(recv(ctxn, block = 500)) nanotestz(send(ctxn, TRUE, mode = 1L, block = 500)) nanotestz(reap(ctxn)) nanotest(reap(ctxn) == 7L) nanotestz(pipe_notify(rep, cv, add = TRUE, flag = TRUE)) nanotestz(pipe_notify(rep, cv, remove = TRUE, flag = tools::SIGCONT)) nanotestz(pipe_notify(req$socket, cv = cv, add = TRUE)) nanotestz(pipe_notify(req$socket, cv = cv, cv2 = cv2, remove = TRUE, flag = tools::SIGCONT)) nanotesterr(request(err, "test", cv = cv), "valid") nanotesterr(recv_aio(err, cv = cv, timeout = 500)) nanotesterr(wait(err), "valid") nanotesterr(wait_(err), "valid") nanotesterr(until(err, 10), "valid") nanotesterr(until_(err, 10), "valid") nanotesterr(cv_value(err), "valid") nanotesterr(cv_reset(err), "valid") nanotesterr(cv_signal(err), "valid") nanotesterr(collect_pipe(err), "valid") nanotesterr(pipe_notify(err, cv), "valid Socket") nanotesterr(pipe_notify(rep, err), "valid Condition Variable") nanotesterr(pipe_notify(rep, cv, err), "valid Condition Variable") nanotestz(req$context_close()) nanotestn(req$context_close) nanotestz(req$close()) nanotestn(req$context) rep$dialer <- NULL nanotestxp(rep$dialer[[1L]]) nanotestz(close(ctx)) nanotestw(close(ctx) == 7L) nanotestz(close(rep)) nanotest(if (is.null(p)) TRUE else reap(p) == 12L) nanotestw(if (is.null(p)) TRUE else close(p) == 12L) nanotestnano(pub <- nano("pub", listen = "inproc://ps")) nanotestnano(sub <- nano("sub", dial = "inproc://ps", autostart = NA)) nanotestz(cv_reset(cv)) nanotestz(cv_reset(cv2)) nanotestz(pipe_notify(pub$socket, cv, cv2, add = TRUE, remove = TRUE)) nanotestnano(sub$opt(name = "sub:prefnew", value = FALSE)) nanotest(!sub$opt(name = "sub:prefnew")) nanotesterr(sub$opt(name = "false", value = 100), "supported") nanotesterr(sub$opt(name = "false"), "supported") nanotesterr(sub$opt(name = "false", value = list()), "type") nanotestnano(sub$subscribe("test")) nanotestnano(subscribe(sub$socket, NULL)) nanotestnano(sub$unsubscribe("test")) nanotestxp(sub$context_open()) nanotest(inherits(sub$context, "nanoContext")) nanotestnano(sub$subscribe(12)) nanotestnano(sub$unsubscribe(12)) nanotestnano(sub$subscribe(NULL)) nanotestz(sub$context_close()) nanotestn(sub$context) nanotestz(sub$close()) nanotestz(pub$close()) nanotest(wait(cv)) nanotest(wait(cv2)) nanotestxp(cv3 <- cv()) nanotestxp(cv %~>% cv2 %~>% cv3) nanotestz(cv_signal(cv)) nanotest(cv_value(cv) == 1L) nanotest(wait_(cv3)) nanotestxp(cv %~>% cv3) nanotesterr("a" %~>% cv3, "valid Condition Variable") nanotesterr(cv3 %~>% "a", "valid Condition Variable") nanotestnano(surv <- nano(protocol = "surveyor", listen = "inproc://sock1", dial = "inproc://sock2")) nanotestp(surv) nanotestnano(resp <- nano(protocol = "respondent", listen = "inproc://sock2", dial = "inproc://sock1")) nanotestz(pipe_notify(surv$socket, cv, cv2, add = TRUE, remove = TRUE, flag = TRUE)) surv$dialer <- NULL nanotestxp(surv$dialer[[1L]]) nanotestxp(surv$listener[[1L]]) nanotestnano(surv$survey_time(5000)) nanotestxp(surv$context_open()) nanotestxp(resp$context_open()) nanotestnano(surv$survey_time(value = 2000)) nanotestz(surv$context_close()) nanotestz(resp$context_close()) nanotestz(surv$close()) nanotestz(resp$close()) nanotest(!wait(cv)) nanotest(!wait(cv2)) nanotest(is_error_value(resp$recv())) nanotest(inherits(bus <- socket(protocol = "bus"), "nanoSocket")) nanotest(inherits(push <- socket(protocol = "push"), "nanoSocket")) nanotest(inherits(pull <- socket(protocol = "pull"), "nanoSocket")) nanotest(inherits(pair <- socket(protocol = "pair"), "nanoSocket")) nanotest(inherits(poly <- socket(protocol = "poly"), "nanoSocket")) nanotestnano(bus) nanotestw(listen(bus, url = "test") == 3L) nanotestw(dial(bus, url = "test") == 3L) nanotesterr(listen(bus, url = "tls+tcp://localhost/:0", tls = "wrong"), "valid TLS") nanotesterr(dial(bus, url = "tls+tcp://localhost/:0", tls = "wrong"), "valid TLS") nanotestz(close(bus)) nanotestw(close(bus) == 7L) nanotestz(close(push)) nanotestz(close(pull)) nanotestz(reap(pair)) nanotestz(reap(poly)) nanotesterr(socket(protocol = "newprotocol"), "protocol") nanotesterr(socket(dial = "test"), "argument") nanotesterr(socket(listen = "test"), "argument") nanotestnn(ncurl("http://www.cam.ac.uk/")) nanotestnn(ncurl("http://www.cam.ac.uk/", follow = FALSE, response = "date")) nanotestnn(ncurl("http://www.cam.ac.uk/", follow = TRUE)) nanotestnn(ncurl("http://postman-echo.com/post", convert = FALSE, method = "POST", headers = c(`Content-Type` = "text/plain"), data = "test", response = c("Date", "Server"), timeout = 3000)) nanotest(is_error_value(ncurl("http")$data)) haio <- ncurl_aio("http://example.com/") nanotest(is.integer(call_aio(haio)$status)) haio <- ncurl_aio("https://example.com/", convert = FALSE, response = "server") nanotestnn(haio$status) if (call_aio(haio)$status == 200L) nanotestnn(haio$headers) put1 <- ncurl_aio("http://postman-echo.com/put", method = "PUT", headers = c(Authorization = "Bearer token"), data = "test", response = c("Date", "server"), timeout = 3000L) nanotestp(put1) nanotest(is.integer(call_aio_(put1)$status)) if (put1$status == 200L) nanotestnn(put1$headers) if (put1$status == 200L) nanotestnn(put1$data) nanotestn(stop_aio(put1)) haio <- ncurl_aio("https://i.i") nanotest(is_error_value(call_aio(haio)$data)) nanotestp(haio$data) ncaio <- ncurl_aio("https://shikokuchuo.net/nanonext/reference/figures/logo.png") if (call_aio(ncaio)$status == 200L) nanotest(is.raw(ncaio$data)) nanotest(is_error_value(ncurl_aio("http")$data)) sess <- ncurl_session("https://postman-echo.com/post", method = "POST", headers = c(`Content-Type` = "text/plain"), data = "test", response = c("date", "Server"), timeout = 3000L) nanotest(is_ncurl_session(sess) || is_error_value(sess)) if (is_ncurl_session(sess)) nanotest(length(transact(sess)) == 3L) if (is_ncurl_session(sess)) nanotest(close(sess) == 0L) if (is_ncurl_session(sess)) nanotestw(close(sess) == 7L) sess <- ncurl_session("https://postman-echo.com/post", convert = FALSE, method = "POST", headers = c(`Content-Type` = "text/plain"), timeout = 3000) nanotest(is_ncurl_session(sess) || is_error_value(sess)) if (is_ncurl_session(sess)) nanotest(length(transact(sess)) == 3L) if (is_ncurl_session(sess)) nanotest(close(sess) == 0L) if (is_ncurl_session(sess)) nanotest(transact(sess)$data == 7L) nanotestw(is_error_value(ncurl_session("https://i"))) nanotesterr(ncurl_aio("https://", tls = "wrong"), "valid TLS") nanotesterr(ncurl("https://www.cam.ac.uk/", tls = "wrong"), "valid TLS") nanotestxp(etls <- tls_config()) nanotesterr(stream(dial = "wss://127.0.0.1:5555", textframes = TRUE, tls = etls)) nanotesterr(stream(dial = "wss://127.0.0.1:5555")) nanotesterr(stream(dial = "errorValue3"), "argument") nanotesterr(stream(dial = "inproc://notsup"), "Not supported") nanotesterr(stream(dial = "wss://127.0.0.1:5555", tls = "wrong"), "valid TLS") nanotesterr(stream(listen = "errorValue3"), "argument") nanotesterr(stream(listen = "inproc://notsup"), "Not supported") nanotesterr(stream(listen = "errorValue3", tls = "wrong"), "valid TLS") nanotesterr(stream(), "specify") nanotest(is.character(ver <- nng_version())) nanotest(length(ver) == 2L) nanotest(nng_error(8L) == "8 | Try again") nanotest(is_nul_byte(as.raw(0L))) nanotest(!is_nul_byte(NULL)) nanotest(!is_error_value(1L)) nanotesterr(messenger("invalidURL"), "argument") nanotest(is.raw(md5 <- nanonext:::md5_object("secret base"))) nanotest(length(md5) == 32L) nanotest(is.double(mclock())) nanotestn(msleep(1L)) nanotestn(msleep(1)) nanotestn(msleep("a")) nanotest(is.character(urlp <- parse_url("://"))) nanotest(length(urlp) == 10L) nanotest(all(nzchar(parse_url("wss://use:r@[::1]/path?q=1#name")))) nanotest(is.character(random())) nanotest(nchar(random(2)) == 4L) nanotest(length(random(4L, convert = FALSE)) == 4L) nanotesterr(random(1025), "between 0 and 1024") nanotesterr(random(-1), "between 0 and 1024") nanotesterr(random("test"), "integer") nanotesterr(parse_url("tcp:/"), "argument") for (i in c(100:103, 200:208, 226, 300:308, 400:426, 428:431, 451, 500:511)) nanotest(is.character(status_code(i))) s <- tryCatch(stream(dial = "wss://echo.websocket.events/", textframes = TRUE), error = function(e) NULL) is_nano(s) && { nanotestnn(recv(s, block = 500L)) nanotest(is.character(opt(s, "ws:response-headers"))) nanotesterr(opt(s, "ws:request-headers") <- "test\n", 24) nanotest(is.integer(send(s, c("message1", "test"), block = 500L))) nanotestnn(recv(s, block = FALSE)) nanotest(is.integer(send(s, "message2", block = FALSE))) nanotestnn(recv(s, mode = 9L, block = 100)) nanotest(is.integer(send(s, 2L, block = 500))) nanotestaio(sr <- recv_aio(s, mode = "i", timeout = 500L, n = 8192L)) nanotestnn(call_aio(sr)[["data"]]) nanotestn(stop_aio(sr)) nanotestaio(ss <- send_aio(s, "async", timeout = 500L)) nanotest(is.integer(ss[])) nanotestn(stop_aio(ss)) nanotest(is.integer(send(s, 12.56, mode = "raw", block = 500L))) nanotestaio(sr <- recv_aio(s, mode = "double", timeout = 500L, cv = cv)) nanotestnn(call_aio_(sr)[["data"]]) nanotest(cv_value(cv) > 0L) nanotest(is.character(opt(s, "ws:request-headers"))) nanotestnn(opt(s, "tcp-nodelay") <- FALSE) nanotesterr(recv(s, mode = "none", block = FALSE), "mode") nanotesterr(recv(s, mode = "c", block = FALSE), "mode") nanotesterr(opt(s, "none"), "supported") nanotesterr(`opt<-`(s, "none", list()), "supported") nanotestp(s) nanotest(is.integer(close(s))) } nanotestnano(s <- socket("bus", listen = "inproc://nanolock")) nanotestnano(s1 <- socket("bus", dial = "inproc://nanolock")) nanotestz(lock(s)) nanotestnano(s2 <- socket("bus", dial = "inproc://nanolock")) nanotestaio(send_aio(s, "test")) nanotestnn(recv(s1, block = 500)) nanotest(is_error_value(recv(s2))) nanotestz(unlock(s)) nanotestz(pipe_notify(s, cv = cv, add = TRUE, remove = TRUE)) nanotestz(lock(s, cv = cv)) nanotestnano(s3 <- socket("bus", dial = "inproc://nanolock")) nanotestz(send(s, "test", block = 500)) nanotestnn(recv(s3, block = 500)) nanotesterr(unlock(cv), "valid Socket") nanotesterr(lock(cv), "valid Socket") nanotesterr(lock(s, cv = s), "valid Condition Variable") nanotestz(pipe_notify(s, cv = NULL, add = TRUE, remove = TRUE)) nanotestz(close(s)) nanotestz(close(s1)) nanotestz(close(s2)) nanotestz(close(s3)) nanotest(nanonext:::.DollarNames.ncurlAio(NULL, "sta") == "status") nanotest(nanonext:::.DollarNames.recvAio(NULL, "dat") == "data") nanotest(nanonext:::.DollarNames.sendAio(NULL, "r") == "result") nanotest(length(nanonext:::.DollarNames.nano(NULL)) == 0L) fakesock <- `class<-`(new.env(), "nanoSocket") nanotesterr(dial(fakesock), "valid Socket") nanotesterr(dial(fakesock, autostart = FALSE), "valid Socket") nanotesterr(listen(fakesock), "valid Socket") nanotesterr(listen(fakesock, autostart = FALSE), "valid Socket") nanotesterr(context(fakesock), "valid Socket") nanotesterr(.context(fakesock), "valid Socket") nanotesterr(stat(fakesock, "pipes"), "valid Socket") nanotesterr(close(fakesock), "valid Socket") nanotest(!.unresolved(fakesock)) fakectx <- `class<-`("test", "nanoContext") nanotest(!unresolved(fakectx)) nanotest(!.unresolved(fakectx)) nanotesterr(request(fakectx, data = "test"), "valid Context") nanotesterr(subscribe(fakectx, NULL), "valid") nanotesterr(close(fakectx), "valid Context") nanotest(reap(fakectx) == 3L) fakestream <- `class<-`("test", "nanoStream") nanotestp(fakestream) fakesession <- `class<-`("test", "ncurlSession") nanotestp(fakesession) nanotesterr(transact(fakesession), "valid") nanotesterr(close(fakesession), "valid") nanotesterr(send(fakestream, "test"), "valid") nanotesterr(send_aio(fakestream, "test"), "valid") nanotesterr(recv(fakestream), "valid") nanotesterr(recv_aio(fakestream), "valid") nanotesterr(collect_pipe(fakestream), "valid") nanotesterr(opt(fakestream, name = "test") <- "test", "valid") nanotesterr(opt(fakestream, name = "test"), "valid") nanotesterr(close(fakestream), "active Stream") fakedial <- `class<-`("test", "nanoDialer") nanotesterr(start(fakedial), "valid Dialer") nanotesterr(close(fakedial), "valid Dialer") fakelist <- `class<-`("test", "nanoListener") nanotesterr(start(fakelist), "valid Listener") nanotesterr(close(fakelist), "valid Listener") fakepipe <- `class<-`("test", "nanoPipe") nanotesterr(close(fakepipe), "valid Pipe") unres <- `class<-`(NA, "unresolvedValue") nanotest(!unresolved(unres)) nanotestp(unres) nanotest(is.logical(unres <- unresolved(list("a", "b")))) nanotest(length(unres) == 1L) nanotest(is.integer(unres <- .unresolved(list("a", "b")))) nanotest(length(unres) == 1L) nanotesti(call_aio("a"), "a") nanotesti(call_aio_("a"), "a") nanotesterr(collect_aio_("a"), "object is not an Aio or list of Aios") nanotesterr(collect_aio_(list("a")), "object is not an Aio or list of Aios") nanotesterr(collect_aio(list(fakesock)), "object is not an Aio or list of Aios") nanotestn(stop_aio("a")) nanotestn(stop_aio(list("a"))) if (later) nanotest(is.environment(set_promise_context(new.env(), new.env()))) pem <- "-----BEGIN CERTIFICATE----- -----END CERTIFICATE-----" test_tls <- function(pem) { file <- tempfile() on.exit(unlink(file)) cat(pem, file = file) nanotesterr(tls_config(client = file), "Cryptographic error") nanotesterr(tls_config(server = file), "Cryptographic error") } nanotest(test_tls(pem = pem)) nanotesterr(tls_config(client = c(pem, pem)), "Cryptographic error") nanotesterr(tls_config(server = c(pem, pem)), "Cryptographic error") nanotest(is.list(cert <- write_cert(cn = "127.0.0.1"))) nanotest(length(cert) == 2L) nanotest(is.character(cert[[1L]])) nanotesti(names(cert), c("server", "client")) nanotestxp(tls <- tls_config(client = cert$client)) nanotest(inherits(tls, "tlsConfig")) nanotestp(tls) nanotest(is_error_value(ncurl("https://www.cam.ac.uk/", tls = tls)$status)) nanotest(is_error_value(call_aio(ncurl_aio("https://www.cam.ac.uk/", tls = tls))$data)) nanotesterr(ncurl_session("https://www.cam.ac.uk/", tls = cert$client), "not a valid TLS") sess <- ncurl_session("https://www.cam.ac.uk/", tls = tls) nanotest(is_ncurl_session(sess) || is_error_value(sess)) if (is_ncurl_session(sess)) nanotest(is_error_value(transact(sess)[["headers"]])) nanotestxp(s <- socket(listen = "tls+tcp://127.0.0.1:5556", tls = tls_config(server = cert$server))) nanotestxp(s1 <- socket(dial = "tls+tcp://127.0.0.1:5556", tls = tls)) nanotestw(dial(s, url = "tls+tcp://.", tls = tls, error = FALSE) > 0) nanotestw(listen(s, url = "tls+tcp://.", tls = tls, error = FALSE) > 0) nanotestz(close(s1)) nanotestz(close(s)) nanotest(!identical(get0(".Random.seed"), {.advance(); .Random.seed})) if (promises) nanotestaio(n <- ncurl_aio("https://postman-echo.com/get")) if (promises) nanotest(tryCatch(promises::is.promise(promises::then(n, cat)), error = function(e) TRUE)) if (promises) nanotest(promises::is.promising(call_aio(n))) if (promises) nanotest(promises::is.promise(promises::as.promise(call_aio(ncurl_aio("https://postman-echo.com/get"))))) if (promises) later::run_now() if (Sys.info()[["sysname"]] == "Linux") { rm(list = ls()) gc() Sys.sleep(1L) .Call(nanonext:::rnng_fini) invisible() }