@r-universe/webr 2023.6.11 → 2023.6.21

package/dist/vfs/usr/lib/R/tests/reg-tests-1c.R

@@ -0,0 +1,1631 @@
+## Regression tests for R 3.[0-3].*  _plus_ later modifications of these
+
+pdf("reg-tests-1c.pdf", encoding = "ISOLatin1.enc")
+.pt <- proc.time()
+
+## mapply with classed objects with length method
+## was not documented to work in 2.x.y
+setClass("A", representation(aa = "integer"))
+a <- new("A", aa = 101:106)
+setMethod("length", "A", function(x) length(x@aa))
+setMethod("[[", "A", function(x, i, j, ...) x@aa[[i]])
+(z <- mapply(function(x, y) {x * y}, a, rep(1:3, 2)))
+stopifnot(z == c(101, 204, 309, 104, 210, 318))
+## reported as a bug (which it was not) by H. Pages in
+## https://stat.ethz.ch/pipermail/r-devel/2012-November/065229.html
+
+## recyling in split()
+## https://stat.ethz.ch/pipermail/r-devel/2013-January/065700.html
+x <- 1:6
+y <- split(x, 1:2)
+class(x) <- "ABC" ## class(x) <- "A" creates an invalid object
+yy <- split(x, 1:2)
+stopifnot(identical(y, yy))
+## were different in R < 3.0.0
+
+
+## dates with fractional seconds after 2038 (PR#15200)
+## Extremely speculative!
+z <- as.POSIXct(2^31+c(0.4, 0.8), origin=ISOdatetime(1970,1,1,0,0,0,tz="GMT"))
+zz <- format(z)
+stopifnot(zz[1] == zz[2])
+## printed form rounded not truncated in R < 3.0.0
+
+## origin coerced in tz and not GMT by as.POSIXct.numeric()
+x <- as.POSIXct(1262304000, origin="1970-01-01", tz="EST")
+y <- as.POSIXct(1262304000, origin=.POSIXct(0, "GMT"), tz="EST")
+stopifnot(identical(x, y))
+
+## Handling records with quotes in names
+x <- c("a b' c",
+"'d e' f g",
+"h i 'j",
+"k l m'")
+y <- data.frame(V1 = c("a", "d e", "h"), V2 = c("b'", "f", "i"), V3 = c("c", "g", "j\nk l m"))
+f <- tempfile()
+writeLines(x, f)
+stopifnot(identical(count.fields(f), c(3L, 3L, NA_integer_, 3L)))
+stopifnot(identical(read.table(f), y))
+stopifnot(identical(scan(f, ""), as.character(t(as.matrix(y)))))
+
+## docu always said  'length 1 is sorted':
+stopifnot(!is.unsorted(NA))
+
+## str(.) for large factors should be fast:
+u <- as.character(runif(1e5))
+dummy <- str(u); dummy <- str(u); # force compilation of str
+t1 <- max(0.001, system.time(str(u))[[1]]) # get a baseline > 0
+uf <- factor(u)
+(t2 <- system.time(str(uf))[[1]]) / t1 # typically around 1--2
+stopifnot(t2  / t1 < 30)
+## was around 600--850 for R <= 3.0.1
+
+
+## ftable(<array with unusual dimnames>)
+(m <- matrix(1:12, 3,4, dimnames=list(ROWS=paste0("row",1:3), COLS=NULL)))
+ftable(m)
+## failed to format (and hence print) because of NULL 'COLS' dimnames
+
+## regression test formerly in kmeans.Rd, but result differs by platform
+## Artificial example [was "infinite loop" on x86_64; PR#15364]
+rr <- c(rep(-0.4, 5), rep(-0.4- 1.11e-16, 14), -.5)
+r. <- signif(rr, 12)
+k3 <- kmeans(rr, 3, trace=2) ## Warning: Quick-Transfer.. steps exceed
+try ( k. <- kmeans(r., 3) ) # after rounding, have only two distinct points
+      k. <- kmeans(r., 2)   # fine
+
+
+## PR#15376
+stem(c(1, Inf))
+## hung in 3.0.1
+
+
+## PR#15377, very long variable names
+x <- 1:10
+y <- x + rnorm(10)
+z <- y + rnorm(10)
+yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy <- y
+fit <- lm(cbind(yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy, z) ~ x)
+## gave spurious error message in 3.0.1.
+
+## PR#15341 singular complex matrix in rcond()
+set.seed(11)
+n <- 5
+A <- matrix(runif(n*n),nrow=n)
+B <- matrix(runif(n*n),nrow=n)
+B[n,] <- (B[n-1,]+B[n-2,])/2
+rcond(B)
+B <- B + 0i
+rcond(B)
+## gave error message (OK) in R 3.0.1: now returns 0 as in real case.
+
+
+## Misuse of formatC as in PR#15303
+days <- as.Date(c("2012-02-02", "2012-03-03", "2012-05-05"))
+(z <- formatC(days))
+stopifnot(!is.object(z), is.null(oldClass(z)))
+## used to copy over class in R < 3.0.2.
+
+
+## PR15219
+val <- sqrt(pi)
+fun <- function(x) (-log(x))^(-1/2)
+(res <- integrate(fun, 0, 1, rel.tol = 1e-4))
+stopifnot(abs(res$value - val) < res$abs.error)
+(res <- integrate(fun, 0, 1, rel.tol = 1e-6))
+stopifnot(abs(res$value - val) < res$abs.error)
+res <- integrate(fun, 0, 1, rel.tol = 1e-8)
+stopifnot(abs(res$value - val) < res$abs.error)
+
+fun <- function(x) x^(-1/2)*exp(-x)
+(res <- integrate(fun, 0, Inf, rel.tol = 1e-4))
+stopifnot(abs(res$value - val) < res$abs.error)
+(res <- integrate(fun, 0, Inf, rel.tol = 1e-6))
+stopifnot(abs(res$value - val) < res$abs.error)
+(res <- integrate(fun, 0, Inf, rel.tol = 1e-8))
+stopifnot(abs(res$value - val) < res$abs.error)
+## sometimes exceeded reported error in 2.12.0 - 3.0.1
+
+
+## Unary + should coerce
+x <- c(TRUE, FALSE, NA, TRUE)
+stopifnot(is.integer(+x))
+## +x was logical in R <= 3.0.1
+
+
+## Attritbutes of value of unary operators
+# +x, -x were ts, !x was not in 3.0.2
+x <- ts(c(a=TRUE, b=FALSE, c=NA, d=TRUE), frequency = 4, start = 2000)
+x; +x; -x; !x
+stopifnot(is.ts(!x), !is.ts(+x), !is.ts(-x))
+# +x, -x were ts, !x was not in 3.0.2
+x <- ts(c(a=1, b=2, c=0, d=4), frequency = 4, start = 2010)
+x; +x; -x; !x
+stopifnot(!is.ts(!x), is.ts(+x), is.ts(-x))
+##
+
+
+## regression test incorrectly in colorRamp.Rd
+bb <- colorRampPalette(2)(4)
+stopifnot(bb[1] == bb)
+## special case, invalid in R <= 2.15.0:
+
+
+## Setting NAMED on ... arguments
+f <- function(...) { x <- (...); x[1] <- 7; (...) }
+stopifnot(f(1+2) == 3)
+## was 7 in 3.0.1
+
+
+## copying attributes from only one arg of a binary operator.
+A <- array(c(1), dim = c(1L,1L), dimnames = list("a", 1))
+x <- c(a = 1)
+B <- A/(pi*x)
+stopifnot(is.null(names(B)))
+## was wrong in R-devel in Aug 2013
+## needed an un-NAMED rhs.
+
+
+## lgamma(x) for very small negative x
+X <- 3e-308; stopifnot(identical(lgamma(-X), lgamma(X)))
+## lgamma(-X) was NaN in R <= 3.0.1
+
+
+## PR#15413
+z <- subset(data.frame(one = numeric()), select = one)
+stopifnot(nrow(z) == 0L)
+## created a row prior to 3.0.2
+
+
+## https://stat.ethz.ch/pipermail/r-devel/2013-September/067524.html
+dbeta(0.9, 9.9e307, 10)
+dbeta(0.1, 9,  9.9e307)
+dbeta(0.1, 9.9e307, 10)
+## first two hung in R <= 3.0.2
+
+## PR#15465 (0-extent matrix / data frame)
+provideDimnames(matrix(nrow = 0, ncol = 1))
+provideDimnames(table(character()))
+as.data.frame(table(character()))
+## all failed in 3.0.2
+
+## PR#15004
+n <- 10
+s <- 3
+l <- 10000
+m <- 20
+x <- data.frame(x1 = 1:n, x2 = 1:n)
+by <- data.frame(V1 = factor(rep(1:3, n %/% s + 1)[1:n], levels = 1:s))
+for(i in 1:m) {
+    by[[i + 1]] <- factor(rep(l, n), levels = 1:l)
+}
+agg <- aggregate.data.frame(x, by, mean)
+stopifnot(nrow(unique(by)) == nrow(agg))
+## rounding caused groups to be falsely merged
+
+## PR#15454
+set.seed(357)
+z <- matrix(c(runif(50, -1, 1), runif(50, -1e-190, 1e-190)), nrow = 10)
+contour(z)
+## failed because rounding made crossing tests inconsistent
+
+## Various cases where zero length vectors were not handled properly
+## by functions in base and utils, including PR#15499
+y <- as.data.frame(list())
+format(y)
+format(I(integer()))
+gl(0, 2)
+z <- list(numeric(0), 1)
+stopifnot(identical(relist(unlist(z), z), z))
+summary(y)
+## all failed in 3.0.2
+
+## PR#15518 Parser catching errors in particular circumstance:
+(ee <- tryCatch(parse(text = "_"), error= function(e)e))
+stopifnot(inherits(ee, "error"))
+## unexpected characters caused the parser to segfault in 3.0.2
+
+
+## nonsense value of nmax
+unique(1:3, nmax = 1)
+## infinite-looped in 3.0.2, now ignored.
+
+
+## besselI() (and others), now using sinpi() etc:
+stopifnot(all.equal(besselI(2.125,-5+1/1024),
+		    0.02679209380095711, tol= 8e-16),
+	  all.equal(lgamma(-12+1/1024), -13.053274367453049, tol=8e-16))
+## rel.error was 1.5e-13 / 7.5e-14 in R <= 3.0.x
+ss <- sinpi(2*(-10:10)-2^-12)
+tt <- tanpi(  (-10:10)-2^-12)
+stopifnot(ss == ss[1], tt == tt[1], # as internal arithmetic must be exact here
+	  all.equal(ss[1], -0.00076699031874270453, tol=8e-16),
+	  all.equal(tt[1], -0.00076699054434309260, tol=8e-16))
+## (checked via Rmpfr) The above failed during development
+
+
+## PR#15535 c() "promoted" raw vectors to bad logical values
+stopifnot( c(as.raw(11), TRUE) == TRUE )
+## as.raw(11) became a logical value coded as 11,
+## and did not test equal to TRUE.
+
+
+## PR#15564
+fit <- lm(rnorm(10) ~ I(1:10))
+predict(fit, interval = "confidence", scale = 1)
+## failed in <= 3.0.2 with object 'w' not found
+
+
+## PR#15534 deparse() did not produce reparseable complex vectors
+assert.reparsable <- function(sexp) {
+  deparsed <- paste(deparse(sexp), collapse=" ")
+  reparsed <- tryCatch(eval(parse(text=deparsed)[[1]]), error = function(e) NULL)
+  if (is.null(reparsed))
+    stop(sprintf("Deparsing produced invalid syntax: %s", deparsed))
+  if(!identical(reparsed, sexp))
+    stop(sprintf("Deparsing produced change: value is not %s", reparsed))
+}
+
+assert.reparsable(1)
+assert.reparsable("string")
+assert.reparsable(2+3i)
+assert.reparsable(1:10)
+assert.reparsable(c(NA, 12, NA, 14))
+assert.reparsable(as.complex(NA))
+assert.reparsable(complex(real=Inf, i=4))
+assert.reparsable(complex(real=Inf, i=Inf))
+assert.reparsable(complex(real=Inf, i=-Inf))
+assert.reparsable(complex(real=3, i=-Inf))
+assert.reparsable(complex(real=3, i=NaN))
+assert.reparsable(complex(r=NaN, i=0))
+assert.reparsable(complex(real=NA, i=1))
+assert.reparsable(complex(real=1, i=NA))
+## last 7 all failed
+
+
+## PR#15621 backticks could not be escaped
+stopifnot(deparse(as.name("`"), backtick=TRUE) == "`\\``")
+assign("`", TRUE)
+`\``
+tools::assertError(parse("```"))
+##
+
+
+## We document tanpi(0.5) etc to be NaN
+stopifnot(is.nan(tanpi(c(0.5, 1.5, -0.5, -1.5))))
+## That is not required for system implementations, and some give +/-Inf
+
+
+## PR#15642 segfault when parsing overflowing reals
+as.double("1e1000")
+
+
+ll <- ml <- list(1,2); dim(ml) <- 2:1
+ali <- all.equal(list( ), identity)  # failed in R-devel for ~ 30 hours
+al1 <- all.equal(list(1), identity)  # failed in R < 3.1.0
+stopifnot(length(ali) == 3, grepl("list", ali[1]),
+	  grepl("length", ali[2], ignore.case=TRUE),
+	  is.character(al1), length(al1) >= 2,
+	  all.equal(ml, ml),
+	  all.equal(ll, ml, check.attributes=FALSE))
+
+
+## PR#15699 aggregate failed when there were no grouping variables
+dat <- data.frame(Y = runif(10), X = sample(LETTERS[1:3], 10, TRUE))
+aggregate(Y ~ 1, FUN = mean, data = dat)
+
+
+## merge() with duplicated column names, similar to PR#15618
+X <- data.frame(Date = c("1967-02-01", "1967-02-02", "1967-02-03"),
+                Settle.x = c(NA, NA, NA), Settle.y = c(NA, NA, NA),
+                Settle = c(35.4, 35.15, 34.95))
+Y <- data.frame(Date = c("2013-12-10", "2013-12-11", "2013-12-12"),
+                Settle = c(16.44, 16.65, 16.77))
+merge(X, Y, by = "Date", all = TRUE)
+## failed in R < 3.1.0: now warns (correctly).
+
+
+## PR#15679
+badstructure <- function(depth, key)
+{
+    ch <- if (depth == 1L) list() else list(badstructure(depth-1,key))
+    r <- list()
+    r[[key]] <- ch
+    r
+}
+badstructure(20, "children")
+## overran, segfaulted for the original reporter.
+
+
+## PR#15702 and PR#15703
+d <- as.dendrogram(hclust(dist(sin(1:7))))
+(dl <- d[[c(2,1,2)]]) # single-leaf dendrogram
+stopifnot(inherits(dl, "dendrogram"), is.leaf(dl),
+	  identical(attributes(reorder(dl, 1:7)), c(attributes(dl), value = 5L)),
+	  identical(order.dendrogram(dl), as.vector(dl)),
+	  identical(d, as.dendrogram(d)))
+## as.dendrogram() was hidden;  order.*() failed for leaf
+
+
+## using *named* method
+hw <- hclust(dist(sqrt(1:5)), method=c(M = "ward"))
+## failed for 2 days in R-devel/-alpha
+
+
+## PR#15758
+my_env <- new.env(); my_env$one <- 1L
+save(one, file = tempfile(), envir = my_env)
+## failed in R < 3.1.1.
+
+
+## Conversion to numeric in boundary case
+ch <- "0x1.ffa0000000001p-1"
+rr <- type.convert(ch, numerals = "allow.loss", as.is=FALSE)
+rX <- type.convert(ch, numerals = "no.loss",    as.is=FALSE)
+stopifnot(is.numeric(rr), identical(rr, rX),
+          all.equal(rr, 0.999267578125),
+	  all.equal(type.convert(ch,	      numerals = "warn", as.is=FALSE),
+		    type.convert("0x1.ffap-1",numerals = "warn", as.is=FALSE), tol = 5e-15))
+## type.convert(ch) was not numeric in R 3.1.0
+##
+ch <- "1234567890123456789"
+rr <- type.convert(ch, numerals = "allow.loss", as.is=FALSE)
+rX <- type.convert(ch, numerals = "no.loss",    as.is=FALSE)
+rx <- type.convert(ch, numerals = "no.loss",    as.is= TRUE)
+tools::assertWarning(r. <- type.convert(ch, numerals = "warn.loss", as.is=FALSE))
+stopifnot(is.numeric(rr), identical(rr, r.), all.equal(rr, 1.234567890e18),
+	  is.factor(rX),  identical(rx, ch))
+
+
+## PR#15764: integer overflow could happen without a warning or giving NA
+tools::assertWarning(ii <- 1980000020L + 222000000L)
+stopifnot(is.na(ii))
+tools::assertWarning(ii <- (-1980000020L) + (-222000000L))
+stopifnot(is.na(ii))
+tools::assertWarning(ii <- (-1980000020L) - 222000000L)
+stopifnot(is.na(ii))
+tools::assertWarning(ii <- 1980000020L - (-222000000L))
+stopifnot(is.na(ii))
+## first two failed for some version of clang in R < 3.1.1
+
+
+## PR#15735: formulae with exactly 32 variables
+myFormula <- as.formula(paste(c("y ~ x0", paste0("x", 1:30)), collapse = "+"))
+ans <- update(myFormula, . ~ . - w1)
+stopifnot(identical(ans, myFormula))
+
+updateArgument <-
+    as.formula(paste(c(". ~ . ", paste0("w", 1:30)), collapse = " - "))
+ans2 <- update(myFormula, updateArgument)
+stopifnot(identical(ans2, myFormula))
+
+
+## PR#15753
+0x110p-5L # (+ warning)
+stopifnot(.Last.value == 8.5)
+## was 272 with a garbled message in R 3.0.0 - 3.1.0.
+
+
+## numericDeriv failed to duplicate variables in
+## the expression before modifying them.  PR#15849
+x <- 10; y <- 10
+d1 <- numericDeriv(quote(x+y),c("x","y"))
+x <- y <- 10
+d2 <- numericDeriv(quote(x+y),c("x","y"))
+stopifnot(identical(d1,d2))
+## The second gave the wrong answer
+
+
+## prettyNum(x, zero.print = .) failed when x had NAs
+pp <- sapply(list(TRUE, FALSE, ".", " "), function(.)
+	     prettyNum(c(0:1,NA), zero.print = . ))
+stopifnot(identical(pp[1,], c("0", " ", ".", " ")),
+	  pp[2:3,] == c("1","NA"))
+## all 4 prettyNum() would error out
+
+
+## checking all.equal() with externalptr
+library(methods) # getClass()'s versionKey is an e.ptr
+cA <- getClass("ANY")
+stopifnot(all.equal(cA, cA),
+          is.character(all.equal(cA, getClass("S4"))))
+# both all.equal() failed in R <= 3.1.1
+
+
+## as.hexmode(x), as.octmode(x)  when x is double
+x <- c(NA, 1)
+stopifnot(identical(x == x,
+		    as.hexmode(x) == as.octmode(x)))
+p <- c(1, pi)
+tools::assertError(as.hexmode(p))
+tools::assertError(as.octmode(p))
+## where all "wrong" in R <= 3.1.1
+
+
+## PR#15935
+y <- 1:3
+drop1(lm(y ~ 1))
+drop1(glm(y ~ 1))
+stats:::drop1.default(glm(y ~ 1))
+## gave error in R < 3.1.2
+
+## getAnywhere() wrongly dealing with namespace hidden list object
+nm <- deparse(body(pbinom)[[2]])# == "C_pbinom" currently
+gg <- getAnywhere(nm)
+stopifnot(length(gg$objs) == 1)
+## was 4 and printed "4 differing objects matching ‘C_pbinom’ ..." in R <= 3.1.1
+
+
+## 0-length consistency of options(), PR#15979
+stopifnot(identical(options(list()), options(NULL)))
+## options(list()) failed in R <= 3.1.1
+
+
+## merge.dendrogram(), PR#15648
+mkDend <- function(n, lab, method = "complete",
+                   ## gives *ties* often:
+		   rGen = function(n) 1+round(16*abs(rnorm(n)))) {
+    stopifnot(is.numeric(n), length(n) == 1, n >= 1, is.character(lab))
+    a <- matrix(rGen(n*n), n, n)
+    colnames(a) <- rownames(a) <- paste0(lab, 1:n)
+    .HC. <<- hclust(as.dist(a + t(a)), method=method)
+    as.dendrogram(.HC.)
+}
+set.seed(7)
+da <- mkDend(4, "A")
+db <- mkDend(3, "B")
+d.ab <- merge(da, db)
+hcab <- as.hclust(d.ab)
+stopifnot(hcab$order == c(2, 4, 1, 3, 7, 5, 6),
+	  hcab$labels == c(paste0("A", 1:4), paste0("B", 1:3)))
+## was wrong in R <= 3.1.1
+set.seed(1) ; h1 <- as.hclust(mkDend(5, "S", method="single")); hc1 <- .HC.
+set.seed(5) ; h5 <- as.hclust(mkDend(5, "S", method="single")); hc5 <- .HC.
+set.seed(42); h3 <- as.hclust(mkDend(5, "A", method="single")); hc3 <- .HC.
+## all failed (differently!) because of ties in R <= 3.2.3
+stopifnot(all.equal(h1[1:4], hc1[1:4], tol = 1e-12),
+	  all.equal(h5[1:4], hc5[1:4], tol = 1e-12),
+	  all.equal(h3[1:4], hc3[1:4], tol = 1e-12))
+
+
+## bw.SJ() and similar with NA,Inf values, PR#16024
+try(bw.SJ (c(NA,2,3)))
+try(bw.bcv(c(-Inf,2,3)))
+try(bw.ucv(c(1,NaN,3,4)))
+## seg.faulted  in  3.0.0 <= R <= 3.1.1
+
+
+## as.dendrogram() with wrong input
+x <- rbind(c( -6, -9), c(  0, 13),
+	   c(-15,  6), c(-14,  0), c(12,-10))
+dx <- dist(x,"manhattan")
+hx <- hclust(dx)
+hx$merge <- matrix(c(-3, 1, -2, 3,
+                     -4, -5, 2, 3), 4,2)
+tools::assertError(as.dendrogram(hx))
+## 8 member dendrogram and memory explosion for larger examples in R <= 3.1.2
+
+
+## abs with named args failed, PR#16047
+abs(x=1i)
+## Complained that the arg should be named z
+
+
+## Big exponents overflowed, PR#15976
+x <- 0E4933
+y <- 0x0p100000
+stopifnot(x == 0, y == 0)
+##
+
+
+## drop.terms() dropped some attributes, PR#16029
+test <- model.frame(Employed ~ Year + poly(GNP,3) + Population, data=longley)
+mterm <- terms(test)
+mterm2 <- drop.terms(mterm, 3)
+predvars <- attr(mterm2, "predvars")
+dataClasses <- attr(mterm2, "dataClasses")
+factors <- attr(mterm2, "factors")
+stopifnot(is.language(predvars), length(predvars) == length(dataClasses)+1,
+          all(names(dataClasses) == rownames(factors)))
+## Previously dropped predvars and dataClasses
+
+
+## prompt() did not escape percent signs properly
+fn <- function(fmt = "%s") {}
+f <- tempfile(fileext = ".Rd")
+prompt(fn, filename = f)
+rd <- tools::parse_Rd(f)
+## Gave syntax errors because the percent sign in Usage
+## was taken as the start of a comment.
+
+## pass no arguments to 0-parameter macro
+cat("\\newcommand{\\mac0}{MAC0}\\mac0", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), "MAC0\n"))
+
+## pass empty argument to a 1-parameter macro (failed in 3.5.0 and earlier)
+cat("\\newcommand{\\mac1}{MAC1:#1}\\mac1{}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), "MAC1:\n"))
+
+## pass empty argument to a 2-parameter macro (failed in 3.5.0 and earlier)
+cat("\\newcommand{\\mac2}{MAC2:#2}\\mac2{}{XX}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), "MAC2:XX\n"))
+
+cat("\\newcommand{\\mac2}{MAC2:#2#1}\\mac2{YY}{}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), "MAC2:YY\n"))
+
+## pass multi-line argument to a user macro (failed in 3.5.0 and earlier)
+cat("\\newcommand{\\mac1}{MAC1:#1}\\mac1{XXX\nYYY}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), c("MAC1:XXX\n","YYY\n")))
+
+## comments are removed from macro arguments (not in 3.5.0 and earlier)
+cat("\\newcommand{\\mac1}{MAC1:#1}\\mac1{XXX%com\n}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), c("MAC1:XXX\n","\n")))
+
+cat("\\newcommand{\\mac1}{MAC1:#1}\\mac1{XXX%com\nYYY}", file=f)
+rd <- tools::parse_Rd(f)
+stopifnot(identical(as.character(rd), c("MAC1:XXX\n","YYY\n")))
+
+## power.t.test() failure for very large n (etc): PR#15792
+(ptt <- power.t.test(delta = 1e-4, sd = .35, power = .8))
+(ppt <- power.prop.test(p1 = .5, p2 = .501, sig.level=.001, power=0.90, tol=1e-8))
+stopifnot(all.equal(ptt$n, 192297000, tol = 1e-5),
+          all.equal(ppt$n,  10451937, tol = 1e-7))
+## call to uniroot() did not allow n > 1e7
+
+
+## save(*, ascii=TRUE):  PR#16137
+x0 <- x <- c(1, NA, NaN)
+save(x, file=(sf <- tempfile()), ascii = TRUE)
+load(sf)
+stopifnot(identical(x0, x))
+## x had 'NA' instead of 'NaN'
+
+
+## PR#16205
+stopifnot(length(glob2rx(character())) == 0L)
+## was "^$" in R < 3.1.3
+
+
+### Bugs fixed in R 3.2.0
+
+## Bugs reported by Radford Neal
+x <- pairlist(list(1, 2))
+x[[c(1, 2)]] <- NULL   # wrongly gave an error, referring to misuse
+                       # of the internal SET_VECTOR_ELT procedure
+stopifnot(identical(x, pairlist(list(1))))
+
+a <- pairlist(10, 20, 30, 40, 50, 60)
+dim(a) <- c(2, 3)
+dimnames(a) <- list(c("a", "b"), c("x", "y", "z"))
+# print(a)              # doesn't print names, not fixed
+a[["a", "x"]] <- 0
+stopifnot(a[["a", "x"]] == 0)
+## First gave a spurious error, second caused a seg.fault
+
+
+## Radford (R-devel, June 24, 2014); M.Maechler
+m <- matrix(1:2, 1,2); v <- 1:3
+stopifnot(identical(crossprod(2, v), t(2) %*% v),
+	  identical(crossprod(m, v), t(m) %*% v),
+	  identical(5 %*% v, 5 %*% t(v)),
+          identical(tcrossprod(m, 1:2), m %*% 1:2) )
+## gave error "non-conformable arguments" in R <= 3.2.0
+proc.time() - .pt; .pt <- proc.time()
+
+
+## list <--> environment
+L0 <- list()
+stopifnot(identical(L0, as.list(as.environment(L0))))
+## as.env..() did not work, and as.list(..) gave non-NULL names in R 3.1.x
+
+
+### all.equal() refClass()es check moved to methods package
+
+
+## missing() did not propagate through '...', PR#15707
+check <- function(x,y,z) c(missing(x), missing(y), missing(z))
+check1 <- function(...) check(...)
+check2 <- function(...) check1(...)
+stopifnot(identical(check2(one, , three), c(FALSE, TRUE, FALSE)))
+## missing() was unable to handle recursive promises
+
+
+### envRefClass check moved to methods package
+
+### This is an error in R 4.2.0
+## takes too long with JIT enabled:
+## .jit.lev <- compiler::enableJIT(0)
+## Sys.getenv("_R_CHECK_LENGTH_1_CONDITION_") -> oldV
+## Sys.setenv("_R_CHECK_LENGTH_1_CONDITION_" = "false") # only *warn*
+## ## while did not protect its argument, which caused an error
+## ## under gctorture, PR#15990
+## gctorture()
+## suppressWarnings(while(c(FALSE, TRUE)) 1)
+## gctorture(FALSE)
+## ## gave an error because the test got released when the warning was generated.
+## compiler::enableJIT(.jit.lev)# revert
+## Sys.setenv("_R_CHECK_LENGTH_1_CONDITION_" = oldV)
+
+
+## hist(x, breaks =) with too large bins, PR#15988
+set.seed(5); x <- runif(99)
+Hist <- function(x, b) hist(x, breaks = b, plot = FALSE)$counts
+for(k in 1:5) {
+    b0 <- seq_len(k-1)/k
+    H.ok <- Hist(x, c(-10, b0, 10))
+    for(In in c(1000, 1e9, Inf))
+	stopifnot(identical(Hist(x, c(-In, b0, In)), H.ok),
+		  identical(Hist(x, c( 0,  b0, In)), H.ok))
+}
+## "wrong" results for k in {2,3,4} in R 3.1.x
+
+
+## eigen(*, symmetric = <default>) with asymmetric dimnames,  PR#16151
+m <- matrix(c(83,41), 5, 4,
+	    dimnames=list(paste0("R",1:5), paste0("C",1:4)))[-5,] + 3*diag(4)
+stopifnot( all.equal(eigen(m, only.values=TRUE) $ values,
+		     c(251, 87, 3, 3), tol=1e-14) )
+## failed, using symmetric=FALSE and complex because of the asymmetric dimnames()
+
+
+## match.call() re-matching '...'
+test <- function(x, ...) test2(x, 2, ...)
+test2 <- function(x, ...) match.call(test2, sys.call())
+stopifnot(identical(test(1, 3), quote(test2(x=x, 2, 3))))
+## wrongly gave test2(x=x, 2, 2, 3) in R <= 3.1.2
+
+
+## callGeneric not forwarding dots in call (PR#16141)
+setGeneric("foo", function(x, ...) standardGeneric("foo"))
+setMethod("foo", "character",
+          function(x, capitalize = FALSE) if (capitalize) toupper(x) else x)
+setMethod("foo", "factor",
+          function(x, capitalize = FALSE) { x <- as.character(x);  callGeneric() })
+toto1 <- function(x, ...) foo(x, ...)
+stopifnot(identical(toto1(factor("a"), capitalize = TRUE), "A"))
+## wrongly did not capitalize in R <= 3.1.2
+
+
+## Accessing non existing objects must be an error
+tools::assertError(base :: foobar)
+tools::assertError(base :::foobar)
+tools::assertError(stats:::foobar)
+tools::assertError(stats:: foobar)
+## lazy data only via '::', not ':::' :
+stopifnot(    nrow(datasets:: swiss) == 47)
+tools::assertError(datasets:::swiss)
+## The ::: versions gave NULL in certain development versions of R
+stopifnot(identical(stats4::show -> s4s,
+		    get("show", asNamespace("stats4") -> ns4)),
+	  s4s@package == "methods",
+	  is.null(ns4[["show"]]) # not directly in stats4 ns
+	  )
+## stats4::show was NULL for 4 hours in R-devel
+
+
+## mode<- did too much evaluation (PR#16215)
+x <- y <- quote(-2^2)
+x <- as.list(x)
+mode(y) <- "list"
+stopifnot(identical(x, y))
+## y ended up containing -4, not -2^2
+
+
+## besselJ()/besselY() with too large order
+besselJ(1, 2^64) ## NaN with a warning
+besselY(1, c(2^(60:70), Inf))
+## seg.faulted in R <= 3.1.2
+
+
+## besselJ()/besselY() with  nu = k + 1/2; k in {-1,-2,..}
+besselJ(1, -1750.5) ## Inf, with only one warning...
+stopifnot(is.finite(besselY(1, .5 - (1500 + 0:10))))
+## last gave NaNs; both: more warnings in R <= 3.1.x
+
+
+## BIC() for arima(), also with NA's
+lho <- lh; lho[c(3,7,13,17)] <- NA
+alh300 <- arima(lh,  order = c(3,0,0))
+alh311 <- arima(lh,  order = c(3,1,1))
+ao300  <- arima(lho, order = c(3,0,0))
+ao301  <- arima(lho, order = c(3,0,1))
+## AIC/BIC for *different* data rarely makes sense ... want warning:
+tools::assertWarning(AA <- AIC(alh300,alh311, ao300,ao301))
+tools::assertWarning(BB <- BIC(alh300,alh311, ao300,ao301))
+fmLst <- list(alh300,alh311, ao300,ao301)
+## nobs() did not "work" in R < 3.2.0:
+stopifnot(sapply(fmLst, nobs) == c(48,47, 44,44))
+lls <- lapply(fmLst, logLik)
+str(lapply(lls, unclass))# -> 'df' and 'nobs'
+## 'manual BIC' via generalized AIC:
+stopifnot(all.equal(BB[,"BIC"],
+                    sapply(fmLst, function(fm) AIC(fm, k = log(nobs(fm))))))
+## BIC() was NA unnecessarily in  R < 3.2.0; nobs() was not available eiher
+
+
+## as.integer() close and beyond maximal integer
+MI <- .Machine$integer.max
+stopifnot(identical( MI, as.integer( MI + 0.99)),
+	  identical(-MI, as.integer(-MI - 0.99)),
+	  is.na(as.integer(as.character( 100*MI))),
+	  is.na(as.integer(as.character(-100*MI))))
+## The two cases with positive numbers  failed in R <= 3.2.0
+
+
+## Ensure that sort() works with a numeric vector "which is an object":
+stopifnot(is.object(y <- freeny$y))
+stopifnot(diff(sort(y)) > 0)
+## order() and hence sort() failed here badly for a while around 2015-04-16
+
+
+## NAs in data frame names (but *not* in row.names; that's really wrong):
+dn <- list(c("r1", "r2"), c("V", NA))
+d11 <- as.data.frame(matrix(c(1, 1, 1, 1), ncol = 2, dimnames = dn))
+stopifnot(identical(names(d11), dn[[2]]),
+          identical(row.names(d11), dn[[1]]))
+## as.data.frame() failed in R-devel for a couple of hours ..
+
+
+## Ensure  R -e ..  works on Unix
+if(.Platform$OS.type == "unix" &&
+   file.exists(Rc <- file.path(R.home("bin"), "R")) &&
+   file.access(Rc, mode = 1) == 0) { # 1: executable
+    cmd <- paste(Rc, "-q --vanilla -e 1:3")
+    ans <- system(cmd, intern=TRUE)
+    stopifnot(length(ans) >= 3,
+	      identical(ans[1:2], c("> 1:3",
+				    "[1] 1 2 3")))
+}
+## (failed for < 1 hr, in R-devel only)
+proc.time() - .pt; .pt <- proc.time()
+
+
+## Parsing large exponents of floating point numbers, PR#16358
+set.seed(12)
+lrg <- sprintf("%.0f", round(exp(10*(2+abs(rnorm(2^10))))))
+head(huge <- paste0("1e", lrg))
+    micro <- paste0("1e-", lrg)
+stopifnot(as.numeric(huge) == Inf,
+          as.numeric(micro) == 0)
+## Both failed in R <= 3.2.0
+
+
+## vcov() failed on manova() results, PR#16380
+tear <- c(6.5, 6.2, 5.8, 6.5, 6.5, 6.9, 7.2, 6.9, 6.1, 6.3, 6.7, 6.6, 7.2, 7.1, 6.8, 7.1, 7.0, 7.2, 7.5, 7.6)
+gloss <- c(9.5, 9.9, 9.6, 9.6, 9.2, 9.1, 10.0, 9.9, 9.5, 9.4, 9.1, 9.3, 8.3, 8.4, 8.5, 9.2, 8.8, 9.7, 10.1, 9.2)
+opacity <- c(4.4, 6.4, 3.0, 4.1, 0.8, 5.7, 2.0, 3.9, 1.9, 5.7, 2.8, 4.1, 3.8,1.6, 3.4, 8.4, 5.2, 6.9, 2.7, 1.9)
+Y <- cbind(tear, gloss, opacity)
+rate <- factor(gl(2,10), labels = c("Low", "High"))
+fit <- manova(Y ~ rate)
+vcov(fit)
+## Gave error because coef.aov() turned matrix of coefficients into a vector
+
+
+## Unary / Binary uses of logic operations, PR#16385
+tools::assertError(`&`(FALSE))
+tools::assertError(`|`(TRUE))
+## Did not give errors in R <= 3.2.0
+E <- tryCatch(`!`(), error = function(e)e)
+stopifnot(grepl("0 argument.*\\<1", conditionMessage(E)))
+##            PR#17456 :   ^^ a version that also matches in a --disable-nls configuration
+## Gave wrong error message in R <= 3.2.0
+stopifnot(identical(!matrix(TRUE), matrix(FALSE)),
+	  identical(!matrix(FALSE), matrix(TRUE)))
+## was wrong for while in R 3.2.0 patched
+
+
+## cummax(<integer>)
+iNA <- NA_integer_
+x <- c(iNA, 1L)
+stopifnot(identical(cummin(x), c(iNA, iNA)),
+          identical(cummax(x), c(iNA, iNA)))
+## an initial NA was not propagated in R <= 3.2.0
+
+
+## summaryRprof failed for very short profile, PR#16395
+profile <- tempfile()
+writeLines(c(
+'memory profiling: sample.interval=20000',
+':145341:345360:13726384:0:"stdout"',
+':208272:345360:19600000:0:"stdout"'), profile)
+summaryRprof(filename = profile, memory = "both")
+unlink(profile)
+## failed when a matrix was downgraded to a vector
+
+
+## option(OutDec = *)  -- now gives a warning when  not 1 character
+op <- options(OutDec = ".", digits = 7, # <- default
+              warn = 2)# <- (unexpected) warnings become errors
+stopifnot(identical("3.141593", fpi <- format(pi)))
+options(OutDec = ",")
+stopifnot(identical("3,141593", cpi <- format(pi)))
+## warnings, but it "works" (for now):
+tools::assertWarning(options(OutDec = ".1."))
+stopifnot(identical("3.1.141593", format(pi)))
+tools::assertWarning(options(OutDec = ""))
+tools::assertWarning(stopifnot(identical("3141593", format(pi))))
+options(op)# back to sanity
+## No warnings in R versions <= 3.2.1
+
+
+## format(*, decimal.mark=".")  when   OutDec != "."  (PR#16411)
+op <- options(OutDec = ",")
+stopifnot(identical(fpi, format(pi, decimal.mark=".")))
+options(op)
+## failed in R <= 3.2.1
+
+
+## model.frame() removed ts attributes on original data (PR#16436)
+orig <- class(EuStockMarkets)
+mf <- model.frame(EuStockMarkets ~ 1, na.action=na.fail)
+stopifnot(identical(orig, class(EuStockMarkets)))
+## ts class lost in R <= 3.2.1
+
+
+##
+foo <- as.expression(1:3)
+matrix(foo, 3, 3) # always worked
+matrix(foo, 3, 3, byrow = TRUE)
+## failed in R <= 3.1.2
+
+
+## labels.dendrogram(), dendrapply(), etc -- see comment #15 of PR#15215 :
+(D <- as.dendrogram(hclust(dist(cbind(setNames(c(0,1,4), LETTERS[1:3]))))))
+stopifnot(
+    identical(labels(D), c("C", "A", "B")),
+    ## has been used in "CRAN package space"
+    identical(suppressWarnings(dendrapply(D, labels)),
+              list("C", list("A", "B"), "C")))
+## dendrapply(D, labels) failed in R-devel for a day or two
+
+
+## poly() / polym() predict()ion
+library(datasets)
+alm <- lm(stack.loss ~ poly(Air.Flow, Water.Temp, degree=3), stackloss)
+f20 <- fitted(alm)[1:20] # "correct" prediction values [1:20]
+stopifnot(all.equal(unname(f20[1:4]), c(39.7703378, 39.7703378, 35.8251359, 21.5661761)),
+	  all.equal(f20, predict(alm, stackloss) [1:20] , tolerance = 1e-14),
+	  all.equal(f20, predict(alm, stackloss[1:20, ]), tolerance = 1e-14))
+## the second prediction went off in  R <= 3.2.1
+
+
+## PR#16478
+kkk <- c("a\tb", "3.14\tx")
+z1 <- read.table(textConnection(kkk), sep = "\t", header = TRUE,
+                 colClasses = c("numeric", "character"))
+z2 <- read.table(textConnection(kkk), sep = "\t", header = TRUE,
+                 colClasses = c(b = "character", a = "numeric"))
+stopifnot(identical(z1, z2))
+z3 <- read.table(textConnection(kkk), sep = "\t", header = TRUE,
+                 colClasses = c(b = "character"))
+stopifnot(identical(z1, z3))
+z4 <- read.table(textConnection(kkk), sep = "\t", header = TRUE,
+                 colClasses = c(c = "integer", b = "character", a = "numeric"))
+stopifnot(identical(z1, z4))
+## z2 and z4 used positional matching (and failed) in R < 3.3.0.
+
+
+## PR#16484
+z <- regexpr("(.)", NA_character_, perl = TRUE)
+stopifnot(is.na(attr(z, "capture.start")), is.na(attr(z, "capture.length")))
+## Result was random integers in R <= 3.2.2.
+
+
+## PR#14861
+if(.Platform$OS.type == "unix") { # no 'ls /'  on Windows
+    con <- pipe("ls /", open = "rt")
+    data <- readLines(con)
+    z <- close(con)
+    print(z)
+    stopifnot(identical(z, 0L))
+}
+## was NULL in R <= 3.2.2
+
+
+## Sam Steingold:  compiler::enableJIT(3) not working in ~/.Rprofile anymore
+stopifnot(identical(topenv(baseenv()),
+                    baseenv()))
+## accidentally globalenv in R 3.2.[12] only
+
+
+## widths of unknown Unicode characters
+stopifnot(nchar("\u200b", "w") == 0)
+## was -1 in R 3.2.2
+
+
+## abbreviate dropped names in some cases
+x <- c("AA", "AB", "AA", "CBA") # also test handling of duplicates
+for(m in 2:0) {
+    print(y <- abbreviate(x, m))
+    stopifnot(identical(names(y), x))
+}
+## dropped for 0 in R <= 3.2.2
+
+
+## match(<NA>, <NA>)
+stopifnot(
+    isTRUE(NA          %in% c(NA, TRUE)),
+    isTRUE(NA_integer_ %in% c(TRUE, NA)),
+    isTRUE(NA_real_    %in% c(NA, FALSE)),# !
+    isTRUE(!(NaN       %in% c(NA, FALSE))),
+    isTRUE(NA          %in% c(3L, NA)),
+    isTRUE(NA_integer_ %in% c(NA, 3L)),
+    isTRUE(NA_real_    %in% c(3L, NA)),# !
+    isTRUE(!(NaN       %in% c(3L, NA))),
+    isTRUE(NA          %in% c(2., NA)),# !
+    isTRUE(NA_integer_ %in% c(NA, 2.)),# !
+    isTRUE(NA_real_    %in% c(2., NA)),# !
+    isTRUE(!(NaN       %in% c(2., NA))))
+## the "!" gave FALSE in R-devel (around 20.Sep.2015)
+
+
+## oversight in  within.data.frame()  [R-help, Sep 20 2015 14:23 -04]
+df <- data.frame(.id = 1:3 %% 3 == 2, a = 1:3)
+d2 <- within(df, {d = a + 2})
+stopifnot(identical(names(d2), c(".id", "a", "d")))
+## lost the '.id' column in R <= 3.2.2
+proc.time() - .pt; .pt <- proc.time()
+
+## system() truncating and splitting long lines of output, PR#16544
+## only works when platform has getline() in stdio.h, and Solaris does not.
+known.POSIX_2008 <- .Platform$OS.type == "unix" &&
+     (Sys.info()[["sysname"]] != "SunOS")
+## ^^^ explicitly exclude *non*-working platforms above
+if(known.POSIX_2008) {
+    cat("testing system(\"echo\", <large>) : "); op <- options(warn = 2)# no warnings allowed
+    cn <- paste(1:2222, collapse=" ")
+    rs <- system(paste("echo", cn), intern=TRUE)
+    stopifnot(identical(rs, cn))
+    cat("[Ok]\n"); options(op)
+}
+
+
+## tail.matrix()
+B <- 100001; op <- options(max.print = B + 99)
+mat.l <- list(m0  = matrix(, 0,2),
+              m0n = matrix(, 0,2, dimnames = list(NULL, paste0("c",1:2))),
+              m2  = matrix(1:2,   2,1),
+              m2n = matrix(1:2,   2,3, dimnames = list(NULL, paste0("c",1:3))),
+              m9n = matrix(1:9,   9,1, dimnames = list(paste0("r",1:9),"CC")),
+              m12 = matrix(1:12, 12,1),
+              mBB = matrix(1:B, B, 1))
+## tail() used to fail for 0-rows matrices m0*
+n.s <- -3:3
+hl <- lapply(mat.l, function(M) lapply(n.s, function(n) head(M, n)))
+tl <- lapply(mat.l, function(M) lapply(n.s, function(n) tail(M, n)))
+## Check dimensions of resulting matrices --------------
+## ncol:
+Mnc <- do.call(rbind, rep(list(vapply(mat.l, ncol, 1L)), length(n.s)))
+stopifnot(identical(Mnc, sapply(hl, function(L) vapply(L, ncol, 1L))),
+          identical(Mnc, sapply(tl, function(L) vapply(L, ncol, 1L))))
+## nrow:
+fNR <- function(L) vapply(L, nrow, 1L)
+tR <- sapply(tl, fNR)
+stopifnot(identical(tR, sapply(hl, fNR)), # head() & tail  both
+          tR[match(0, n.s),] == 0, ## tail(*,0) has always 0 rows
+          identical(tR, outer(n.s, fNR(mat.l), function(x,y)
+              ifelse(x < 0, pmax(0L, y+x), pmin(y,x)))))
+for(j in c("m0", "m0n")) { ## 0-row matrices: tail() and head() look like identity
+    co <- capture.output(mat.l[[j]])
+    stopifnot(vapply(hl[[j]], function(.) identical(co, capture.output(.)), NA),
+              vapply(tl[[j]], function(.) identical(co, capture.output(.)), NA))
+}
+
+CO1 <- function(.) capture.output(.)[-1] # drop the printed column names
+## checking tail(.) rownames formatting
+nP <- n.s > 0
+for(nm in c("m9n", "m12", "mBB")) { ## rownames: rather [100000,] than [1e5,]
+    tf <- file(); capture.output(mat.l[[nm]], file=tf)
+    co <- readLines(tf); close(tf)
+    stopifnot(identical(# tail(.) of full output == output of tail(.) :
+        lapply(n.s[nP], function(n) tail(co, n)),
+        lapply(tl[[nm]][nP], CO1)))
+}
+
+identCO <- function(x,y, ...) identical(capture.output(x), capture.output(y), ...)
+headI <- function(M, n) M[head(seq_len(nrow(M)), n), , drop=FALSE]
+tailI <- function(M, n) M[tail(seq_len(nrow(M)), n), , drop=FALSE]
+for(mat in mat.l) {
+    ## do not capture.output for  tail(<large>, <small negative>)
+    n.set <- if(nrow(mat) < 999) -3:3 else 0:3
+    stopifnot(
+        vapply(n.set, function(n) identCO (head(mat, n), headI(mat, n)), NA),
+        vapply(n.set, function(n) identCO (tail (mat, n, keepnums=FALSE),
+                                           tailI(mat, n)), NA),
+        vapply(n.set, function(n) all.equal(tail(mat, n), tailI(mat, n),
+                                            check.attributes=FALSE), NA))
+}
+options(op)
+## end{tail.matrix check} ------------------
+
+## format.data.frame() & as.data.frame.list() - PR#16580
+myL <- list(x=1:20, y=rnorm(20), stringsAsFactors = gl(4,5))
+names(myL)[1:2] <- lapply(1:2, function(i)
+    paste(sample(letters, 300, replace=TRUE), collapse=""))
+nD  <- names(myD  <- as.data.frame(myL))
+nD2 <- names(myD2 <- as.data.frame(myL, cut.names = 280))
+nD3 <- names(myD3 <- as.data.frame(myL, cut.names = TRUE))
+stopifnot(nchar(nD) == c(300,300,16), is.data.frame(myD),  dim(myD)  == c(20,3),
+	  nchar(nD2)== c(278,278,16), is.data.frame(myD2), dim(myD2) == c(20,3),
+	  nchar(nD3)== c(254,254,16), is.data.frame(myD3), dim(myD3) == c(20,3),
+	  identical(nD[3], "stringsAsFactors"),
+	  identical(nD[3], nD2[3]), identical(nD[3], nD3[3]))
+
+names(myD)[1:2] <- c("Variable.1", "")# 2nd col.name is "empty"
+## A data frame with a column that is an empty data frame:
+d20 <- structure(list(type = c("F", "G"), properties = data.frame(i=1:2)[,-1]),
+                 class = "data.frame", row.names = c(NA, -2L))
+stopifnot(is.data.frame(d20), dim(d20) == c(2,2),
+	  identical(colnames(d20), c("type", "properties")),
+	  identical(capture.output(d20), c("  type", "1    F", "2    G")))
+## format(d20) failed in intermediate R versions
+stopifnot(identical(names(myD), names(format(head(myD)))),
+	  identical(names(myD), c("Variable.1", "", "stringsAsFactors")),
+	  identical(rbind.data.frame(2:1, 1:2), ## was wrong for some days
+		    data.frame(X2.1 = 2:1, X1.2 = 1:2)))
+## format.data.frame() did not show "stringsAsFactors" in R <= 3.2.2
+## Follow up: the new as.data.frame.list() must be careful with 'AsIs' columns:
+desc <- structure( c("a", NA, "z"), names = c("A", NA, "Z"))
+tools::assertError( data.frame(desc = desc, stringsAsFactors = FALSE) )
+## however
+dd <- data.frame(desc = structure(desc, class="AsIs"),
+                 row.names = c("A","M","Z"), stringsAsFactors = FALSE)
+## is "legal" (because "AsIs" can be 'almost anything')
+dd ## <- did not format nor print correctly in R-devel early Nov.2015
+fdesc <- structure(c("a", "NA", "z"), names=names(desc), class="AsIs")
+stopifnot(identical(format(dd),
+                    data.frame(desc = fdesc, row.names = c("A", "M", "Z"))),
+          identical(capture.output(dd),
+                    c("  desc", "A    a",
+		      "M <NA>", "Z    z")),
+	  identical(dd, data.frame(list(dd))))# lost row.names for a while
+
+
+## var(x) and hence sd(x)  with factor x, PR#16564
+tools::assertError(cov(1:6, f <- gl(2,3)))# was ok already
+tools::assertError(var(f))# these two give an error now (R >= 3.6.0)
+tools::assertError( sd(f))
+## var() "worked" in R <= 3.2.2  using the underlying integer codes
+proc.time() - .pt; .pt <- proc.time()
+
+
+## loess(*, .. weights) - PR#16587
+d.loess <-
+    do.call(expand.grid,
+            c(formals(loess.control)[1:3],
+              list(iterations = c(1, 10),
+                   KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE)))
+d.loess $ iterTrace <- (d.loess$ iterations > 1)
+## apply(d.loes, 1L, ...) would coerce everything to atomic, i.e, "character":
+loess.c.list <- lapply(1:nrow(d.loess), function(i)
+    do.call(loess.control, as.list(d.loess[i,])))
+set.seed(123)
+for(n in 1:6) { if(n %% 10 == 0) cat(n,"\n")
+    wt <- runif(nrow(cars))
+    for(ctrl in loess.c.list) {
+        cars.wt <- loess(dist ~ speed, data = cars, weights = wt,
+                         family = if(ctrl$iterations > 1) "symmetric" else "gaussian",
+                         control = ctrl)
+        cPr  <- predict(cars.wt)
+        cPrN <- predict(cars.wt, newdata=cars)
+        stopifnot(all.equal(cPr, cPrN, check.attributes = FALSE, tol=1e-14))
+    }
+}
+## gave (typically slightly) wrong predictions in R <= 3.2.2
+
+
+## aperm() for named dim()s:
+na <- list(A=LETTERS[1:2], B=letters[1:3], C=LETTERS[21:25], D=letters[11:17])
+da <- lengths(na)
+A <- array(1:210, dim=da, dimnames=na)
+aA <- aperm(A)
+a2 <- aperm(A, (pp <- c(3:1,4)))
+stopifnot(identical(     dim(aA), rev(da)),# including names(.)
+	  identical(dimnames(aA), rev(na)),
+	  identical(     dim(a2), da[pp]), # including names(.)
+	  identical(dimnames(a2), na[pp]))
+## dim(aperm(..)) did lose names() in R <= 3.2.2
+
+
+## poly() / predict(poly()) with NAs -- PR#16597
+fm <- lm(y ~ poly(x, 3), data=data.frame(x=1:7, y=sin(1:7)))
+x <- c(1,NA,3:7)
+stopifnot(all.equal(c(predict(fm, newdata=list(x = 1:3)), `4`=NA),
+		      predict(fm, newdata=list(x=c(1:3,NA))), tol=1e-15),
+	  all.equal(unclass(poly(x, degree=2, raw=TRUE)),
+		    cbind(x, x^2), check.attributes=FALSE))
+## both gave error about NA in R <= 3.2.2
+
+
+## data(package = *) on some platforms
+dd <- data(package="datasets")[["results"]]
+if(anyDuplicated(dd[,"Item"])) stop("data(package=*) has duplications")
+## sometimes returned the data sets *twice* in R <= 3.2.2
+
+
+## prettyNum(*, big.mark, decimal.mark)
+b.m <- c(".", ",", "'", "")
+d.m <- c(".", ",", ".,", "..")
+pa <- expand.grid(big.mark = b.m, decimal.mark = d.m,
+                  x = c(1005.24, 100.22, 1000000.33), scientific=FALSE, digits=9,
+                  stringsAsFactors=FALSE, KEEP.OUT.ATTRS=FALSE)
+r <- vapply(1:nrow(pa), function(i) do.call(prettyNum, pa[i,]), "")# with 6x2 warnings
+r
+b.m[b.m == ""] <- "0"
+## big.mark: only >= 1000; *and* because particular chosen numbers:
+r.2 <- substr(r[pa[,"x"] > 1000], 2, 2)
+## compute location of decimal point (which maybe more than one char)
+nd <- nchar(dm.s <- rep(d.m, each=length(b.m)))
+nr <- nchar(r) - 3 + (nd == 1)
+nr2 <- nr + (nd > 1)
+stopifnot(identical(r.2,               rep_len(b.m, length(r.2))),
+          identical(substr(r, nr,nr2), rep_len(dm.s, length(r))))
+## several cases (1, 5, 9, 10,..) were wrong in R 3.2.2
+
+
+## kmeans with just one center -- PR#16623
+set.seed(23)
+x <- rbind(matrix(rnorm(100,           sd = 0.3), ncol = 2),
+           matrix(rnorm(100, mean = 1, sd = 0.3), ncol = 2))
+k1 <- kmeans(x, 1)
+k2 <- kmeans(x, centers = k1$centers)
+stopifnot(all.equal(k1, k2), k1$cluster == 1)
+## the kmeans(*, centers=.) called failed in R <= 3.2.3
+
+
+## invalid dimnames for array()
+tools::assertError(array(1, 2:3, dimnames="foo"))
+## were silently disregarded in R <= 3.2.3
+
+
+## addmargins() - dimnames with (by default) "Sum"
+m <- rbind(1, 2:3)
+m2 <- addmargins(m, 2)
+am <- addmargins(m)
+stopifnot(
+    identical(dimnames(m2), list(NULL, c("", "", "Sum"))),
+    identical(am[,"Sum"], setNames(c(2, 5, 7), c("", "", "Sum"))))
+## the dimnames array() bug above hid the addmargins() not adding "Sum"
+
+
+## dim( x[,] ) -- should keep names(dim(.)) --
+## ---  ----
+##_ 1 D _
+A1 <- array(1:6, (d <- c(nam=6L)))
+stopifnot(identical(dim(A1), d),
+          identical(dim(A1), dim(A1[])))
+##_ 2 D _
+A2 <- A[1,2,,]
+stopifnot(identical(names(dim(A2)), c("C", "D")),
+          identical(dim(A2), dim(A)[-(1:2)]),
+          identical(dim(A2[ ]), dim(A2)),
+          identical(dim(A2[,]), dim(A2)),
+          identical(dim(A2[1, , drop=FALSE]), c(C = 1L, D = 7L)),
+          identical(dim(A2[, 1, drop=FALSE]), c(C = 5L, D = 1L)))
+##_ higher D_
+A3 <- A[1, ,,]
+stopifnot(
+    identical(dim(A ), dim(A [,,,])),# was already wrong: [,,,] losing names(dim(.))
+    identical(dim(A[,-1,-1,-1]), dim(A) - c(0:1,1L,1L)),
+    identical(dim(A3), dim(A)[-1]),
+    identical(dim(A3), dim(A3[,, ])),
+    identical(dim(A3[,1,]), c(B = 3L, D = 7L)))
+## all subsetting of arrays lost names(dim(.)) in R < 3.3.0
+
+
+## NextMethod() dispatch for  `$`  and  `$<-`
+`$.foo` <- function(x, fun) paste("foo:", NextMethod())
+x <- list(a = 1, b = 2)
+class(x) <- "foo"
+stopifnot(identical(x$b, "foo: 2"))  # 'x$b' failed prior to R 3.3.0
+
+`$<-.foo` <- function(x, value, fun) {
+    attr(x, "modified") <- "yes"
+    NextMethod()
+}
+x$y <- 10 ## failed prior to R 3.3.0
+stopifnot(identical(attr(x, "modified"), "yes"))
+
+
+## illegal 'row.names' for as.data.frame(): was just warning; error since R 4.3.0:
+tools::assertError(
+    d3 <- as.data.frame(1:3, row.names = letters[1:2])
+)
+## stopifnot(dim(d3) == c(3,1)) ## was (2, 1) in R <= 3.2.3
+## 'row.names' were not checked and produced a "corrupted" data frame in R <= 3.2.3
+
+
+## rbind.data.frame()'s  smart row names construction
+mk1 <- function(x) data.frame(x=x)
+d4 <- rbind(mk1(1:4)[3:4,,drop=FALSE], mk1(1:2))
+stopifnot(identical(dimnames(d4),
+                    list(c("3", "4", "1", "2"), "x")),
+## the rownames were       "3"  "4"  "31" "41"  in R <= 3.3.0
+          identical(attr(rbind(mk1(5:8), 7, mk1(6:3)), "row.names"), 1:9)
+          )
+
+## sort on integer() should drop NAs by default
+stopifnot(identical(1L, sort(c(NA, 1L))))
+## and other data types for method="radix"
+stopifnot(identical("a", sort(c(NA, "a"), method="radix")))
+stopifnot(identical(character(0L), sort(c(NA, NA_character_), method="radix")))
+stopifnot(identical(1, sort(c(NA, 1), method="radix")))
+
+
+## dummy.coef(.) in the case of "non-trivial terms" -- PR#16665
+op <- options(contrasts = c("contr.treatment", "contr.poly"))
+fm1 <- lm(Fertility ~ cut(Agriculture, breaks=4) + Infant.Mortality, data=swiss)
+(dc1 <- dummy.coef(fm1)) ## failed in R <= 3.3.0
+## (R-help, Alexandra Kuznetsova, 24 Oct 2013):
+set.seed(56)
+group <- gl(2, 10, 20, labels = c("Ctl","Trt"))
+weight <- c(rnorm(10, 4), rnorm(10, 5))
+x <- rnorm(20)
+lm9 <- lm(weight ~ group + x + I(x^2))
+dc9 <- dummy.coef(lm9)
+## failed in R <= 3.3.0
+stopifnot( # depends on contrasts:
+    all.equal(unname(coef(fm1)), unlist(dc1, use.names=FALSE)[-2], tol= 1e-14),
+    all.equal(unname(coef(lm9)), unlist(dc9, use.names=FALSE)[-2], tol= 1e-14))
+## a 'use.na=TRUE' example
+dd <- data.frame(x1 = rep(letters[1:2], each=3),
+                 x2 = rep(LETTERS[1:3], 2),
+                 y = rnorm(6),
+                 stringsAsFactors = TRUE)
+dd[6,2] <- "B" # => no (b,C) combination => that coef should be NA
+fm3 <- lm(y ~ x1*x2, dd)
+(d3F <- dummy.coef(fm3, use.na=FALSE))
+(d3T <- dummy.coef(fm3, use.na=TRUE))
+stopifnot(all.equal(d3F[-4], d3T[-4]),
+	  all.equal(d3F[[4]][-6], d3T[[4]][-6]),
+	  all.equal(drop(d3T$`x1:x2`),
+		    c("a:A"= 0, "b:A"= 0, "a:B"= 0,
+		      "b:B"= 0.4204843786, "a:C"=0, "b:C"=NA)))
+## in R <= 3.2.3, d3T$`x1:x2` was *all* NA
+##
+## dummy.coef() for "manova"
+## artificial data inspired by the  summary.manova  example
+rate <- gl(2,10, labels=c("Lo", "Hi"))
+additive <- gl(4, 1, length = 20, labels = paste("d", 1:4, sep="."))
+additive <- C(additive, "contr.sum")# => less trivial dummy.coef
+X <- model.matrix(~ rate*additive)
+E <- matrix(round(rnorm(20*3), 2), 20,3) %*% cbind(1, c(.5,-1,.5), -1:1)
+bet <- outer(1:8, c(tear = 2, gloss = 5, opacity = 20))
+Y <- X %*% bet + E
+
+fit <- manova(Y ~ rate * additive)
+## For consistency checking, one of the univariate models:
+flm <- lm(Y[,"tear"] ~ rate * additive)
+dclm <- lapply(dummy.coef(flm), drop); names(dclm[[1]]) <- "tear"
+
+op <- options(digits = 3, width = 88)
+(cf <- coef(fit))
+(dcf <- dummy.coef(fit))
+options(op)
+stopifnot(all.equal(coef(flm), cf[,"tear"]),
+          all.equal(dclm,
+                    lapply(dcf, function(cc)
+                        if(is.matrix(cc)) cc["tear",] else cc["tear"])),
+          identical(lengths(dcf),
+                    c("(Intercept)" = 3L, "rate" = 6L,
+                      "additive" = 12L, "rate:additive" = 24L)),
+          identical(sapply(dcf[-1], dim),
+                    cbind(rate = 3:2, additive = 3:4,
+                          `rate:additive` = c(3L, 8L))))
+## dummy.coef() were missing coefficients in R <= 3.2.3
+proc.time() - .pt; .pt <- proc.time()
+
+
+## format.POSIXlt() with modified 'zone' or length-2 format
+f0 <- "2016-01-28 01:23:45"; tz0 <- "Europe/Stockholm"
+d2 <- d1 <- rep(as.POSIXlt(f0, tz = tz0), 2)
+(f1 <- format(d1, usetz=TRUE))
+identical(f1, rep(paste(f0, "CET"), 2))# often TRUE (but too platform dependent)
+d2$zone <- d1$zone[1] # length 1 instead of 2
+f2 <- format(d2, usetz=TRUE)## -> segfault
+f1.2 <- format(as.POSIXlt("2016-01-28 01:23:45"), format=c("%d", "%y"))# segfault
+stopifnot(identical(f2, format(as.POSIXct(d2), usetz=TRUE)),# not yet in R <= 3.5.x
+	  identical(f1.2, c("28", "16")))
+tims <- seq.POSIXt(as.POSIXct("2016-01-01"),
+		   as.POSIXct("2017-11-11"), by = as.difftime(pi, units="weeks"))
+form <- c("%m/%d/%y %H:%M:%S", "", "%Y-%m-%d %H:%M:%S")
+op <- options(warn = 2)# no warnings allowed
+head(rf1 <- format(tims, form)) # recycling was wrong
+head(rf2 <- format(tims, form[c(2,1,3)]))
+stopifnot(identical(rf1[1:3], c("01/01/16 00:00:00", "2016-01-22 23:47:15",
+				"2016-02-13 23:34:30")),
+	  identical(rf2[1:3], c("2016-01-01 00:00:00", "01/22/16 23:47:15",
+				rf1[3])),
+	  nchar(rf1) == rep(c(17,19,19), length = length(rf1)),
+	  nchar(rf2) == rep(c(19,17,19), length = length(rf2)))
+options(op)
+## Wrong-length 'zone' or short 'x' segfaulted -- PR#16685
+## Default 'format' setting sometimes failed for length(format) > 1
+
+
+## saveRDS(*, compress= .)
+opts <- setNames(,c("bzip2", "xz", "gzip"))
+fil <- tempfile(paste0("xx", 1:6, "_"), fileext = ".rds")
+names(fil) <- c("default", opts, FALSE,TRUE)
+xx <- 1:11
+saveRDS(xx, fil["default"])
+saveRDS(xx, fil[opts[1]], compress = opts[1])
+saveRDS(xx, fil[opts[2]], compress = opts[2])
+saveRDS(xx, fil[opts[3]], compress = opts[3])
+saveRDS(xx, fil["FALSE"], compress = FALSE)
+saveRDS(xx, fil["TRUE" ], compress = TRUE)
+f.raw <- lapply(fil, readBin, what = "raw", n = 100)
+lengths(f.raw) # 'gzip' is best in this case
+for(i in 1:6) stopifnot(identical(xx, readRDS(fil[i])))
+eMsg <- tryCatch(saveRDS(xx, tempfile(), compress = "Gzip"),
+                 error = function(e) e$message)
+stopifnot(
+    grepl("'compress'.*Gzip", eMsg), # had ".. not interpretable as logical"
+    identical(f.raw[["default"]], f.raw[["TRUE"]]),
+    identical(f.raw[["default"]], f.raw[[opts["gzip"]]]))
+## compress = "gzip" failed (PR#16653), but compress = c(a = "xz") did too
+
+
+## recursive dendrogram methods and deeply nested dendrograms
+op <- options(expressions = 999)# , verbose = 2) # -> max. depth= 961
+set.seed(11); d <- mkDend(1500, "A", method="single")
+rd <- reorder(d, nobs(d):1)
+## Error: evaluation nested too deeply: infinite recursion .. in R <= 3.2.3
+stopifnot(is.leaf(r1 <- rd[[1]]),    is.leaf(r2 <- rd[[2:1]]),
+	  attr(r1, "label") == "A1458", attr(r2, "label") == "A1317")
+options(op)# revert
+
+
+## cor.test() with extremely small p values
+b <- 1:10; set.seed(1)
+for(n in 1:256) {
+    a <- round(jitter(b, f = 1/8), 3)
+    p1 <- cor.test(a, b)$ p.value
+    p2 <- cor.test(a,-b)$ p.value
+    stopifnot(abs(p1 - p2) < 8e-16 * (p1+p2))
+    ## on two different Linuxen, they actually are always equal
+}
+## were slightly off in R <= 3.2.3. PR#16704
+
+
+## smooth(*, do.ends=TRUE)
+y <- c(4,2,2,3,10,5:7,7:6)
+stopifnot(
+    identical(c(smooth(y, "3RSR" , do.ends=TRUE, endrule="copy")),
+              c(4, 2, 2, 3, 5, 6, 6, 7, 7, 6) -> sy.c),
+    identical(c(smooth(y, "3RSS" , do.ends=TRUE, endrule="copy")), sy.c),
+    identical(c(smooth(y, "3RS3R", do.ends=TRUE, endrule="copy")), sy.c),
+    identical(c(smooth(y, "3RSR" , do.ends=FALSE, endrule="copy")),
+              c(4, 4, 4, 4, 5, 6, 6, 6, 6, 6)),
+    identical(c(smooth(y, "3RSS" , do.ends=FALSE, endrule="copy")),
+              c(4, 4, 2, 3, 5, 6, 6, 6, 6, 6)),
+    identical(c(smooth(y, "3RS3R", do.ends=FALSE, endrule="copy")),
+              c(4, 4, 3, 3, 5, 6, 6, 6, 6, 6)))
+## do.ends=TRUE was not obeyed for the "3RS*" kinds, for 3.0.0 <= R <= 3.2.3
+proc.time() - .pt; .pt <- proc.time()
+
+
+## prettyDate() for subsecond ranges
+##' checking pretty():
+chkPretty <- function(x, n = 5, min.n = NULL, ..., max.D = 1) {
+    if(is.null(min.n)) {
+	## work with both pretty.default() and greDevices::prettyDate()
+	## *AND* these have a different default for 'min.n' we must be "extra smart":
+	min.n <-
+	    if(inherits(x, "Date") || inherits(x, "POSIXt"))
+		n %/% 2 # grDevices:::prettyDate
+	    else
+		n %/% 3 # pretty.default
+    }
+    pr <- pretty(x, n=n, min.n=min.n, ...)
+    ## if debugging: pr <- grDevices:::prettyDate(x, n=n, min.n=min.n, ...)
+    stopifnot(length(pr) >= (min.n+1),
+	      ## pretty(x, *) must cover range of x:
+	      min(pr) <= min(x), max(x) <= max(pr))
+    if((D <- abs(length(pr) - (n+1))) > max.D)
+	stop("| |pretty(.)| - (n+1) | = ", D, " > max.D = ", max.D)
+    ## is it equidistant [may need fuzz, i.e., signif(.) ?]:
+    eqD <- length(pr) == 1 || length(udp <- unique(dp <- diff(pr))) == 1
+    ## may well FALSE (differing number days in months; leap years, leap seconds)
+    if(!eqD) {
+        if(inherits(dp, "difftime") && units(dp) %in% c("days")# <- more ??
+           )
+            attr(pr, "chkPr") <- "not equidistant"
+        else
+            stop("non equidistant: has ", length(udp)," unique differences")
+    }
+    invisible(pr)
+}
+sTime <- structure(1455056860.75, class = c("POSIXct", "POSIXt"))
+for(n in c(1:16, 30:32, 41, 50, 60)) # (not for much larger n, (TODO ?))
+    chkPretty(sTime, n=n)
+set.seed(7)
+for(n in c(1:7, 12)) replicate(32, chkPretty(sTime + .001*rlnorm(1) * 0:9, n = n))
+## failed in R <= 3.2.3
+seqD  <- function(d1,d2) seq.Date(as.Date(d1), as.Date(d2), by = "1 day")
+seqDp <- function(d1,d2) { s <- seqD(d1,d2); structure(s, labels=format(s,"%b %d"), format="%b %d") }
+time2d <- function(i) sprintf("%02d", i %% 60)
+MTbd <- as.Date("1960-02-10")
+(p1   <- chkPretty(MTbd))
+stopifnot(
+    identical(p1, seqDp("1960-02-08", "1960-02-13")) ,
+    identical(attr(p1, "labels"), paste("Feb", time2d(8:13))),
+    identical(chkPretty(MTbd + rep(0,2)), p1) ,
+    identical(chkPretty(MTbd +  0:1), p1) ,
+    identical(chkPretty(MTbd + -1:1), p1) ,
+    identical(chkPretty(MTbd +  0:3), seqDp("1960-02-09", "1960-02-14")) )
+## all pretty() above gave length >= 5 answer (with duplicated values!) in R <= 3.2.3!
+## and length 1 or 2 instead of about 6 in R 3.2.4
+(p2 <- chkPretty(as.POSIXct("2002-02-02 02:02", tz = "GMT-1"), n = 5, min.n = 5))
+stopifnot(length(p2) >= 5+1,
+	  identical(p2, structure(1012611717 + (0:5), class = c("POSIXct", "POSIXt"),
+				  tzone = "GMT-1", labels = time2d(57 + (0:5)), format = "%S")))
+## failed in R 3.2.4
+(T3 <- structure(1460019857.25, class = c("POSIXct", "POSIXt")))# typical Sys.date()
+chkPretty(T3, 1) # error in svn 70438
+## "Data" from  example(pretty.Date) :
+steps <- setNames(,
+    c("10 secs", "1 min", "5 mins", "30 mins", "6 hours", "12 hours",
+      "1 DSTday", "2 weeks", "1 month", "6 months", "1 year",
+      "10 years", "50 years", "1000 years"))
+t02 <- as.POSIXct("2002-02-02 02:02")
+(at <- chkPretty(t02 + 0:1, n = 5, min.n = 3, max.D=2))
+xU <- as.POSIXct("2002-02-02 02:02", tz = "UTC")
+x5 <- as.POSIXct("2002-02-02 02:02", tz = "EST5EDT")
+atU <- chkPretty(seq(xU, by = "30 mins", length = 2), n = 5)
+at5 <- chkPretty(seq(x5, by = "30 mins", length = 2), n = 5)
+stopifnot(length(at) >= 4,
+	  identical(sort(names(aat <- attributes(at))), c("class", "format", "labels", "tzone")),
+	  identical(aat$labels, time2d(59+ 0:3)),
+          identical(x5 - xU, structure(5, units = "hours", class = "difftime")),
+          identical(attr(at5, "labels"), attr(atU, "labels") -> lat),
+          identical(lat, paste("02", time2d(10* 0:4), sep=":"))
+)
+nns <- c(1:9, 15:17); names(nns) <- paste0("n=",nns)
+prSeq <- function(x, n, st, ...) pretty(seq(x, by = st, length = 2), n = n, ...)
+pps <- lapply(nns, function(n)
+	      lapply(steps, function(st) prSeq(x=t02, n=n, st=st)))
+Ls.ok <- list(
+    `10 secs`  = c("00", "02", "04", "06", "08", "10"),
+    `1 min`    = sprintf("%02d", 10*((0:6) %% 6)),
+    `5 mins`   = sprintf("02:%02d", 2:7),
+    `30 mins`  = sprintf("02:%02d", (0:4)*10),
+    `6 hours`  = sprintf("%02d:00", 2:9),
+    `12 hours` = sprintf("%02d:00", (0:5)*3),
+    `1 DSTday` = c("Feb 02 00:00", "Feb 02 06:00", "Feb 02 12:00",
+		   "Feb 02 18:00", "Feb 03 00:00", "Feb 03 06:00"),
+    `2 weeks`  = c("Jan 28", "Feb 04", "Feb 11", "Feb 18"),
+    `1 month`  = c("Jan 28", "Feb 04", "Feb 11", "Feb 18", "Feb 25", "Mar 04"),
+    `6 months` = c("Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep"),
+    `1 year`   = c("Jan", "Apr", "Jul", "Oct", "Jan", "Apr"),
+    `10 years` = as.character(2000 +   2*(1:7)),
+    `50 years` = as.character(2000 +  10*(0:6)),
+    `1000 years`= as.character(2000 + 200*(0:6)))
+stopifnot(identical(Ls.ok,
+		    lapply(pps[["n=5"]], attr, "label")))
+##
+chkSeq <- function(st, x, n, max.D = if(n <= 4) 1 else if(n <= 10) 2 else 3, ...)
+    tryCatch(chkPretty(seq(x, by = st, length = 2), n = n, max.D=max.D, ...),
+             error = conditionMessage)
+prSeq.errs <- function(tt, nset, tSteps) {
+    stopifnot(length(tt) == 1)
+    c.ps <- lapply(nset, function(n) lapply(tSteps, chkSeq, x = tt, n = n))
+    ## ensure that all are ok *but* some which did not match 'n' well enough:
+    cc.ps <- unlist(c.ps, recursive=FALSE)
+    ok <- vapply(cc.ps, inherits, NA, what = "POSIXt")
+    errs <- unlist(cc.ps[!ok])
+    stopifnot(startsWith(errs, prefix = "| |pretty(.)| - (n+1) |"))
+    list(ok = ok,
+	 Ds = as.numeric(sub(".*\\| = ([0-9]+) > max.*", "\\1", errs)))
+}
+r.t02 <- prSeq.errs(t02, nset = nns, tSteps = steps)
+table(r.t02 $ ok)
+table(r.t02 $ Ds -> Ds)
+## Currently   [may improve]
+##  3  4  5  6  7  8
+##  4 14  6  3  2  1
+## ... and ensure we only improve:
+stopifnot(length(Ds) <= 30, max(Ds) <= 8, sum(Ds) <= 138)
+## A Daylight saving time -- halfmonth combo:
+(tOz <- structure(c(1456837200, 1460728800), class = c("POSIXct", "POSIXt"),
+		tzone = "Australia/Sydney"))
+(pz <- pretty(tOz)) # failed in R 3.3.0, PR#16923
+stopifnot(length(pz) <= 6, # is 5
+          attr(dpz <- diff(pz), "units") == "days", sd(dpz) < 1.6)
+if(FALSE) { # save 0.4 sec
+    print(system.time(
+        r.tOz <- prSeq.errs(tOz[1], nset = nns, tSteps = steps)
+    ))
+    stopifnot(sum(r.tOz $ ok) >= 132,
+              max(r.tOz $ Ds -> DOz) <= 8, mean(DOz) < 4.5)
+}
+nn <- c(1:33,10*(4:9),100*(1+unique(sort(rpois(20,4)))))
+pzn <- lengths(lapply(nn, pretty, x=tOz))
+stopifnot(0.5 <= min(pzn/(nn+1)), max(pzn/(nn+1)) <= 1.5)
+proc.time() - .pt; .pt <- proc.time()
+
+
+
+stopifnot(c("round.Date", "round.POSIXt") %in% as.character(methods(round)))
+## round.POSIXt suppressed in R <= 3.2.x
+
+
+## approxfun(*, method="constant")
+Fn <- ecdf(1:5)
+t <- c(NaN, NA, 1:5)
+stopifnot(all.equal(Fn(t), t/5))
+## In R <= 3.2.3,  NaN values resulted in something like (n-1)/n.
+
+
+## PR#16716: tar() default (i.e. "no files") behaviour and regular 'files'
+doit <- function(...) {
+    dir.create(td <- tempfile("tar-experi"))
+    setwd(td)
+    dfil <- "base_Desc"
+    file.copy(system.file("DESCRIPTION"), dfil)
+    ## tar w/o specified files (empty in R < 3.3.0)
+    tar("ex.tar", ... ) # all files, i.e. 'dfil'
+    unlink(dfil)
+    stopifnot(grepl(dfil, untar("ex.tar", list = TRUE)))
+    untar("ex.tar")
+    myF2 <- c(dfil, "ex.tar")
+    stopifnot(identical(list.files(), myF2))
+    ## tar with specified regular files (empty in R <= 4.0.2)
+    tar("ex2.tar", files = myF2, ...)
+    unlink(myF2)
+    stopifnot(identical(untar("ex2.tar", list = TRUE), myF2))
+    untar("ex2.tar")
+    stopifnot(identical(list.files(), c(myF2, "ex2.tar")))
+}
+doit()
+if(nzchar(Sys.getenv("tar"))) doit(tar = "internal")
+if(nzchar(Sys.which("tar"))) doit(tar = "tar")
+## internal tar silently ignored unused 'files' in R <= 4.0.2
+tools::assertWarning(verbose=TRUE,
+    tar(tempfile(fileext=".tar"), files = tempfile(), tar = "internal")
+)
+
+
+## format.POSIXlt() of Jan.1 if  1941 or '42 is involved:
+tJan1 <- function(n1, n2)
+    strptime(paste0(n1:n2,"/01/01"), "%Y/%m/%d", tz="CET")
+wDSTJan1 <- function(n1, n2)
+    which("CEST" == sub(".* ", '', format(tJan1(n1,n2), usetz=TRUE)))
+(w8 <- wDSTJan1(1801, 2300))
+(w9 <- wDSTJan1(1901, 2300))
+stopifnot(identical(w8, 141:142),# exactly 1941:1942 had CEST on Jan.1
+          identical(w9,  41: 42))
+## for R-devel Jan.2016 to Mar.14 -- *AND* for R 3.2.4 -- the above gave
+## integer(0)  and  c(41:42, 99:100, ..., 389:390)  respectively
+
+## the above gives 1:142 and 1:42 respectively on Solaris 10 when not using
+## --with-internal-tzcode; R-Admin recommends --with-internal-tzcode.
+
+## tsp<- did not remove mts class
+z <- ts(cbind(1:5,1:5))
+tsp(z) <- NULL
+stopifnot(identical(c(FALSE,  TRUE),
+                    c("mts","matrix") %in% class(z)))
+## kept "mts" in 3.2.4, PR#16769
+
+
+## as.hclust() and str() for deeply nested dendrograms
+op <- options(expressions = 300) # so problem triggers early
+d500 <- mkDend(500, 'x', 'single')
+sink(tempfile()); str(d500) ; sink()
+hc2 <- as.hclust(d500)
+options(op)
+## gave .. nested too deeply / node stack overflow / "C stack usage ..."
+## for R <= 3.3.z
+
+
+
+## keep at end
+rbind(last =  proc.time() - .pt,
+      total = proc.time())