@r-universe/webr 2023.6.11 → 2023.6.21

package/dist/vfs/usr/lib/R/tests/complex.Rout.save

@@ -0,0 +1,297 @@
+
+R Under development (unstable) (2022-03-19 r81942) -- "Unsuffered Consequences"
+Copyright (C) 2022 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.
+
+> ### Tests of complex arithemetic.
+> 
+> Meps <- .Machine$double.eps
+> ## complex
+> z <- 0i ^ (-3:3)
+> stopifnot(Re(z) == 0 ^ (-3:3))
+> 
+> 
+> ## powers, including complex ones
+> a <- -4:12
+> m <- outer(a +0i, b <- seq(-.5,2, by=.5), "^")
+> dimnames(m) <- list(paste(a), "^" = sapply(b,format))
+> round(m,3)
+    ^
+             -0.5    0          0.5     1           1.5      2
+  -4 0.000-0.500i 1+0i 0.000+2.000i -4+0i  0.000-8.000i  16+0i
+  -3 0.000-0.577i 1+0i 0.000+1.732i -3+0i  0.000-5.196i   9+0i
+  -2 0.000-0.707i 1+0i 0.000+1.414i -2+0i  0.000-2.828i   4+0i
+  -1 0.000-1.000i 1+0i 0.000+1.000i -1+0i  0.000-1.000i   1+0i
+  0    Inf+0.000i 1+0i 0.000+0.000i  0+0i  0.000+0.000i   0+0i
+  1  1.000+0.000i 1+0i 1.000+0.000i  1+0i  1.000+0.000i   1+0i
+  2  0.707+0.000i 1+0i 1.414+0.000i  2+0i  2.828+0.000i   4+0i
+  3  0.577+0.000i 1+0i 1.732+0.000i  3+0i  5.196+0.000i   9+0i
+  4  0.500+0.000i 1+0i 2.000+0.000i  4+0i  8.000+0.000i  16+0i
+  5  0.447+0.000i 1+0i 2.236+0.000i  5+0i 11.180+0.000i  25+0i
+  6  0.408+0.000i 1+0i 2.449+0.000i  6+0i 14.697+0.000i  36+0i
+  7  0.378+0.000i 1+0i 2.646+0.000i  7+0i 18.520+0.000i  49+0i
+  8  0.354+0.000i 1+0i 2.828+0.000i  8+0i 22.627+0.000i  64+0i
+  9  0.333+0.000i 1+0i 3.000+0.000i  9+0i 27.000+0.000i  81+0i
+  10 0.316+0.000i 1+0i 3.162+0.000i 10+0i 31.623+0.000i 100+0i
+  11 0.302+0.000i 1+0i 3.317+0.000i 11+0i 36.483+0.000i 121+0i
+  12 0.289+0.000i 1+0i 3.464+0.000i 12+0i 41.569+0.000i 144+0i
+> stopifnot(m[,as.character(0:2)] == cbind(1,a,a*a),
++                                         # latter were only approximate
++           all.equal(unname(m[,"0.5"]),
++                     sqrt(abs(a))*ifelse(a < 0, 1i, 1),
++                     tolerance = 20*Meps))
+> 
+> ## 2.10.0-2.12.1 got z^n wrong in the !HAVE_C99_COMPLEX case
+> z <- 0.2853725+0.3927816i
+> z2 <- z^(1:20)
+> z3 <- z^-(1:20)
+> z0 <- cumprod(rep(z, 20))
+> stopifnot(all.equal(z2, z0), all.equal(z3, 1/z0))
+> ## was z^3 had value z^2 ....
+> 
+> ## fft():
+> for(n in 1:30) cat("\nn=",n,":", round(fft(1:n), 8),"\n")
+
+n= 1 : 1+0i 
+
+n= 2 : 3+0i -1+0i 
+
+n= 3 : 6+0i -1.5+0.866025i -1.5-0.866025i 
+
+n= 4 : 10+0i -2+2i -2+0i -2-2i 
+
+n= 5 : 15+0i -2.5+3.440955i -2.5+0.812299i -2.5-0.812299i -2.5-3.440955i 
+
+n= 6 : 21+0i -3+5.196152i -3+1.732051i -3+0i -3-1.732051i -3-5.196152i 
+
+n= 7 : 28+0i -3.5+7.267825i -3.5+2.791157i -3.5+0.798852i -3.5-0.798852i -3.5-2.791157i -3.5-7.267825i 
+
+n= 8 : 36+0i -4+9.656854i -4+4i -4+1.656854i -4+0i -4-1.656854i -4-4i -4-9.656854i 
+
+n= 9 : 45+0i -4.5+12.36365i -4.5+5.362891i -4.5+2.598076i -4.5+0.793471i -4.5-0.793471i -4.5-2.598076i -4.5-5.362891i -4.5-12.36365i 
+
+n= 10 : 55+0i -5+15.38842i -5+6.88191i -5+3.632713i -5+1.624598i -5+0i -5-1.624598i -5-3.632713i -5-6.88191i -5-15.38842i 
+
+n= 11 : 66+0i -5.5+18.73128i -5.5+8.558167i -5.5+4.765777i -5.5+2.511766i -5.5+0.790781i -5.5-0.790781i -5.5-2.511766i -5.5-4.765777i -5.5-8.558167i -5.5-18.73128i 
+
+n= 12 : 78+0i -6+22.3923i -6+10.3923i -6+6i -6+3.464102i -6+1.607695i -6+0i -6-1.607695i -6-3.464102i -6-6i -6-10.3923i -6-22.3923i 
+
+n= 13 : 91+0i -6.5+26.37154i -6.5+12.38472i -6.5+7.336983i -6.5+4.486626i -6.5+2.465125i -6.5+0.789243i -6.5-0.789243i -6.5-2.465125i -6.5-4.486626i -6.5-7.336983i -6.5-12.38472i -6.5-26.37154i 
+
+n= 14 : 105+0i -7+30.669i -7+14.53565i -7+8.777722i -7+5.582314i -7+3.371022i -7+1.597704i -7+0i -7-1.597704i -7-3.371022i -7-5.582314i -7-8.777722i -7-14.53565i -7-30.669i 
+
+n= 15 : 120+0i -7.5+35.28473i -7.5+16.84528i -7.5+10.32286i -7.5+6.75303i -7.5+4.330127i -7.5+2.436898i -7.5+0.788282i -7.5-0.788282i -7.5-2.436898i -7.5-4.330127i -7.5-6.75303i -7.5-10.32286i -7.5-16.84528i -7.5-35.28473i 
+
+n= 16 : 136+0i -8+40.21872i -8+19.31371i -8+11.97285i -8+8i -8+5.345429i -8+3.313709i -8+1.591299i -8+0i -8-1.591299i -8-3.313709i -8-5.345429i -8-8i -8-11.97285i -8-19.31371i -8-40.21872i 
+
+n= 17 : 153+0i -8.5+45.47098i -8.5+21.94103i -8.5+13.72797i -8.5+9.324056i -8.5+6.418902i -8.5+4.232497i -8.5+2.418459i -8.5+0.787641i -8.5-0.787641i -8.5-2.418459i -8.5-4.232497i -8.5-6.418902i -8.5-9.324056i -8.5-13.72797i -8.5-21.94103i -8.5-45.47098i 
+
+n= 18 : 171+0i -9+51.04154i -9+24.7273i -9+15.58846i -9+10.72578i -9+7.551897i -9+5.196152i -9+3.275732i -9+1.586943i -9+0i -9-1.586943i -9-3.275732i -9-5.196152i -9-7.551897i -9-10.72578i -9-15.58846i -9-24.7273i -9-51.04154i 
+
+n= 19 : 190+0i -9.5+56.93038i -9.5+27.67255i -9.5+17.55446i -9.5+12.2056i -9.5+8.745366i -9.5+6.20666i -9.5+4.167086i -9.5+2.405727i -9.5+0.787192i -9.5-0.787192i -9.5-2.405727i -9.5-4.167086i -9.5-6.20666i -9.5-8.745366i -9.5-12.2056i -9.5-17.55446i -9.5-27.67255i -9.5-56.93038i 
+
+n= 20 : 210+0i -10+63.13752i -10+30.77684i -10+19.62611i -10+13.76382i -10+10i -10+7.26543i -10+5.09525i -10+3.2492i -10+1.58384i -10+0i -10-1.58384i -10-3.2492i -10-5.09525i -10-7.26543i -10-10i -10-13.76382i -10-19.62611i -10-30.77684i -10-63.13752i 
+
+n= 21 : 231+0i -10.5+69.66295i -10.5+34.04016i -10.5+21.80347i -10.5+15.40067i -10.5+11.31631i -10.5+8.37347i -10.5+6.06218i -10.5+4.12095i -10.5+2.39656i -10.5+0.78687i -10.5-0.78687i -10.5-2.39656i -10.5-4.12095i -10.5-6.06218i -10.5-8.37347i -10.5-11.31631i -10.5-15.40067i -10.5-21.80347i -10.5-34.04016i -10.5-69.66295i 
+
+n= 22 : 253+0i -11+76.50668i -11+37.46256i -11+24.08664i -11+17.11633i -11+12.69468i -11+9.53155i -11+7.06927i -11+5.02353i -11+3.22989i -11+1.58156i -11+0i -11-1.58156i -11-3.22989i -11-5.02353i -11-7.06927i -11-9.53155i -11-12.69468i -11-17.11633i -11-24.08664i -11-37.46256i -11-76.50668i 
+
+n= 23 : 276+0i -11.5+83.66871i -11.5+41.04404i -11.5+26.47566i -11.5+18.91094i -11.5+14.1354i -11.5+10.74025i -11.5+8.11759i -11.5+5.95882i -11.5+4.0871i -11.5+2.38973i -11.5+0.78662i -11.5-0.78662i -11.5-2.38973i -11.5-4.0871i -11.5-5.95882i -11.5-8.11759i -11.5-10.74025i -11.5-14.1354i -11.5-18.91094i -11.5-26.47566i -11.5-41.04404i -11.5-83.66871i 
+
+n= 24 : 300+0i -12+91.14905i -12+44.78461i -12+28.97056i -12+20.78461i -12+15.6387i -12+12i -12+9.20792i -12+6.9282i -12+4.97056i -12+3.21539i -12+1.57983i -12+0i -12-1.57983i -12-3.21539i -12-4.97056i -12-6.9282i -12-9.20792i -12-12i -12-15.6387i -12-20.78461i -12-28.97056i -12-44.78461i -12-91.14905i 
+
+n= 25 : 325+0i -12.5+98.94769i -12.5+48.68429i -12.5+31.5714i -12.5+22.73742i -12.5+17.20477i -12.5+13.31115i -12.5+10.3409i -12.5+7.93274i -12.5+5.88205i -12.5+4.0615i -12.5+2.3845i -12.5+0.78643i -12.5-0.78643i -12.5-2.3845i -12.5-4.0615i -12.5-5.88205i -12.5-7.93274i -12.5-10.3409i -12.5-13.31115i -12.5-17.20477i -12.5-22.73742i -12.5-31.5714i -12.5-48.68429i -12.5-98.94769i 
+
+n= 26 : 351+0i -13+107.0646i -13+52.74307i -13+34.27818i -13+24.76943i -13+18.83375i -13+14.67397i -13+11.517i -13+8.97325i -13+6.82293i -13+4.93025i -13+3.20421i -13+1.57849i -13+0i -13-1.57849i -13-3.20421i -13-4.93025i -13-6.82293i -13-8.97325i -13-11.517i -13-14.67397i -13-18.83375i -13-24.76943i -13-34.27818i -13-52.74307i -13-107.0646i 
+
+n= 27 : 378+0i -13.5+115.4999i -13.5+56.96098i -13.5+37.09095i -13.5+26.88071i -13.5+20.52575i -13.5+16.08867i -13.5+12.73659i -13.5+10.05038i -13.5+7.79423i -13.5+5.82333i -13.5+4.04163i -13.5+2.38041i -13.5+0.78629i -13.5-0.78629i -13.5-2.38041i -13.5-4.04163i -13.5-5.82333i -13.5-7.79423i -13.5-10.05038i -13.5-12.73659i -13.5-16.08867i -13.5-20.52575i -13.5-26.88071i -13.5-37.09095i -13.5-56.96098i -13.5-115.4999i 
+
+n= 28 : 406+0i -14+124.2534i -14+61.33801i -14+40.0097i -14+29.0713i -14+22.28087i -14+17.55544i -14+14i -14+11.16463i -14+8.79678i -14+6.74204i -14+4.89881i -14+3.19541i -14+1.57742i -14+0i -14-1.57742i -14-3.19541i -14-4.89881i -14-6.74204i -14-8.79678i -14-11.16463i -14-14i -14-17.55544i -14-22.28087i -14-29.0713i -14-40.0097i -14-61.33801i -14-124.2534i 
+
+n= 29 : 435+0i -14.5+133.3253i -14.5+65.87416i -14.5+43.03447i -14.5+31.34124i -14.5+24.09919i -14.5+19.07442i -14.5+15.30746i -14.5+12.31641i -14.5+9.83124i -14.5+7.68741i -14.5+5.77733i -14.5+4.02591i -14.5+2.37715i -14.5+0.78617i -14.5-0.78617i -14.5-2.37715i -14.5-4.02591i -14.5-5.77733i -14.5-7.68741i -14.5-9.83124i -14.5-12.31641i -14.5-15.30746i -14.5-19.07442i -14.5-24.09919i -14.5-31.34124i -14.5-43.03447i -14.5-65.87416i -14.5-133.3253i 
+
+n= 30 : 465+0i -15+142.7155i -15+70.56945i -15+46.16525i -15+33.69055i -15+25.98076i -15+20.64573i -15+16.65919i -15+13.50606i -15+10.89814i -15+8.66025i -15+6.67843i -15+4.8738i -15+3.18835i -15+1.57656i -15+0i -15-1.57656i -15-3.18835i -15-4.8738i -15-6.67843i -15-8.66025i -15-10.89814i -15-13.50606i -15-16.65919i -15-20.64573i -15-25.98076i -15-33.69055i -15-46.16525i -15-70.56945i -15-142.7155i 
+> 
+> 
+> ## polyroot():
+> stopifnot(abs(1 + polyroot(choose(8, 0:8))) < 1e-10)# maybe smaller..
+> 
+> ## precision of complex numbers
+> signif(1.678932e80+0i, 5)
+[1] 1.6789e+80+0i
+> signif(1.678932e-300+0i, 5)
+[1] 1.6789e-300+0i
+> signif(1.678932e-302+0i, 5)
+[1] 1.6789e-302+0i
+> signif(1.678932e-303+0i, 5)
+[1] 1.6789e-303+0i
+> signif(1.678932e-304+0i, 5)
+[1] 1.6789e-304+0i
+> signif(1.678932e-305+0i, 5)
+[1] 1.6789e-305+0i
+> signif(1.678932e-306+0i, 5)
+[1] 1.6789e-306+0i
+> signif(1.678932e-307+0i, 5)
+[1] 1.6789e-307+0i
+> signif(1.678932e-308+0i, 5)
+[1] 1.6789e-308+0i
+> signif(1.678932-1.238276i, 5)
+[1] 1.6789-1.2383i
+> signif(1.678932-1.238276e-1i, 5)
+[1] 1.6789-0.1238i
+> signif(1.678932-1.238276e-2i, 5)
+[1] 1.6789-0.0124i
+> signif(1.678932-1.238276e-3i, 5)
+[1] 1.6789-0.0012i
+> signif(1.678932-1.238276e-4i, 5)
+[1] 1.6789-0.0001i
+> signif(1.678932-1.238276e-5i, 5)
+[1] 1.6789+0i
+> signif(8.678932-9.238276i, 5)
+[1] 8.6789-9.2383i
+> ## prior to 2.2.0 rounded real and imaginary parts separately.
+> 
+> 
+> ## Complex Trig.:
+> abs(Im(cos(acos(1i))) -	 1) < 2*Meps
+[1] TRUE
+> abs(Im(sin(asin(1i))) -	 1) < 2*Meps
+[1] TRUE
+> ##P (1 - Im(sin(asin(Ii))))/Meps
+> ##P (1 - Im(cos(acos(Ii))))/Meps
+> abs(Im(asin(sin(1i))) -	 1) < 2*Meps
+[1] TRUE
+> all.equal(cos(1i), cos(-1i)) # i.e. Im(acos(*)) gives + or - 1i:
+[1] TRUE
+> abs(abs(Im(acos(cos(1i)))) - 1) < 4*Meps
+[1] TRUE
+> 
+> 
+> set.seed(123) # want reproducible output
+> Isi <- Im(sin(asin(1i + rnorm(100))))
+> all(abs(Isi-1) < 100* Meps)
+[1] TRUE
+> ##P table(2*abs(Isi-1)	/ Meps)
+> Isi <- Im(cos(acos(1i + rnorm(100))))
+> all(abs(Isi-1) < 100* Meps)
+[1] TRUE
+> ##P table(2*abs(Isi-1)	/ Meps)
+> Isi <- Im(atan(tan(1i + rnorm(100)))) #-- tan(atan(..)) does NOT work (Math!)
+> all(abs(Isi-1) < 100* Meps)
+[1] TRUE
+> ##P table(2*abs(Isi-1)	/ Meps)
+> 
+> set.seed(123)
+> z <- complex(real = rnorm(100), imag = rnorm(100))
+> stopifnot(Mod ( 1 -  sin(z) / ( (exp(1i*z)-exp(-1i*z))/(2*1i) )) < 20 * Meps)
+> ## end of moved from complex.Rd
+> 
+> 
+> ## PR#7781
+> ## This is not as given by e.g. glibc on AMD64
+> (z <- tan(1+1000i)) # 0+1i from R's own code.
+[1] 0+1i
+> stopifnot(is.finite(z))
+> ##
+> 
+> 
+> ## Branch cuts in complex inverse trig functions
+> atan(2)
+[1] 1.107149
+> atan(2+0i)
+[1] 1.107149+0i
+> tan(atan(2+0i))
+[1] 2+0i
+> ## should not expect exactly 0i in result
+> round(atan(1.0001+0i), 7)
+[1] 0.7854482+0i
+> round(atan(0.9999+0i), 7)
+[1] 0.7853482+0i
+> ## previously not as in Abramowitz & Stegun.
+> 
+> 
+> ## typo in z_atan2.
+> (z <- atan2(0+1i, 0+0i))
+[1] 1.570796+0i
+> stopifnot(all.equal(z, pi/2+0i))
+> ## was NA in 2.1.1
+> 
+> 
+> ## Hyperbolic
+> x <- seq(-3, 3, len=200)
+> Meps <- .Machine$double.eps
+> stopifnot(
++  Mod(cosh(x) - cos(1i*x))	< 20*Meps,
++  Mod(sinh(x) - sin(1i*x)/1i)	< 20*Meps
++ )
+> ## end of moved from Hyperbolic.Rd
+> 
+> ## values near and on branch cuts
+> options(digits=5)
+> z <- c(2+0i, 2-0.0001i, -2+0i, -2+0.0001i)
+> asin(z)
+[1]  1.5708-1.317i  1.5707-1.317i -1.5708+1.317i -1.5707+1.317i
+> acos(z)
+[1] 0.0000+1.317i 0.0001+1.317i 3.1416-1.317i 3.1415-1.317i
+> atanh(z)
+[1]  0.5493-1.5708i  0.5493-1.5708i -0.5493+1.5708i -0.5493+1.5708i
+> z <- c(0+2i, 0.0001+2i, 0-2i, -0.0001i-2i)
+> asinh(z)
+[1]  1.317+1.5708i  1.317+1.5707i -1.317-1.5708i -1.317-1.5708i
+> acosh(z)
+[1]  1.4436+1.5708i  1.4436+1.5708i -1.4436+1.5708i -1.4437+1.5708i
+> atan(z)
+[1]  1.5708+0.5493i  1.5708+0.5493i -1.5708-0.5493i -1.5708-0.5493i
+> ## According to C99, should have continuity from the side given if there
+> ## are not signed zeros.
+> ## Both glibc 2.12 and macOS 10.6 used continuity from above in the first set
+> ## but they seem to assume signed zeros.
+> ## Windows gave incorrect (NaN) values on the cuts.
+> 
+> stopifnot(identical(tanh(356+0i), 1+0i))
+> ## Used to be NaN+0i on Windows
+> 
+> ## Not a regression test, but rather one of the good cases:
+> (cNaN <- as.complex("NaN"))
+[1] NaN+0i
+> stopifnot(identical(cNaN, complex(re = NaN)), is.nan(Re(cNaN)), Im(cNaN) == 0)
+> dput(cNaN) ## (real = NaN, imaginary = 0)
+complex(real=NaN, imaginary=0)
+> ## Partly new behavior:
+> (c0NaN  <- complex(real=0, im=NaN))
+[1] 0+NaNi
+> (cNaNaN <- complex(re=NaN, im=NaN))
+[1] NaN+NaNi
+> stopifnot(identical(cNaN, as.complex(NaN)),
++           identical(vapply(c(cNaN, c0NaN, cNaNaN), format, ""),
++                     c("NaN+0i", "0+NaNi", "NaN+NaNi")),
++           identical(cNaN, NaN + 0i),
++           identical(cNaN, Conj(cNaN)),
++           identical(cNaN, cNaN+cNaN),
++ 
++           identical(cNaNaN, 1i * NaN),
++           identical(cNaNaN, complex(modulus= NaN)),
++           identical(cNaNaN, complex(argument= NaN)),
++           identical(cNaNaN, complex(arg=NaN, mod=NaN)),
++ 
++           identical(c0NaN, c0NaN+c0NaN), # !
++           ## Platform dependent, not TRUE e.g. on F21 gcc 4.9.2:
++           ## identical(NA_complex_, NaN + NA_complex_ ) ,
++           ## Probably TRUE, but by a standard ??
++           ## identical(cNaNaN, 2 * c0NaN), # C-library arithmetic
++           ## identical(cNaNaN, 2 * cNaN),  # C-library arithmetic
++           ## identical(cNaNaN, NA_complex_ * Inf),
++           TRUE)
+> 

