[R-gregmisc-commits] r2169 - in pkg/gtools: . R man src tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 14 21:43:00 CEST 2017
Author: warnes
Date: 2017-06-14 21:42:59 +0200 (Wed, 14 Jun 2017)
New Revision: 2169
Added:
pkg/gtools/src/gtools.h
pkg/gtools/src/gtools_load.c
Modified:
pkg/gtools/DESCRIPTION
pkg/gtools/NAMESPACE
pkg/gtools/R/checkRVersion.R
pkg/gtools/R/newVersionAvailable.R
pkg/gtools/R/roman2int.R
pkg/gtools/R/setTCPNoDelay.R
pkg/gtools/man/combinations.Rd
pkg/gtools/man/defmacro.Rd
pkg/gtools/src/setTCPNoDelay.c
pkg/gtools/tests/test_setTCPNoDelay.R
Log:
Explicitly register C routines used by gtools
Modified: pkg/gtools/DESCRIPTION
===================================================================
--- pkg/gtools/DESCRIPTION 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/DESCRIPTION 2017-06-14 19:42:59 UTC (rev 2169)
@@ -23,7 +23,7 @@
- generate significance stars from p-values ('stars.pval'),
- convert characters to/from ASCII codes.
Version: 3.7.0
-Date: 2017-06-11
+Date: 2017-06-14
Author: Gregory R. Warnes, Ben Bolker, and Thomas Lumley
Maintainer: Gregory R. Warnes <greg at warnes.net>
License: GPL-2
Modified: pkg/gtools/NAMESPACE
===================================================================
--- pkg/gtools/NAMESPACE 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/NAMESPACE 2017-06-14 19:42:59 UTC (rev 2169)
@@ -51,3 +51,9 @@
importFrom("utils", "available.packages", "flush.console", "head",
"help.search", "installed.packages", "modifyList",
"packageVersion")
+
+# Refer to all C routines by their name prefixed by C_
+useDynLib(gtools, .registration = TRUE, .fixes = "C_")
+
+
+
Modified: pkg/gtools/R/checkRVersion.R
===================================================================
--- pkg/gtools/R/checkRVersion.R 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/R/checkRVersion.R 2017-06-14 19:42:59 UTC (rev 2169)
@@ -1,12 +1,12 @@
checkRVersion <- function(quiet=FALSE)
{
- page2 <- scan(file="http://cran.r-project.org/src/base/R-2",
+ page2 <- scan(file="https://cran.r-project.org/src/base/R-2",
what="", quiet=TRUE)
- page3 <- scan(file="http://cran.r-project.org/src/base/R-3",
+ page3 <- scan(file="https://cran.r-project.org/src/base/R-3",
what="", quiet=TRUE)
combined <- c(page2, page3)
-
+
matches <- grep("R-[0-9]\\.[0-9]+\\.[0-9]+", combined, value=TRUE)
versionList <- gsub("^.*R-([0-9].[0-9]+.[0-9]+).*$","\\1",matches)
versionList <- numeric_version(versionList)
@@ -30,5 +30,5 @@
}
invisible( NULL );
}
-
+
}
Modified: pkg/gtools/R/newVersionAvailable.R
===================================================================
--- pkg/gtools/R/newVersionAvailable.R 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/R/newVersionAvailable.R 2017-06-14 19:42:59 UTC (rev 2169)
@@ -1,6 +1,6 @@
newVersionAvailable <- function(quiet=FALSE)
{
- page <- scan(file="http://cran.r-project.org/src/base/R-2", what="", quiet=TRUE)
+ page <- scan(file="https://cran.r-project.org/src/base/R-2", what="", quiet=TRUE)
matches <- grep("R-[0-9]\\.[0-9]+\\.[0-9]+", page, value=TRUE)
versionList <- gsub("^.*R-([0-9].[0-9]+.[0-9]+).*$","\\1",matches)
versionList <- numeric_version(versionList)
@@ -24,5 +24,5 @@
}
invisible( NULL );
}
-
+
}
Modified: pkg/gtools/R/roman2int.R
===================================================================
--- pkg/gtools/R/roman2int.R 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/R/roman2int.R 2017-06-14 19:42:59 UTC (rev 2169)
@@ -8,7 +8,7 @@
romandigit.convert <- function(roman)
{
- retval <- .C('convert',
+ retval <- .C(C_convert,
roman=as.character(roman),
nchar=as.integer(nchar(roman)),
values=integer(nchar(roman))
@@ -18,7 +18,7 @@
roman2int.inner <- function(roman)
{
- results <- .C("roman2int",
+ results <- .C(C_roman2int,
roman = as.character(roman),
nchar = as.integer(nchar(roman)),
value = integer(1),
Modified: pkg/gtools/R/setTCPNoDelay.R
===================================================================
--- pkg/gtools/R/setTCPNoDelay.R 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/R/setTCPNoDelay.R 2017-06-14 19:42:59 UTC (rev 2169)
@@ -9,15 +9,13 @@
conn <- getConnection(socket[1])
else
conn <- socket
-
-
- retval <- .C("R_setTCPNoDelay",
- socket=as.integer(socket[1]),
- flag=as.integer(value),
- status=integer(1),
- status.str=as.character(buffer),
- status.len=as.integer(nchar(buffer)),
- package="gtools"
+
+ retval <- .C(C_setTCPNoDelay,
+ socket = as.integer(socket[1]),
+ flag = as.integer(value),
+ status = integer(1),
+ status.str = as.character(buffer),
+ status.len = as.integer(nchar(buffer))
)
if(retval$status != 0)
Modified: pkg/gtools/man/combinations.Rd
===================================================================
--- pkg/gtools/man/combinations.Rd 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/man/combinations.Rd 2017-06-14 19:42:59 UTC (rev 2169)
@@ -36,7 +36,7 @@
Returns a matrix where each row contains a vector of length \code{r}.
}
\references{Venables, Bill. "Programmers Note", R-News, Vol 1/1,
- Jan. 2001. \url{http://cran.r-project.org/doc/Rnews/} }
+ Jan. 2001. \url{https://cran.r-project.org/doc/Rnews/} }
\author{ Original versions by Bill Venables
\email{Bill.Venables at cmis.csiro.au}. Extended to handle
\code{repeats.allowed} by Gregory R. Warnes
@@ -53,6 +53,6 @@
# To use large 'n', you need to change the default recusion limit
options(expressions=1e5)
cmat <- combinations(300,2)
-dim(cmat) # 44850 by 2
+dim(cmat) # 44850 by 2
}
\keyword{ manip }
Modified: pkg/gtools/man/defmacro.Rd
===================================================================
--- pkg/gtools/man/defmacro.Rd 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/man/defmacro.Rd 2017-06-14 19:42:59 UTC (rev 2169)
@@ -50,7 +50,7 @@
a C programmer might expect
\code{mul(i, j + k)} to expand (incorrectly) to \code{i*j + k}. In fact it
expands correctly, to the equivalent of \code{i*(j + k)}.
-
+
For a discussion of the differences between functions
and macros, please Thomas Lumley's R-News article (reference below).
}
@@ -61,7 +61,7 @@
The original \code{defmacro} code was directly taken from:
Lumley T. "Programmer's Niche: Macros in R", R News, 2001, Vol 1,
- No. 3, pp 11--13, \url{http://cran.r-project.org/doc/Rnews/}
+ No. 3, pp 11--13, \url{https://cran.r-project.org/doc/Rnews/}
}
\author{ Thomas Lumley wrote \code{defmacro}. Gregory R. Warnes
\email{greg at warnes.net} enhanced it and created
@@ -112,7 +112,7 @@
###
# String macro (note the quoted text in the calls below)
-#
+#
# This style of macro can be useful when you are reading
# function arguments from a text file
###
@@ -121,7 +121,7 @@
)
plot.s( "d", "V1")
-plot.s( DF="d", VAR="V1", COL='"blue"' )
+plot.s( DF="d", VAR="V1", COL='"blue"' )
plot.s( "d", "V1", DOTS='lwd=4') # use optional 'DOTS' argument
Added: pkg/gtools/src/gtools.h
===================================================================
--- pkg/gtools/src/gtools.h (rev 0)
+++ pkg/gtools/src/gtools.h 2017-06-14 19:42:59 UTC (rev 2169)
@@ -0,0 +1,29 @@
+#include <R.h>
+#include <Rinternals.h>
+#include <R_ext/Rdynload.h>
+
+void setTCPNoDelay(int *socket,
+ int* flag,
+ int* status,
+ char** status_str,
+ int* status_len
+);
+
+void convert(char** letters,
+ int* nchar,
+ int* values
+);
+
+
+void roman2int(char** str,
+ int* nchar,
+ int* retval);
+
+
+R_CMethodDef cMethods[] = {
+ {"setTCPNoDelay", (DL_FUNC) &setTCPNoDelay, 5},
+ {"convert", (DL_FUNC) &convert, 3},
+ {"roman2int", (DL_FUNC) &roman2int, 3},
+ {NULL, NULL, 0}
+};
+
Added: pkg/gtools/src/gtools_load.c
===================================================================
--- pkg/gtools/src/gtools_load.c (rev 0)
+++ pkg/gtools/src/gtools_load.c 2017-06-14 19:42:59 UTC (rev 2169)
@@ -0,0 +1,14 @@
+#include "gtools.h"
+
+void R_init_gtools(DllInfo *info)
+{
+ /* Register C routines */
+ R_registerRoutines (info, cMethods, NULL, NULL, NULL);
+ R_useDynamicSymbols(info, FALSE);
+ R_forceSymbols (info, TRUE);
+}
+
+void R_unload_gtools(DllInfo *info)
+{
+ /* Release resources. */
+}
Modified: pkg/gtools/src/setTCPNoDelay.c
===================================================================
--- pkg/gtools/src/setTCPNoDelay.c 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/src/setTCPNoDelay.c 2017-06-14 19:42:59 UTC (rev 2169)
@@ -29,7 +29,7 @@
ERRNO ":" DESCR,
status_len);
break;
-#endif
+#endif
@@ -61,7 +61,7 @@
CASE_ERR(WSAENOPROTOOPT, "he option is unknown or unsupported for the specified provider or socket (see SO_GROUP_PRIORITY limitations).");
CASE_ERR(WSAENOTCONN, "Connection has been reset when SO_KEEPALIVE is set.");
CASE_ERR(WSAENOTSOCK, "The descriptor is not a socket.");
-
+
case 0:
strncpy( status_str,
"SUCCESS",
@@ -69,7 +69,7 @@
break;
default:
- strncpy(status_str, strerror(status), status_len);
+ strncpy(status_str, strerror(status), status_len);
break;
}
@@ -78,17 +78,17 @@
/* Function to de-nagle a TCP socket connection */
-void R_setTCPNoDelay(int *socket,
+void setTCPNoDelay(int *socket,
int* flag,
int* status,
char** status_str,
int* status_len)
{
int off;
-
+
/* ensure that we use only 0,1 values */
off = (*flag) ? 1 : 0;
-
+
*status = setsockopt(
*socket,
IPPROTO_TCP,
@@ -99,43 +99,6 @@
checkStatus(errno, status_str[0], *status_len);
-
+
return;
}
-
-/* function to check socket options */
-/* NOT USED...
-void R_getsockopt(int *s,
- int *level,
- int *optname,
- int *optval,
- int *optlen,
- int *status,
- char *status_str,
- int *status_len)
-{
- *status = getsockopt(*s, *level, *optname, optval, optlen);
-
- checkStatus(*status, status_str, *status_len);
-
-}
-*/
-
-/* function to set socket options */
-/* NOT USED ...
-void R_setsockopt(int *s,
- int *level,
- int *optname,
- int *optval,
- int *optlen,
- int *status,
- char *status_str,
- int *status_len)
-{
-
- *status = setsockopt(*s, *level, *optname, optval, *optlen);
-
- checkStatus(*status, status_str, *status_len);
-}
-*/
-
Modified: pkg/gtools/tests/test_setTCPNoDelay.R
===================================================================
--- pkg/gtools/tests/test_setTCPNoDelay.R 2017-06-13 00:16:17 UTC (rev 2168)
+++ pkg/gtools/tests/test_setTCPNoDelay.R 2017-06-14 19:42:59 UTC (rev 2169)
@@ -1,35 +1,5 @@
library('gtools')
-setTCPNoDelay <- function( socket, value=TRUE )
-{
- if(!any(c("socket","sockconn") %in% class(socket)))
- stop("socket must be a socket object")
-
- buffer <- paste(rep(" ", 1000), sep='', collapse='')
-
- if("sockconn" %in% class(socket))
- conn <- getConnection(socket[1])
- else
- conn <- socket
-
-
- retval <- .C("R_setTCPNoDelay",
- socket=as.integer(socket[1]),
- flag=as.integer(value),
- status=integer(1),
- status.str=as.character(buffer),
- status.len=as.integer(nchar(buffer)),
- package="gtools"
- )
-
- if(retval$status != 0)
- stop( retval$status.str )
- else
- invisible(retval$status.str)
-}
-
-
-
host <- "www.r-project.org"
socket <- make.socket(host, 80)
print(socket)
@@ -38,6 +8,5 @@
write.socket(socket, "GET /\n\n")
write.socket(socket, "A")
write.socket(socket, "B\n")
-while( (str <- read.socket(socket)) > "")
- cat(str)
+while( (str <- read.socket(socket)) > "") cat(str)
close.socket(socket)
More information about the R-gregmisc-commits
mailing list