R version 3.3.1 (2016-06-21) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

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.

> ## Regression tests for R >= 3.0.0
> 
> pdf("reg-tests-1c.pdf", encoding = "ISOLatin1.enc")
> 
> ## 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))
[1] "length"
> setMethod("[[", "A", function(x, i, j, ...) x@aa[[i]])
[1] "[["
> (z <- mapply(function(x, y) {x * y}, a, rep(1:3, 2)))
[1] 101 204 309 104 210 318
> 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)))))
Read 9 items
> 
> ## docu always said  'length 1 is sorted':
> stopifnot(!is.unsorted(NA))
> 
> ## str(.) for large factors should be fast:
> u <- as.character(runif(1e5))
> t1 <- max(0.001, system.time(str(u))[[1]]) # get a baseline > 0
 chr [1:100000] "0.0947509987745434" "0.162095254985616" ...
> uf <- factor(u)
> (t2 <- system.time(str(uf))[[1]]) / t1 # typically around 1--2
 Factor w/ 99999 levels "0.000147690763697028",..: 9481 16183 24035 8812 39698 49460 69900 80602 11628 71897 ...
[1] 0.3333333
> 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)))
      COLS
ROWS   [,1] [,2] [,3] [,4]
  row1    1    4    7   10
  row2    2    5    8   11
  row3    3    6    9   12
> ftable(m)
     COLS  A  B  C  D
ROWS                 
row1       1  4  7 10
row2       2  5  8 11
row3       3  6  9 12
> ## 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
KMNS(*, k=3): iter=  1, indx=7
 QTRAN(): istep=20, icoun=6, NCP[1:3]= -1 34 34
 QTRAN(): istep=40, icoun=5, NCP[1:3]= -1 55 55
 QTRAN(): istep=60, icoun=4, NCP[1:3]= -1 76 76
 QTRAN(): istep=80, icoun=3, NCP[1:3]= -1 97 97
 QTRAN(): istep=100, icoun=2, NCP[1:3]= -1 118 118
 QTRAN(): istep=120, icoun=1, NCP[1:3]= -1 139 139
 QTRAN(): istep=140, icoun=7, NCP[1:3]= -1 153 153
 QTRAN(): istep=160, icoun=6, NCP[1:3]= -1 174 174
 QTRAN(): istep=180, icoun=5, NCP[1:3]= -1 195 195
 QTRAN(): istep=200, icoun=4, NCP[1:3]= -1 216 216
 QTRAN(): istep=220, icoun=3, NCP[1:3]= -1 237 237
 QTRAN(): istep=240, icoun=2, NCP[1:3]= -1 258 258
 QTRAN(): istep=260, icoun=1, NCP[1:3]= -1 279 279
 QTRAN(): istep=280, icoun=7, NCP[1:3]= -1 293 293
 QTRAN(): istep=300, icoun=6, NCP[1:3]= -1 314 314
 QTRAN(): istep=320, icoun=5, NCP[1:3]= -1 335 335
 QTRAN(): istep=340, icoun=4, NCP[1:3]= -1 356 356
 QTRAN(): istep=360, icoun=3, NCP[1:3]= -1 377 377
 QTRAN(): istep=380, icoun=2, NCP[1:3]= -1 398 398
 QTRAN(): istep=400, icoun=1, NCP[1:3]= -1 419 419
 QTRAN(): istep=420, icoun=7, NCP[1:3]= -1 433 433
 QTRAN(): istep=440, icoun=6, NCP[1:3]= -1 454 454
 QTRAN(): istep=460, icoun=5, NCP[1:3]= -1 475 475
 QTRAN(): istep=480, icoun=4, NCP[1:3]= -1 496 496
 QTRAN(): istep=500, icoun=3, NCP[1:3]= -1 517 517
 QTRAN(): istep=520, icoun=2, NCP[1:3]= -1 538 538
 QTRAN(): istep=540, icoun=1, NCP[1:3]= -1 559 559
 QTRAN(): istep=560, icoun=7, NCP[1:3]= -1 573 573
 QTRAN(): istep=580, icoun=6, NCP[1:3]= -1 594 594
 QTRAN(): istep=600, icoun=5, NCP[1:3]= -1 615 615
 QTRAN(): istep=620, icoun=4, NCP[1:3]= -1 636 636
 QTRAN(): istep=640, icoun=3, NCP[1:3]= -1 657 657
 QTRAN(): istep=660, icoun=2, NCP[1:3]= -1 678 678
 QTRAN(): istep=680, icoun=1, NCP[1:3]= -1 699 699
 QTRAN(): istep=700, icoun=7, NCP[1:3]= -1 713 713
 QTRAN(): istep=720, icoun=6, NCP[1:3]= -1 734 734
 QTRAN(): istep=740, icoun=5, NCP[1:3]= -1 755 755
 QTRAN(): istep=760, icoun=4, NCP[1:3]= -1 776 776
 QTRAN(): istep=780, icoun=3, NCP[1:3]= -1 797 797
 QTRAN(): istep=800, icoun=2, NCP[1:3]= -1 818 818
 QTRAN(): istep=820, icoun=1, NCP[1:3]= -1 839 839
 QTRAN(): istep=840, icoun=7, NCP[1:3]= -1 853 853
 QTRAN(): istep=860, icoun=6, NCP[1:3]= -1 874 874
 QTRAN(): istep=880, icoun=5, NCP[1:3]= -1 895 895
 QTRAN(): istep=900, icoun=4, NCP[1:3]= -1 916 916
 QTRAN(): istep=920, icoun=3, NCP[1:3]= -1 937 937
 QTRAN(): istep=940, icoun=2, NCP[1:3]= -1 958 958
 QTRAN(): istep=960, icoun=1, NCP[1:3]= -1 979 979
 QTRAN(): istep=980, icoun=7, NCP[1:3]= -1 993 993
