bring back vectorized form of dot unresolved

Author: shikokuchuo

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nanonext
 Type: Package
 Title: NNG (Nanomsg Next Gen) Lightweight Messaging Library
-Version: 1.0.0.9021
+Version: 1.0.0.9022
 Description: R binding for NNG (Nanomsg Next Gen), a successor to ZeroMQ. NNG is
     a socket library implementing 'Scalability Protocols', a reliable,
     high-performance standard for common communications patterns including

NAMESPACE

@@ -38,6 +38,7 @@ S3method(start,nanoListener)
 export("%~>%")
 export("opt<-")
 export(.context)
+export(.unresolved)
 export(base64dec)
 export(base64enc)
 export(call_aio)

NEWS.md

@@ -1,4 +1,4 @@
-# nanonext 1.0.0.9021 (development)
+# nanonext 1.0.0.9022 (development)
 
 #### New Features
 

R/aio.R

@@ -331,3 +331,26 @@ stop_aio <- function(aio) invisible(.Call(rnng_aio_stop, aio))
 #' @export
 #'
 unresolved <- function(aio) .Call(rnng_unresolved, aio)
+
+#' Technical Utility: Query if an Aio is Unresolved
+#'
+#' Query whether an Aio or list of Aios remains unresolved. This is an
+#'     experimental technical utility version of \code{\link{unresolved}} not
+#'     intended for ordinary use. Provides a method of querying the busy status
+#'     of an Aio without altering its state in any way i.e. not attempting to
+#'     retrieve the result or message.
+#'
+#' @inheritParams collect_aio
+#'
+#' @return Logical TRUE if \sQuote{aio} is an unresolved Aio or else FALSE, or
+#'     if \sQuote{aio} is a list, the integer number of unresolved Aios in the
+#'     list.
+#'
+#' @details \code{.unresolved()} is not intended to be used for \sQuote{recvAio}
+#'     returned by a signalling function, in which case \code{\link{unresolved}}
+#'     must be used in all cases.
+#'
+#' @keywords internal
+#' @export
+#'
+.unresolved <- function(x) .Call(rnng_unresolved2, x)

man/dot-unresolved.Rd

@@ -651,6 +651,38 @@ SEXP rnng_unresolved(SEXP x) {
 
 }
 
+static int rnng_unresolved2_impl(SEXP x) {
+
+  if (TYPEOF(x) == ENVSXP) {
+    const SEXP coreaio = Rf_findVarInFrame(x, nano_AioSymbol);
+    if (R_ExternalPtrTag(coreaio) != nano_AioSymbol)
+      return 0;
+    nano_aio *aiop = (nano_aio *) R_ExternalPtrAddr(coreaio);
+    return nng_aio_busy(aiop->aio);
+  }
+
+  return 0;
+
+}
+
+SEXP rnng_unresolved2(SEXP x) {
+
+  switch (TYPEOF(x)) {
+  case ENVSXP:
+    return Rf_ScalarLogical(rnng_unresolved2_impl(x));
+  case VECSXP: ;
+    int xc = 0;
+    const R_xlen_t xlen = Rf_xlength(x);
+    for (R_xlen_t i = 0; i < xlen; i++) {
+      xc += rnng_unresolved2_impl(VECTOR_ELT(x, i));
+    }
+    return Rf_ScalarInteger(xc);
+  }
+
+  return Rf_ScalarLogical(0);
+
+}
+
 // send recv aio functions -----------------------------------------------------
 
 SEXP rnng_send_aio(SEXP con, SEXP data, SEXP mode, SEXP timeout, SEXP clo) {

src/aio.c

@@ -203,6 +203,7 @@ static const R_CallMethodDef callMethods[] = {
   {"rnng_subscribe", (DL_FUNC) &rnng_subscribe, 3},
   {"rnng_tls_config", (DL_FUNC) &rnng_tls_config, 4},
   {"rnng_unresolved", (DL_FUNC) &rnng_unresolved, 1},
+  {"rnng_unresolved2", (DL_FUNC) &rnng_unresolved2, 1},
   {"rnng_url_parse", (DL_FUNC) &rnng_url_parse, 1},
   {"rnng_version", (DL_FUNC) &rnng_version, 0},
   {"rnng_wait_thread_create", (DL_FUNC) &rnng_wait_thread_create, 1},

src/init.c

@@ -269,6 +269,7 @@ SEXP rnng_strerror(SEXP);
 SEXP rnng_subscribe(SEXP, SEXP, SEXP);
 SEXP rnng_tls_config(SEXP, SEXP, SEXP, SEXP);
 SEXP rnng_unresolved(SEXP);
+SEXP rnng_unresolved2(SEXP);
 SEXP rnng_url_parse(SEXP);
 SEXP rnng_version(void);
 SEXP rnng_wait_thread_create(SEXP);

src/nanonext.h

@@ -93,6 +93,7 @@ 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))
@@ -204,6 +205,7 @@ nanotest(is.integer(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))
@@ -489,8 +491,10 @@ 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")
@@ -518,6 +522,7 @@ unres <- `class<-`(NA, "unresolvedValue")
 nanotest(!unresolved(unres))
 nanotestp(unres)
 nanotest(is.logical(unres <- unresolved(list("a", "b"))) && length(unres) == 1L)
+nanotest(is.integer(unres <- .unresolved(list("a", "b"))) && 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")