The R Project SVN – R – Diff – /trunk/tests/reg-tests-1b.R



## force standard handling for data frames
options(stringsAsFactors = TRUE)
## .Machine
(Meps <- .Machine$double.eps)# and use it in this file
 
assertWarning <- tools::assertWarning
assertError <- tools::assertError
 
## str() for list-alikes :
"[[.foo" <- function(x,i) x
x <- structure(list(2), class="foo")
str(x)

## interaction() failed to produce unique levels before 2.9.1
 
levs <- c("A","A")
## warnings for now {errors in the future}
local({
    assertWarning(gl(2,3, labels = levs))
    assertWarning(factor(levs, levels=levs))
    assertWarning(factor(1:2,	 labels=levs))
    })
## failed in R < 2.10.0
L <- c("no", "yes")
x <- (5:1)/10; lx <- paste("0.", 1:5, sep="")
y <- pi + (-9:9)*2^-53

	  identical(of, factor(of)))
## partly failed in R <= 2.9.0, partly in R-devel(2.10.0)
 
 
## "misuses" of sprintf()
assertError(sprintf("%S%"))
assertError(sprintf("%n %g", 1))
## seg.faulted in R <= 2.9.0
 
 
## sprintf(., e)  where length(as.character(e)) < length(e):
e <- tryCatch(stop(), error=identity)

lapply("forward", switch, forward = "posS", reverse = "negS")
## failed  when first converted to primitive.
 
 
## evaluation of arguments of log2
assertError(tryCatch(log2(quote(1:10))))
## 'worked' in 2.10.x by evaluting the arg twice.
 
 
## mean with NAs and trim (Bill Dunlap,
## https://stat.ethz.ch/pipermail/r-devel/2010-March/056982.html)

try(format(d0))
## crashed (Arithmetic exception) for  R <= 2.14.1
 
 
## options("max.print") :
tools::assertCondition(options(max.print = Inf), "warning") # and then error
assertError(options(max.print = -2))
tools::assertCondition(options(max.print = 1e100), "warning")
## gave only warnings (every print() time, ...)  in R <= 2.14.2
 
 
## attributes with units<-  (PR#14839)
tt <- structure(500, units = "secs", class = "difftime", names = "a")

 
## aperm(a, <char>)  when a has named dimnames:
a <- matrix(1:6, 2, dimnames=list(A=NULL, B=NULL))
stopifnot(identical(unname(aperm(a, c("B","A"))),
		    matrix(1:6, 3, byrow=TRUE)))# worked
assertError(aperm(a, c("C","A")))# fine, but
## forgetting one had been detrimental:
assertError( aperm(a, "A"))
## seg.faulted in 2.15.2 and earlier
 
## enc2utf8 failed on NA in non-UTF-8 locales PR#15201
stopifnot(identical(NA_character_, enc2utf8(NA_character_)))
## gave "NA" instead of NA_character_

