R Under development (unstable) (2024-01-23 r85822 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

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.

> message("TESTING: finalize() reentrant...")
TESTING: finalize() reentrant...
> 
> ## FIXME: 'covr' does not play well with tests
> ## detaching/unloading packages
> if ("covr" %in% loadedNamespaces()) {
+   detach <- function(...) NULL
+ }
> 
> 
> library("R.methodsS3")
R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help.
> library("R.oo")
R.oo v1.26.0 successfully loaded. See ?R.oo for help.

Attaching package: 'R.oo'

The following object is masked from 'package:R.methodsS3':

    throw

The following objects are masked from 'package:methods':

    getClasses, getMethods

The following objects are masked from 'package:base':

    attach, detach, load, save

> 
> lotsOfParsing <- function(code="y <- 1:3") {
+   parse(text=rep(code, times=10000))
+ }
> 
> setConstructorS3("MyClass", function(a=1:10) {
+   extend(Object(), "MyClass", a=a)
+ })
> 
> setMethodS3("finalize", "MyClass", function(this, ...) {
+   cat("finalize...\n")
+   utils::str(sys.calls())
+   cat("finalize...done\n")
+ })
NULL
> 
> # Parse and eval expression (works)
> expr <- lotsOfParsing()
> eval(expr)
> print(y)
[1] 1 2 3
> ## [1] 1 2 3
> stopifnot(identical(y, 1:3))
> 
> # Create an object with a finalizer
> x <- MyClass()
> 
> # Detach R.oo so that the finalizer will try to reload it
> detach("package:R.oo")
> 
> # Remove 'x' so that it will be finalized below
> rm(x)
> 
> 
> # This may trigger garbage collection via parse()
> # If so, it is important that parse() is not called
> # (indirectly via library()) by the finalizer.
> # Because otherwise R may crash.
> expr2 <- lotsOfParsing(code="y <- 1:4")
> ## finalize...
> ## Dotted pair list of 9
> ##  $ : ...
> ##  ...
> ##  $ : language function (env)  { ...
> ##  $ : language finalize(this)
> ##  $ : language finalize.MyClass(this)
> ## Parse called: TRUE
> ## finalize...done
> eval(expr2)
finalize...
Dotted pair list of 5
 $ : language eval(expr2)
 $ : language parent.frame()
 $ : language (function (env)  { ...
 $ : language R.oo::finalize(this)
 $ : language finalize.MyClass(this)
finalize...done
> print(y)
[1] 1 2 3 4
> ## [1] 1 2 3 4
> stopifnot(identical(y, 1:4))
> 
> print(warnings())
> 
> message("TESTING: finalize() reentrant...DONE")
TESTING: finalize() reentrant...DONE
> 
> proc.time()
   user  system elapsed 
   0.32    0.04    0.37