package/dist/vfs/usr/lib/R/tests/conditions.R

@@ -0,0 +1,155 @@
+
+saveTo <- function(to) function(cond) assign(to, cond, envir = globalenv())
+isCond <- function(x, class, msg) {
+    inherits(x, "condition") && inherits(x, class) && identical(x$message, msg)
+}
+
+## Handler stack starts empty
+handlers <- withVisible(globalCallingHandlers())
+stopifnot(
+    identical(handlers$value, list()),
+    isTRUE(handlers$visible)
+)
+
+## Handlers must be functions
+err <- tryCatch(globalCallingHandlers(foo = identity, bar = NA),
+                error = identity)
+stopifnot(identical(err$message, "condition handlers must be functions"))
+
+## Can register and inspect handler
+globalCallingHandlers(error = saveTo(".Last.error"))
+handlers <- withVisible(globalCallingHandlers())
+
+stopifnot(
+    length(handlers$value) == 1,
+    names(handlers$value) == "error",
+    handlers$visible
+)
+
+## Handlers are invoked based on class
+.Last.error <- NULL
+signalCondition(simpleCondition("foo"))
+stopifnot(is.null(.Last.error))
+signalCondition(simpleError("foo"))
+stopifnot(isCond(.Last.error, "error", "foo"))
+
+## Can register multiple handlers
+globalCallingHandlers(
+    condition = saveTo(".Last.condition"),
+    warning = saveTo(".Last.warning")
+)
+handlers <- globalCallingHandlers()
+stopifnot(length(handlers) == 3,
+          all(names(handlers) == c("condition", "warning", "error")))
+
+## Multiple handlers are invoked
+.Last.error <- NULL
+signalCondition(simpleWarning("bar"))
+stopifnot(
+    is.null(.Last.error),
+    isCond(.Last.condition, "warning", "bar"),
+    isCond(.Last.warning, "warning", "bar")
+)
+signalCondition(simpleError("baz"))
+stopifnot(
+    isCond(.Last.error, "error", "baz"),
+    isCond(.Last.condition, "error", "baz"),
+    isCond(.Last.warning, "warning", "bar")
+)
+
+## Handlers are not invoked if error is caught
+.Last.error <- NULL
+try(stop("baz"), TRUE)
+stopifnot(is.null(.Last.error))
+
+## Can remove handlers
+handlers <- globalCallingHandlers()
+old <- withVisible(globalCallingHandlers(NULL))
+stopifnot(
+    identical(old$value, handlers),
+    !old$visible,
+    identical(globalCallingHandlers(), list())
+)
+signalCondition(simpleError("foo"))
+stopifnot(is.null(.Last.error))
+
+## Can pass list of handlers
+foobars <- list(foo = function() "foo", bar = function() "bar")
+globalCallingHandlers(foobars)
+stopifnot(identical(globalCallingHandlers(), foobars))
+globalCallingHandlers(NULL)
+
+## Local handlers are not returned
+handlers <- withCallingHandlers(foo = function(...) NULL,
+                                globalCallingHandlers())
+stopifnot(identical(handlers, list()))
+globalCallingHandlers(foobars)
+handlers <- withCallingHandlers(foo = function(...) NULL,
+                                globalCallingHandlers())
+stopifnot(identical(handlers, foobars))
+globalCallingHandlers(NULL)
+
+## Registering a handler again moves it to the top of the stack
+globalCallingHandlers(
+    warning = function(...) "foo",
+    error = function(...) "foo",
+    condition = function(...) "foo",
+    error = function(...) "bar"
+)
+globalCallingHandlers(
+    error = function(...) "foo"
+)
+bumped <- list(
+    error = function(...) "foo",
+    warning = function(...) "foo",
+    condition = function(...) "foo",
+    error = function(...) "bar"
+)
+stopifnot(identical(globalCallingHandlers(), bumped))
+## Fails in R 4.0
+globalCallingHandlers(
+    warning = function(...) "foo",
+    error = function(...) "foo"
+)
+bumped <- list(
+    warning = function(...) "foo",
+    error = function(...) "foo",
+    condition = function(...) "foo",
+    error = function(...) "bar"
+)
+stopifnot(identical(globalCallingHandlers(), bumped))
+globalCallingHandlers(NULL)
+
+## Attributes and closure environments are detected in the duplicate
+## handlers check
+hnd1 <- function(...) "foo"
+hnd2 <- structure(function(...) "foo", bar = TRUE)
+hnd3 <- local(function(...) "foo")
+expectedList <- list(
+    error = hnd1,
+    error = hnd2,
+    error = hnd3
+)
+globalCallingHandlers(error = hnd1, error = hnd2, error = hnd3)
+stopifnot(identical(globalCallingHandlers(), expectedList))
+globalCallingHandlers(NULL)
+## and removeSource() now retains attributes:
+stopifnot( identical(attributes(removeSource(hnd2)), list(bar = TRUE)) )
+
+
+## Source references do not cause handlers to be treated as distinct
+withSource <- function(src, envir = parent.frame(), file = NULL) {
+    if (is.null(file)) {
+	file <- tempfile("sourced", fileext = ".R")
+    }
+    on.exit(unlink(file))
+    writeLines(src, file)
+    source(file, local = envir, keep.source = TRUE)
+}
+withSource("hnd1 <- structure(function(...) { NULL })")
+withSource("hnd2 <- structure(function(...) { NULL })")
+globalCallingHandlers(NULL)
+globalCallingHandlers(error = hnd1)
+globalCallingHandlers(error = hnd2) # message "pushing duplicate .."
+stopifnot(identical(globalCallingHandlers(), list(error = hnd2)))
+globalCallingHandlers(NULL)