/
s3-externalptr.R
44 lines (39 loc) · 1.47 KB
/
s3-externalptr.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
constructors$externalptr <- new.env()
#' Constructive options for type 'externalptr'
#'
#' These options will be used on objects of type 'externalptr'. By default this
#' function is useless as nothing can be set, this is provided in case users wan
#' to extend the method with other constructors.
#'
#' Depending on `constructor`, we construct the object as follows:
#' * `"default"` : We use a special function from the constructive
#'
#' @param constructor String. Name of the function used to construct the object.
#' @inheritParams opts_atomic
#'
#' @return An object of class <constructive_options/constructive_options_externalptr>
#' @export
opts_externalptr <- function(constructor = c("default"), ...) {
.cstr_combine_errors(
constructor <- .cstr_match_constructor(constructor, "externalptr"),
check_dots_empty()
)
.cstr_options("externalptr", constructor = constructor)
}
#' @export
.cstr_construct.externalptr <- function(x, ...) {
opts <- .cstr_fetch_opts("externalptr", ...)
if (is_corrupted_externalptr (x)) return(NextMethod())
constructor <- constructors$externalptr [[opts$constructor]]
constructor(x, ...)
}
is_corrupted_externalptr <- function(x) {
typeof(x) != "externalptr"
}
constructors$externalptr$default <- function(x, ...) {
code <- sprintf('constructive::.xptr("%s")', external_pointer_address(x))
repair_attributes_externalptr(x, code, ...)
}
repair_attributes_externalptr <- function(x, code, ...) {
.cstr_repair_attributes(x, code, ...)
}