| Line 1... |
Line 1... |
| 1 |
#### Regression and other checks for 'make check-devel' but *not* for 'make check'
|
1 |
#### Regression and other checks for 'make check-devel' but *not* for 'make check'
|
| 2 |
|
2 |
|
| 3 |
## PR#18555: dummy_fgetc() returning EOF if the connection has an encoding specified
|
3 |
## PR#18555: dummy_fgetc() returning EOF if the connection has an encoding specified
|
| 4 |
## -------- Based on small change from https://bugs.r-project.org/show_bug.cgi?id=18555#c4
|
- |
|
| 5 |
## FIXME: needs a more thorough analysis and fixes (see 'Comment #2' in PR)
|
- |
|
| 6 |
|
4 |
|
| - |
|
5 |
# try to find an available port
|
| 7 |
port <- 27182
|
6 |
port <- NULL
|
| - |
|
7 |
for(p in round(runif(100, 27000, 28000))) {
|
| - |
|
8 |
sock <- tryCatch(serverSocket(p), error= function(e) NULL)
|
| - |
|
9 |
if (!is.null(sock)) {
|
| - |
|
10 |
port <- p
|
| - |
|
11 |
break
|
| - |
|
12 |
}
|
| - |
|
13 |
}
|
| 8 |
sock <- serverSocket(port)
|
14 |
stopifnot(!is.null(port))
|
| - |
|
15 |
|
| 9 |
outgoing <- socketConnection("localhost", port)
|
16 |
outgoing <- socketConnection("localhost", port)
|
| 10 |
incoming <- socketAccept(sock, encoding="UTF-8")
|
17 |
incoming <- socketAccept(sock, encoding="UTF-8")
|
| 11 |
close(sock)
|
18 |
close(sock)
|
| 12 |
r <- readLines(incoming, 1) # sets EOF_signalled
|
19 |
r <- readLines(incoming, 1) # sets EOF_signalled
|
| 13 |
stopifnot(identical(r, character(0)))
|
20 |
stopifnot(identical(r, character(0)))
|
| Line 20... |
Line 27... |
| 20 |
r <- readLines(incoming, 1)
|
27 |
r <- readLines(incoming, 1)
|
| 21 |
}
|
28 |
}
|
| 22 |
close(incoming)
|
29 |
close(incoming)
|
| 23 |
stopifnot(identical(r, "hello")) # r was character(0) in error
|
30 |
stopifnot(identical(r, "hello")) # r was character(0) in error
|
| 24 |
|
31 |
|
| 25 |
if (FALSE) { # disabled for further analysis/cleanup
|
- |
|
| 26 |
|
- |
|
| 27 |
sockChk <- function(enc, timeout = 0.25, verbose = TRUE, port = 27182)
|
- |
|
| 28 |
{
|
- |
|
| 29 |
stopifnot(is.character(enc), length(enc) == 1L)
|
- |
|
| 30 |
if(verbose) {
|
- |
|
| 31 |
cat(sprintf("enc = '%s', timeout=%g:\n", enc, timeout))
|
- |
|
| 32 |
pr <- print
|
- |
|
| 33 |
} else
|
- |
|
| 34 |
pr <- identity
|
- |
|
| 35 |
sock <- serverSocket(port)
|
- |
|
| 36 |
outgoing <- socketConnection("localhost", port, encoding=enc)
|
- |
|
| 37 |
incoming <- socketAccept(sock, encoding=enc)
|
- |
|
| 38 |
on.exit({close(incoming); close(outgoing); close(sock) })
|
- |
|
| 39 |
writeLines("hello", outgoing) ; flush(outgoing)
|
- |
|
| 40 |
r1 <- readLines(incoming, 1) # "hello"
|
- |
|
| 41 |
r2 <- readLines(incoming, 1) # character(0) *and* EOF_signalled gets set
|
- |
|
| 42 |
writeLines("again1", outgoing); flush(outgoing)
|
- |
|
| 43 |
stopifnot(identical(r2, character(0)), ## now *have* incoming again:
|
- |
|
| 44 |
socketSelect(list(incoming)))
|
- |
|
| 45 |
r3 <- readLines(incoming, 1) # got character(0) incorrectly
|
- |
|
| 46 |
## because of con->EOF_signalled, dummy_fgetc didn't attempt to read more data
|
- |
|
| 47 |
if(socketSelect(list(incoming), timeout=0)) # *was* TRUE wrongly
|
- |
|
| 48 |
stop("incoming is empty")
|
- |
|
| 49 |
writeLines("again2", outgoing)
|
- |
|
| 50 |
writeLines("again3", outgoing); flush(outgoing)
|
- |
|
| 51 |
if(timeout) Sys.sleep(timeout) # flush not sufficient -> need timeout, platform dependently
|
- |
|
| 52 |
r4 <- readLines(incoming, 1) # was character(0), on Mac even after r84624 (timeout=0)
|
- |
|
| 53 |
## NB isIncomplete(incoming) being FALSE corresponds to doc
|
- |
|
| 54 |
r5 <- suppressWarnings(# Warning "text connection used with readChar(), .."
|
- |
|
| 55 |
readChar(incoming, 100))
|
- |
|
| 56 |
stopifnot(identical(pr(cbind(r1,r3,r4,r5)[1,]), # print() before possibly reporting ..
|
- |
|
| 57 |
c(r1 = "hello", r3 = "again1",
|
- |
|
| 58 |
r4 = "again2",r5 = "again3\n")))
|
- |
|
| 59 |
invisible(TRUE)
|
- |
|
| 60 |
}
|
- |
|
| 61 |
|
- |
|
| 62 |
## All three failed on (arm64) macOS (with 0 timeout); PR#18555, comment c5: even 0.5 is insufficient
|
- |
|
| 63 |
timeout <- if(Sys.info()["sysname"] == "Darwin") 1.0 else 0.125
|
- |
|
| 64 |
# 0 seemed sufficient for non-Mac
|
- |
|
| 65 |
sockChk("ASCII", timeout)
|
- |
|
| 66 |
sockChk("UTF-8", timeout)
|
- |
|
| 67 |
## The default is getOption("encoding") which defaults to "native.enc"
|
- |
|
| 68 |
sockChk("native.enc", timeout)
|
- |
|
| 69 |
## only the last already worked in R <= 4.3.1 {for non macOS with 0 timeout}
|
- |
|
| 70 |
|
- |
|
| 71 |
## stress test w/o sleep
|
- |
|
| 72 |
lapply(1:50, \(i) try({ cat(i,":\n---\n")
|
- |
|
| 73 |
sockChk("ASCII", 0)
|
- |
|
| 74 |
sockChk("UTF-8", 0)
|
- |
|
| 75 |
sockChk("native.enc", 0)
|
- |
|
| 76 |
})) -> R
|
- |
|
| 77 |
str(R, give.attr = FALSE)
|
- |
|
| 78 |
table(sapply(R, \(e) if(is.logical(e)) e else class(e)))
|
- |
|
| 79 |
|
- |
|
| 80 |
proc.time()
|
32 |
proc.time()
|
| 81 |
}
|
- |
|
| 82 |
|
33 |
|
The R Project SVN
R