Commit 5082a080 authored by Radford Neal's avatar Radford Neal

new tests for seek in reg-IO2.R

parent 3ccc2ef4
......@@ -122,3 +122,163 @@ writeLines(x, "test.dat")
read.table("test.dat", allowEscapes=FALSE, header = TRUE)
unlink("test.dat")
## end of tests
## Tests of "seek". The "pr" argument can be "print" for debugging.
seek_test <- function (file, encoding="", pr=invisible) {
# Do it with file contents actually all ASCII.
cat("With ASCII only\n")
con <- file (file)
open (con, "w")
lets <- rep (paste (LETTERS, collapse=""), 100)
substring(lets[1],3,3) <- ":"
lets[2] <- paste (letters, collapse="")
writeLines (lets, con)
close (con)
con <- file (file, encoding=encoding)
open (con, "r+")
cat ("seekable?", isSeekable(con), "\n")
r <- readLines (con)
pr (seek (con, NA))
stopifnot (identical (r, lets))
pr (seek (con, 0))
r <- readLines (con, n=1)
pr (r)
pr (L2pos <- seek (con, NA))
stopifnot (identical (r, lets[1]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[3]))
pr (seek (con, L2pos))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[3]))
pr (seek (con, L2pos))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
cat("--\n")
uvwxyz <- "uvwyxzuvwyxz..uvwyxzuvwyxz"
pr (seek (con, L2pos, rw="w"))
writeLines (rep(uvwxyz,2), con)
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, uvwxyz))
pr (seek (con, 0))
r <- readLines (con, n=4)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, c(lets[1],uvwxyz,uvwxyz,lets[4])))
close (con)
cat ("OK\n")
# Do it again with file containing some UTF-8 characters.
cat("With UTF-8\n")
con <- file (file)
open (con, "w", useBytes=TRUE)
LETRS <- LETTERS
LETRS[1] <- "\u0100"
LETRS[5] <- "\u0112"
lets <- rep (paste (LETRS, collapse=""), 100)
substring(lets[1],3,3) <- ":"
letrs <- letters
letrs[1] <- "\u0101"
letrs[5] <- "\u0113"
lets[2] <- paste (letrs, collapse="")
writeLines (lets, con)
close (con)
con <- file (file, encoding=encoding)
open (con, "r+")
cat ("seekable?", isSeekable(con), "\n")
r <- readLines (con)
pr (seek (con, NA))
pr(r)
lets <- r
pr (seek (con, 0))
r <- readLines (con, n=1)
pr (r)
pr (L2pos <- seek (con, NA))
stopifnot (identical (r, lets[1]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[3]))
pr (seek (con, L2pos))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[3]))
pr (seek (con, L2pos))
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, lets[2]))
cat("--\n")
uvwxyz <- "\u0101vwy\u0102zuvwyxz..uvwyxzuvwyxz"
pr (seek (con, L2pos, rw="w"))
writeLines (rep(uvwxyz,2), con)
r <- readLines (con, n=1)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r, enc2native(uvwxyz)))
pr (seek (con, 0))
r <- readLines (con, n=4)
pr (r)
pr (seek (con, NA))
stopifnot (identical (r,
c(lets[1],enc2native(uvwxyz),enc2native(uvwxyz),lets[4])))
close (con)
cat ("OK\n")
}
tf <- tempfile()
seek_test (tf)
seek_test (tf, "UTF-8")
R version 2.15.0 alpha (2012-03-02 r58556)
Copyright (C) 2012 The R Foundation for Statistical Computing
pqR version 2.15.1 (2018-00-00), based on R 2.15.0 (2012-03-30)
R 2.15.0 is Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Modifications to R in pqR are Copyright (C) 2013-2018 Radford M. Neal
Some modules are from R-2.15.1 or later versions distributed by the R Core Team
Platform: x86_64-unknown-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
......@@ -16,6 +22,9 @@ Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
No helper threads, task merging enabled, uncompressed pointers.
> ## tests of boundary cases in read.table()
>
> ## force standard handling for character cols
......@@ -251,3 +260,179 @@ Read 4 items
> unlink("test.dat")
> ## end of tests
>
>
> ## Tests of "seek". The "pr" argument can be "print" for debugging.
>
> seek_test <- function (file, encoding="", pr=invisible) {
+
+ # Do it with file contents actually all ASCII.
+
+ cat("With ASCII only\n")
+
+ con <- file (file)
+ open (con, "w")
+ lets <- rep (paste (LETTERS, collapse=""), 100)
+ substring(lets[1],3,3) <- ":"
+ lets[2] <- paste (letters, collapse="")
+ writeLines (lets, con)
+ close (con)
+
+ con <- file (file, encoding=encoding)
+ open (con, "r+")
+ cat ("seekable?", isSeekable(con), "\n")
+
+ r <- readLines (con)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets))
+
+ pr (seek (con, 0))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (L2pos <- seek (con, NA))
+ stopifnot (identical (r, lets[1]))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[3]))
+
+ pr (seek (con, L2pos))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[3]))
+
+ pr (seek (con, L2pos))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+
+ cat("--\n")
+
+ uvwxyz <- "uvwyxzuvwyxz..uvwyxzuvwyxz"
+ pr (seek (con, L2pos, rw="w"))
+ writeLines (rep(uvwxyz,2), con)
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, uvwxyz))
+
+ pr (seek (con, 0))
+ r <- readLines (con, n=4)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, c(lets[1],uvwxyz,uvwxyz,lets[4])))
+
+ close (con)
+ cat ("OK\n")
+
+ # Do it again with file containing some UTF-8 characters.
+
+ cat("With UTF-8\n")
+
+ con <- file (file)
+ open (con, "w", useBytes=TRUE)
+ LETRS <- LETTERS
+ LETRS[1] <- "\u0100"
+ LETRS[5] <- "\u0112"
+ lets <- rep (paste (LETRS, collapse=""), 100)
+ substring(lets[1],3,3) <- ":"
+ letrs <- letters
+ letrs[1] <- "\u0101"
+ letrs[5] <- "\u0113"
+ lets[2] <- paste (letrs, collapse="")
+ writeLines (lets, con)
+ close (con)
+
+ con <- file (file, encoding=encoding)
+ open (con, "r+")
+ cat ("seekable?", isSeekable(con), "\n")
+
+ r <- readLines (con)
+ pr (seek (con, NA))
+ pr(r)
+ lets <- r
+
+ pr (seek (con, 0))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (L2pos <- seek (con, NA))
+ stopifnot (identical (r, lets[1]))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[3]))
+
+ pr (seek (con, L2pos))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[3]))
+
+ pr (seek (con, L2pos))
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, lets[2]))
+
+ cat("--\n")
+
+ uvwxyz <- "\u0101vwy\u0102zuvwyxz..uvwyxzuvwyxz"
+ pr (seek (con, L2pos, rw="w"))
+ writeLines (rep(uvwxyz,2), con)
+ r <- readLines (con, n=1)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r, enc2native(uvwxyz)))
+
+ pr (seek (con, 0))
+ r <- readLines (con, n=4)
+ pr (r)
+ pr (seek (con, NA))
+ stopifnot (identical (r,
+ c(lets[1],enc2native(uvwxyz),enc2native(uvwxyz),lets[4])))
+
+ close (con)
+ cat ("OK\n")
+ }
>
> tf <- tempfile()
>
> seek_test (tf)
With ASCII only
seekable? TRUE
--
OK
With UTF-8
seekable? TRUE
--
OK
>
> seek_test (tf, "UTF-8")
With ASCII only
seekable? TRUE
--
OK
With UTF-8
seekable? TRUE
--
OK
>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment