1get_lang_strings <- function() {
2  lang_strings <- c(
3    de = "Gl\u00fcck",
4    cn = "\u5e78\u798f",
5    ru = "\u0441\u0447\u0430\u0441\u0442\u044c\u0435",
6    ko = "\ud589\ubcf5"
7  )
8
9  native_lang_strings <- enc2native(lang_strings)
10
11  same <- (lang_strings == native_lang_strings)
12
13  list(
14    same = lang_strings[same],
15    different = lang_strings[!same]
16  )
17}
18
19get_native_lang_string <- function() {
20  lang_strings <- get_lang_strings()
21  if (length(lang_strings$same) == 0) testthat::skip("No native language string available")
22  lang_strings$same[[1L]]
23}
24
25get_alien_lang_string <- function() {
26  lang_strings <- get_lang_strings()
27  if (length(lang_strings$different) == 0) testthat::skip("No alien language string available")
28  lang_strings$different[[1L]]
29}
30
31try_encoding <- function(enc) {
32  orig_encoding <- Sys.getlocale("LC_CTYPE")
33  on.exit(Sys.setlocale("LC_CTYPE", orig_encoding), add = TRUE)
34  tryCatch({
35    Sys.setlocale("LC_CTYPE", enc)
36    TRUE
37  },
38  warning = function(w) FALSE,
39  error = function(e) FALSE
40  )
41}
42
43non_utf8_encoding <- function(enc = NULL) {
44  if (!l10n_info()$`UTF-8`) {
45    return(Sys.getlocale("LC_CTYPE"))
46  }
47  enc <- enc %||% c(
48    "en_US.ISO8859-1",
49    "en_US.ISO8859-15",
50    "fr_CH.ISO8859-1",
51    "fr_CH.ISO8859-15"
52  )
53  available <- vapply(enc, try_encoding, logical(1))
54  if (any(available)) {
55    enc[available][1]
56  } else {
57    NULL
58  }
59}
60
61local_non_utf8_encoding <- function(enc = NULL, env = parent.frame()) {
62  non_utf8 <- non_utf8_encoding(enc)
63  if (is.null(non_utf8)) {
64    skip("Can't set a non-UTF-8 encoding")
65  } else {
66    withr::local_locale(c(LC_CTYPE = non_utf8), .local_envir = env)
67  }
68}
69