Sys.setLanguage() needs care in an LC_ALL=C session

git-svn-id: https://svn.r-project.org/R/trunk@87042 00db46b3-68df-0310-9c12-caf00c1e9a41

doc/NEWS.Rd

@@ -248,6 +248,9 @@
  \I{Ekaterina Akimova}, \I{Hanne Oberman}, \I{Abhishek Ulayil},
  and \I{Lionel Henry} at the \sQuote{\I{R Dev Day}}, thus fixing
  \PR{15027}.
+
+ \item \code{Sys.setLanguage()} now works in an \command{LC_ALL=C R} session
+ on some platforms.
  }
  }
 }

src/library/base/R/stop.R

@@ -1,7 +1,7 @@
 # File src/library/base/R/stop.R
 # Part of the R package, https://www.R-project.org
 #
-# Copyright (C) 1995-2022 The R Core Team
+# Copyright (C) 1995-2024 The R Core Team
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -128,15 +128,26 @@ gettextf <- function(fmt, ..., domain = NULL, trim = TRUE)
 ## the default domain="R" seems to work for all of base R: {"R", "R-base", "RGui"}
 Sys.setLanguage <- function(lang, unset = "en")
 {
+ if (!capabilities("NLS") || is.na(.popath)) {
+ warning(gettextf("no natural language support or missing translations"), domain=NA)
+ return(invisible(""))
+ }
  stopifnot(is.character(lang), length(lang) == 1L, # e.g., "es" , "fr_CA"
  lang == "C" || grepl("^[a-z][a-z]", lang))
  curLang <- Sys.getenv("LANGUAGE", unset = NA) # so it can be reset
  if(is.na(curLang) || !nzchar(curLang))
  curLang <- unset # "factory" default
+ if(isC <- identical("C", Sys.getlocale())) { ## e.g. LC_ALL=C R on Linux
+ lcSet <- if(.Platform[["OS.type"]] == "unix")
+ Sys.setlocale("LC_MESSAGES", "en_US.UTF-8")
+ ## TODOs: 1) does en_US.UTF-8 always exist? 2) need to deal w/ Windows ?
+ ok.lc <- !is.null(lcSet) && nzchar(lcSet) # NULL or "" are not ok
+ if(!ok.lc) warning(gettextf("In a bare C locale, could not change language"), domain=NA)
+ } else ok.lc <- TRUE
  ok <- Sys.setenv(LANGUAGE=lang)
  if(!ok)
  warning(gettextf('Sys.setenv(LANGUAGE="%s") may have failed', lang), domain=NA)
  ok. <- capabilities("NLS") &&
  isTRUE(bindtextdomain(NULL)) # only flush the cache (of already translated strings)
- invisible(structure(curLang, ok = ok && ok.))
+ invisible(structure(curLang, ok = ok && ok.lc && ok.))
 }

tests/reg-tests-1e.R

@@ -1461,6 +1461,15 @@ stopifnot(beta(B, 4*B) == 0,
 ## no longer warns - as we require IEEE_745
 
 
+## as reg-tests-1<ch>.R run with LC_ALL=C -- test Sys.setLanguage() here
+try( 1 + "2")
+oL <- Sys.setLanguage("fr")
+(out <- tryCmsg(1 + "2"))
+if(attr(oL, "ok") && capabilities("NLS") && !is.na(.popath))
+ stopifnot(grepl("^argument non num.rique pour un ", out))
+## was *not* switched to French (when this was run via 'make ..')
+
+
 
 ## keep at end
 rbind(last = proc.time() - .pt,