Rev 63062	Rev 63205
Line 5...	Line 5...
5	`## force standard handling for data frames`	5	`## force standard handling for data frames`
6	`options(stringsAsFactors = TRUE)`	6	`options(stringsAsFactors = TRUE)`
7	`## .Machine`	7	`## .Machine`
8	`(Meps <- .Machine$double.eps)# and use it in this file`	8	`(Meps <- .Machine$double.eps)# and use it in this file`
9		9
10	`assertCondition <- tools::assertCondition`	10	`assertWarning <- tools::assertWarning`
-		11	`assertError <- tools::assertError`
11		12
12	`## str() for list-alikes :`	13	`## str() for list-alikes :`
13	`"[[.foo" <- function(x,i) x`	14	`"[[.foo" <- function(x,i) x`
14	`x <- structure(list(2), class="foo")`	15	`x <- structure(list(2), class="foo")`
15	`str(x)`	16	`str(x)`
Line 716...	Line 717...
716	`## interaction() failed to produce unique levels before 2.9.1`	717	`## interaction() failed to produce unique levels before 2.9.1`
717		718
718	`levs <- c("A","A")`	719	`levs <- c("A","A")`
719	`## warnings for now {errors in the future}`	720	`## warnings for now {errors in the future}`
720	`local({`	721	`local({`
721	`assertCondition(gl(2,3, labels = levs), "warning")`	722	`assertWarning(gl(2,3, labels = levs))`
722	`assertCondition(factor(levs, levels=levs), "warning")`	723	`assertWarning(factor(levs, levels=levs))`
723	`assertCondition(factor(1:2, labels=levs), "warning")`	724	`assertWarning(factor(1:2, labels=levs))`
724	`})`	725	`})`
725	`## failed in R < 2.10.0`	726	`## failed in R < 2.10.0`
726	`L <- c("no", "yes")`	727	`L <- c("no", "yes")`
727	`x <- (5:1)/10; lx <- paste("0.", 1:5, sep="")`	728	`x <- (5:1)/10; lx <- paste("0.", 1:5, sep="")`
728	`y <- pi + (-9:9)*2^-53`	729	`y <- pi + (-9:9)*2^-53`
Line 739...	Line 740...
739	`identical(of, factor(of)))`	740	`identical(of, factor(of)))`
740	`## partly failed in R <= 2.9.0, partly in R-devel(2.10.0)`	741	`## partly failed in R <= 2.9.0, partly in R-devel(2.10.0)`
741		742
742		743
743	`## "misuses" of sprintf()`	744	`## "misuses" of sprintf()`
744	`assertCondition(sprintf("%S%"), "error")`	745	`assertError(sprintf("%S%"))`
745	`assertCondition(sprintf("%n %g", 1), "error")`	746	`assertError(sprintf("%n %g", 1))`
746	`## seg.faulted in R <= 2.9.0`	747	`## seg.faulted in R <= 2.9.0`
747		748
748		749
749	`## sprintf(., e) where length(as.character(e)) < length(e):`	750	`## sprintf(., e) where length(as.character(e)) < length(e):`
750	`e <- tryCatch(stop(), error=identity)`	751	`e <- tryCatch(stop(), error=identity)`
Line 1139...	Line 1140...
1139	`lapply("forward", switch, forward = "posS", reverse = "negS")`	1140	`lapply("forward", switch, forward = "posS", reverse = "negS")`
1140	`## failed when first converted to primitive.`	1141	`## failed when first converted to primitive.`
1141		1142
1142		1143
1143	`## evaluation of arguments of log2`	1144	`## evaluation of arguments of log2`
1144	`assertCondition(tryCatch(log2(quote(1:10))), "error")`	1145	`assertError(tryCatch(log2(quote(1:10))))`
1145	`## 'worked' in 2.10.x by evaluting the arg twice.`	1146	`## 'worked' in 2.10.x by evaluting the arg twice.`
1146		1147
1147		1148
1148	`## mean with NAs and trim (Bill Dunlap,`	1149	`## mean with NAs and trim (Bill Dunlap,`
1149	`## https://stat.ethz.ch/pipermail/r-devel/2010-March/056982.html)`	1150	`## https://stat.ethz.ch/pipermail/r-devel/2010-March/056982.html)`
Line 1735...	Line 1736...
1735	`try(format(d0))`	1736	`try(format(d0))`
1736	`## crashed (Arithmetic exception) for R <= 2.14.1`	1737	`## crashed (Arithmetic exception) for R <= 2.14.1`
1737		1738
1738		1739
1739	`## options("max.print") :`	1740	`## options("max.print") :`
1740	`assertCondition(options(max.print = Inf), "warning")`	1741	`tools::assertCondition(options(max.print = Inf), "warning") # and then error`
1741	`assertCondition(options(max.print = -2), "error")`	1742	`assertError(options(max.print = -2))`
1742	`assertCondition(options(max.print = 1e100), "warning")`	1743	`tools::assertCondition(options(max.print = 1e100), "warning")`
1743	`## gave only warnings (every print() time, ...) in R <= 2.14.2`	1744	`## gave only warnings (every print() time, ...) in R <= 2.14.2`
1744		1745
1745		1746
1746	`## attributes with units<- (PR#14839)`	1747	`## attributes with units<- (PR#14839)`
1747	`tt <- structure(500, units = "secs", class = "difftime", names = "a")`	1748	`tt <- structure(500, units = "secs", class = "difftime", names = "a")`
Line 2082...	Line 2083...
2082		2083
2083	`## aperm(a, <char>) when a has named dimnames:`	2084	`## aperm(a, <char>) when a has named dimnames:`
2084	`a <- matrix(1:6, 2, dimnames=list(A=NULL, B=NULL))`	2085	`a <- matrix(1:6, 2, dimnames=list(A=NULL, B=NULL))`
2085	`stopifnot(identical(unname(aperm(a, c("B","A"))),`	2086	`stopifnot(identical(unname(aperm(a, c("B","A"))),`
2086	`matrix(1:6, 3, byrow=TRUE)))# worked`	2087	`matrix(1:6, 3, byrow=TRUE)))# worked`
2087	`assertCondition(aperm(a, c("C","A")), "error")# fine, but`	2088	`assertError(aperm(a, c("C","A")))# fine, but`
2088	`## forgetting one had been detrimental:`	2089	`## forgetting one had been detrimental:`
2089	`assertCondition( aperm(a, "A"), "error")`	2090	`assertError( aperm(a, "A"))`
2090	`## seg.faulted in 2.15.2 and earlier`	2091	`## seg.faulted in 2.15.2 and earlier`
2091		2092
2092	`## enc2utf8 failed on NA in non-UTF-8 locales PR#15201`	2093	`## enc2utf8 failed on NA in non-UTF-8 locales PR#15201`
2093	`stopifnot(identical(NA_character_, enc2utf8(NA_character_)))`	2094	`stopifnot(identical(NA_character_, enc2utf8(NA_character_)))`
2094	`## gave "NA" instead of NA_character_`	2095	`## gave "NA" instead of NA_character_`

The R Project SVN R

(root)/trunk/tests/reg-tests-1b.R – Rev 63062 → 63205