Warning message:
Quick-TRANSfer stage steps exceeded maximum (= 1000) 
> try ( k. <- kmeans(r., 3) ) # after rounding, have only two distinct points
Error in kmeans(r., 3) : more cluster centers than distinct data 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)
[1] 0
> B <- B + 0i
> rcond(B)
[1] 0
> ## 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))
[1] "1.537e+04" "1.54e+04"  "1.546e+04"
Warning message:
In formatC(days) : class of 'x' was discarded
> 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))
1.772454 with absolute error < 1.7e-05
> stopifnot(abs(res$value - val) < res$abs.error)
> (res <- integrate(fun, 0, 1, rel.tol = 1e-6))
1.772454 with absolute error < 4.7e-08
> 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))
1.772454 with absolute error < 2e-05
> stopifnot(abs(res$value - val) < res$abs.error)
> (res <- integrate(fun, 0, Inf, rel.tol = 1e-6))
1.772454 with absolute error < 1.6e-06
> stopifnot(abs(res$value - val) < res$abs.error)
> (res <- integrate(fun, 0, Inf, rel.tol = 1e-8))
1.772454 with absolute error < 9.6e-11
> 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
      Qtr1  Qtr2  Qtr3  Qtr4
2000  TRUE FALSE    NA  TRUE
 a  b  c  d 
 1  0 NA  1 
 a  b  c  d 
-1  0 NA -1 
      Qtr1  Qtr2  Qtr3  Qtr4
2000 FALSE  TRUE    NA FALSE
> 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
     Qtr1 Qtr2 Qtr3 Qtr4
2010    1    2    0    4
     Qtr1 Qtr2 Qtr3 Qtr4
2010    1    2    0    4
     Qtr1 Qtr2 Qtr3 Qtr4
2010   -1   -2    0   -4
    a     b     c     d 
FALSE FALSE  TRUE FALSE 
> 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)
[1] 0
> dbeta(0.1, 9,  9.9e307)
[1] 0
> dbeta(0.1, 9.9e307, 10)
[1] 0
> ## first two hung in R <= 3.0.2
> 
> ## PR#15465
> provideDimnames(matrix(nrow = 0, ncol = 1))
     A
> provideDimnames(table(character()))
< table of extent 0 >
> as.data.frame(table(character()))
[1] Freq
<0 rows> (or 0-length row.names)
> ## 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)
data frame with 0 columns and 0 rows
> format(I(integer()))
character(0)
> gl(0, 2)
factor(0)
Levels: 
> z <- list(numeric(0), 1)
> stopifnot(identical(relist(unlist(z), z), z))
> summary(y)
< table of extent 0 x 0 >
> ## all failed in 3.0.2
> 
> ## PR#15518 Parser catching errors in particular circumstance:
> (ee <- tryCatch(parse(text = "_"), error= function(e)e))
<simpleError in parse(text = "_"): <text>:1:1: unexpected input
1: _
    ^>
> stopifnot(inherits(ee, "error"))
> ## unexpected characters caused the parser to segfault in 3.0.2
> 
> 
> ## nonsense value of nmax
> unique(1:3, nmax = 1)
[1] 1 2 3
> ## 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)
            fit        lwr       upr
1  -0.509283393 -1.6612597 0.6426929
2  -0.425329535 -1.4023374 0.5516783
3  -0.341375678 -1.1630602 0.4803089
4  -0.257421820 -0.9566449 0.4418013
5  -0.173467963 -0.8025837 0.4556478
6  -0.089514105 -0.7186299 0.5396017
7  -0.005560248 -0.7047833 0.6936629
8   0.078393610 -0.7432909 0.9000782
9   0.162347468 -0.8146604 1.1393553
10  0.246301325 -0.9056750 1.3982776
> ## 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)
> `\``
[1] 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))))
Warning message:
In tanpi(c(0.5, 1.5, -0.5, -1.5)) : NaNs produced
> ## That is not required for system implementations, and some give +/-Inf
> 
> 
> ## PR#15642 segfault when parsing overflowing reals
> as.double("1e1000")
[1] Inf
> 
> 
> 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)
         Y
1 0.583237
> 
> 
> ## 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)
        Date Settle.x Settle.y Settle.x Settle.y
1 1967-02-01       NA       NA    35.40       NA
2 1967-02-02       NA       NA    35.15       NA
3 1967-02-03       NA       NA    34.95       NA
4 2013-12-10       NA       NA       NA    16.44
5 2013-12-11       NA       NA       NA    16.65
6 2013-12-12       NA       NA       NA    16.77
Warning message:
In merge.data.frame(X, Y, by = "Date", all = TRUE) :
  column names 'Settle.x', 'Settle.y' are duplicated in the result
> ## 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")
$children
$children[[1]]
$children[[1]]$children
$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$...
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$...[[1]]
$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$children[[1]]$...[[1]]
list()







































> ## 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
'dendrogram' leaf '5', at height 0 
> 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"))
The "ward" method has been renamed to "ward.D"; note new "ward.D2"
> ## 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")
> rX <- type.convert(ch, numerals = "no.loss")
> stopifnot(is.numeric(rr), identical(rr, rX),
+           all.equal(rr, 0.999267578125),
+ 	  all.equal(type.convert(ch,	      numerals = "warn"),
+ 		    type.convert("0x1.ffap-1",numerals = "warn"), tol = 5e-15))
> ## type.convert(ch) was not numeric in R 3.1.0
> ##
> ch <- "1234567890123456789"
> rr <- type.convert(ch, numerals = "allow.loss")
> rX <- type.convert(ch, numerals = "no.loss")
> rx <- type.convert(ch, numerals = "no.loss", as.is = TRUE)
> tools::assertWarning(r. <- type.convert(ch, numerals = "warn.loss"))
> 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)
[1] 8.5
Warning message:
non-integer value 0x110p-5 qualified with L; using numeric value 
> 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))
Single term deletions

Model:
y ~ 1
       Df Sum of Sq RSS    AIC
<none>                2 0.7836
> drop1(glm(y ~ 1))
Single term deletions

Model:
y ~ 1
       Df Deviance    AIC
<none>           2 11.297
> stats:::drop1.default(glm(y ~ 1))
Single term deletions

Model:
y ~ 1
     Df    AIC
[1,]    11.297
> ## 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)))
Error in bw.SJ(c(NA, 2, 3)) : non-finite x[1] in bandwidth calculation
> try(bw.bcv(c(-Inf,2,3)))
Error in bw.bcv(c(-Inf, 2, 3)) : non-finite x[1] in bandwidth calculation
> try(bw.ucv(c(1,NaN,3,4)))
Error in bw.ucv(c(1, NaN, 3, 4)) : 
  non-finite x[2] in bandwidth calculation
> ## 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)
[1] 1
> ## 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)
Created file named '/var/tmp/portage/dev-lang/R-3.3.1/temp/RtmpgjBGvp/file3ce47030e4d8.Rd'.
Edit the file and move it to the appropriate directory.
> rd <- tools::parse_Rd(f)
> ## Gave syntax errors because the percent sign in Usage
> ## was taken as the start of a comment.
> 
> 
> ## power.t.test() failure for very large n (etc): PR#15792
> (ptt <- power.t.test(delta = 1e-4, sd = .35, power = .8))

     Two-sample t test power calculation 

              n = 192297554
          delta = 1e-04
             sd = 0.35
      sig.level = 0.05
          power = 0.8
    alternative = two.sided

NOTE: n is number in *each* group

> (ppt <- power.prop.test(p1 = .5, p2 = .501, sig.level=.001, power=0.90, tol=1e-8))

     Two-sample comparison of proportions power calculation 

              n = 10451937
             p1 = 0.5
             p2 = 0.501
      sig.level = 0.001
          power = 0.9
    alternative = two.sided

NOTE: n is number in *each* group

> 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
> 
> 
> ## 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() for environments and refClass()es
> RR <- setRefClass("Ex", fields = list(nr = "numeric"))
> m1 <- RR$new(); m2 <- RR$new(); m3 <- RR$new(nr = pi); m4 <- RR$new(nr=3.14159)
> ee <- emptyenv(); e2 <- new.env()
> stopifnot(all.equal(ee,ee), identical(ee,ee), !identical(ee,e2), all.equal(ee,e2),
+ 	  identical(m3,m3), !identical(m1,m2),
+ 	  all.equal(m1,m2), !isTRUE(all.equal(m1,m3)), !isTRUE(all.equal(m1,m4)),
+ 	  all.equal(m3,m4, tol=1e-6), grepl("relative difference", all.equal(m3,m4)),
+ 	  TRUE)
> ## did not work in R 3.1.x
> e3 <- new.env()
> e3$p <- "p"; e2$p <- "p"; ae.p <- all.equal(e2,e3)
> e3$q <- "q";              ae.q <- all.equal(e2,e3)
> e2$q <- "Q";              ae.Q <- all.equal(e2,e3)
> stopifnot(ae.p, grepl("^Length", ae.q), grepl("string mismatch", ae.Q))
> e2$q <- "q"; e2$r <- pi; e3$r <- 3.14159265
> stopifnot(all.equal(e2, e3),
+ 	  grepl("relative difference", all.equal(e2, e3, tol=1e-10)))
> g <- globalenv() # so it now contains itself
> l <- list(e = g)
> stopifnot(all.equal(g, g),
+ 	  all.equal(l, l))
> ## these ran into infinite recursion error.
> 
> 
> ## 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 prototypes are a bit special -- broke all.equal() for baseenv()
> rc <- getClass("refClass")
> rp <- rc@prototype
> str(rp) ## failed
Prototypical reference class 'envRefClass' [package "methods"]
> rp ## show() failed ..
Prototypical reference class object
> (ner <- new("envRefClass")) # show() failed
Reference class object of class "envRefClass"
> stopifnot(all.equal(rp,rp), all.equal(ner,ner))
> be <- baseenv()
> system.time(stopifnot(all.equal(be,be)))## <- takes a few sec's
   user  system elapsed 
  3.418   0.023   3.440 
> stopifnot(
+     grepl("not identical.*character", print(all.equal(rp, ner))),
+     grepl("not identical.*character", print(all.equal(ner, rp))))
[1] "Class definitions are not identical: target is character, current is refClassRepresentation"
[1] "Class definitions are not identical: Modes: S4, character"
> system.time(stopifnot(all.equal(globalenv(), globalenv())))
   user  system elapsed 
  2.649   0.013   2.662 
> ## Much of the above failed in  R <= 3.2.0
> 
> 
> ## 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.
> 
> 
> ## 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"))
[1] "foo"
> setMethod("foo", "character",
+           function(x, capitalize = FALSE) if (capitalize) toupper(x) else x)
[1] "foo"
> setMethod("foo", "factor",
+           function(x, capitalize = FALSE) { x <- as.character(x);  callGeneric() })
[1] "foo"
> 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
[1] NaN
Warning messages:
1: In besselJ(1, 2^64) :
  besselJ(x, nu): nu=1.84467e+19 too large for bessel_j() algorithm
2: In besselJ(1, 2^64) : NaNs produced
> besselY(1, c(2^(60:70), Inf))
 [1] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
There were 13 warnings (use warnings() to see them)
> ## 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...
[1] Inf
Warning message:
In besselJ(1, -1750.5) : bessel_y(1,nu=1750.5): precision lost in result
> stopifnot(is.finite(besselY(1, .5 - (1500 + 0:10))))
There were 11 warnings (use warnings() to see them)
> ## 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'
List of 4
 $ : atomic [1:1] -27.1
  ..- attr(*, "df")= num 5
  ..- attr(*, "nobs")= int 48
 $ : atomic [1:1] -28.2
  ..- attr(*, "df")= num 5
  ..- attr(*, "nobs")= int 47
 $ : atomic [1:1] -26.1
  ..- attr(*, "df")= num 5
  ..- attr(*, "nobs")= int 44
 $ : atomic [1:1] -25.4
  ..- attr(*, "df")= num 6
  ..- attr(*, "nobs")= int 44
> ## '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))))
Warning messages:
1: In stopifnot(identical(MI, as.integer(MI + 0.99)), identical(-MI,  :
  NAs introduced by coercion to integer range
2: In stopifnot(identical(MI, as.integer(MI + 0.99)), identical(-MI,  :
  NAs introduced by coercion to integer range
> ## 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:
> dn <- list(c("r1", NA), 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 ..
> ## note that format(d11) does fail currently, and hence print(), too
> 
> 
> ## 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)
> 
> 
> ## 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))
[1] "1e1305909266749859"   "1e3431228363977884"   "1e6933908663536"     
[4] "1e4801994534649"      "1e229900032791469120" "1e7386799867"        
>     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)
                    tear:(Intercept) tear:rateHigh gloss:(Intercept)
tear:(Intercept)         0.014027778  -0.014027778       0.003994444
tear:rateHigh           -0.014027778   0.028055556      -0.003994444
gloss:(Intercept)        0.003994444  -0.003994444       0.021027778
gloss:rateHigh          -0.003994444   0.007988889      -0.021027778
opacity:(Intercept)     -0.006083333   0.006083333       0.014716667
opacity:rateHigh         0.006083333  -0.012166667      -0.014716667
                    gloss:rateHigh opacity:(Intercept) opacity:rateHigh
tear:(Intercept)      -0.003994444        -0.006083333      0.006083333
tear:rateHigh          0.007988889         0.006083333     -0.012166667
gloss:(Intercept)     -0.021027778         0.014716667     -0.014716667
gloss:rateHigh         0.042055556        -0.014716667      0.029433333
opacity:(Intercept)   -0.014716667         0.409916667     -0.409916667
opacity:rateHigh       0.029433333        -0.409916667      0.819833333
> ## 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 arguments .*\\<1", conditionMessage(E)))
Error: grepl("0 arguments .*\\<1", conditionMessage(E)) is not TRUE
Execution halted