Mark UTF-8 locale names with their encoding

Author: kevinushey

src/main/platform.c

@@ -2218,15 +2218,17 @@ attribute_hidden SEXP do_getlocale(SEXP call, SEXP op, SEXP args, SEXP rho)
     default: cat = NA_INTEGER;
     }
     if (cat != NA_INTEGER) p = setlocale(cat, NULL);
-    return mkString(p ? p : "");
+    /* setlocale() returns text in the current LC_CTYPE encoding. */
+    return ScalarString(mkCharCE(p ? p : "",
+				 utf8locale ? CE_UTF8 : CE_NATIVE));
 }
 
-/* Locale specs are always ASCII */
 attribute_hidden SEXP do_setlocale(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
     SEXP locale = CADR(args), ans;
     int cat;
     const char *p;
+    char *locale_result = NULL;
     bool warned = FALSE;
 
     checkArity(op, args);
@@ -2322,13 +2324,10 @@ attribute_hidden SEXP do_setlocale(SEXP call, SEXP op, SEXP args, SEXP rho)
 	p = NULL; /* -Wall */
 	error(_("invalid '%s' argument"), "category");
     }
-    PROTECT(ans = allocVector(STRSXP, 1));
-    if (p) SET_STRING_ELT(ans, 0, mkChar(p));
-    else  {
-	SET_STRING_ELT(ans, 0, mkChar(""));
-	if (!warned)
-	    warning(_("OS reports request to set locale to \"%s\" cannot be honored"),
-	            CHAR(STRING_ELT(locale, 0)));
+    if (p) {
+	size_t n = strlen(p) + 1;
+	locale_result = R_alloc(n, 1);
+	memcpy(locale_result, p, n);
     }
 #ifdef Win32
     int oldCP = localeCP;
@@ -2343,6 +2342,18 @@ attribute_hidden SEXP do_setlocale(SEXP call, SEXP op, SEXP args, SEXP rho)
     }
 #endif
     invalidate_cached_recodings();
+
+    PROTECT(ans = allocVector(STRSXP, 1));
+    if (locale_result)
+	SET_STRING_ELT(ans, 0,
+		       mkCharCE(locale_result,
+				utf8locale ? CE_UTF8 : CE_NATIVE));
+    else  {
+	SET_STRING_ELT(ans, 0, mkChar(""));
+	if (!warned)
+	    warning(_("OS reports request to set locale to \"%s\" cannot be honored"),
+	            CHAR(STRING_ELT(locale, 0)));
+    }
     UNPROTECT(1);
     return ans;
 }

tests/reg-encodings.R

@@ -429,6 +429,21 @@ if(!is.null(lc <- lcct) && nzchar(lc)) Sys.setlocale("LC_CTYPE", lc) # revert
 ## <chars>(a1)[3:4] were different in R <= 4.6.0
 
 
+## Sys.[gs]etlocale() return non-ASCII locale names with known encoding
+if(onWindows && UTF8) local({
+    old <- Sys.getlocale("LC_TIME")
+    on.exit(Sys.setlocale("LC_TIME", old))
+
+    ## UCRT may expand this ASCII alias to a name containing "Bokm\u00e5l".
+    setloc <- suppressWarnings(Sys.setlocale("LC_TIME", "Norwegian_Norway.UTF-8"))
+    if(nzchar(setloc) && any(as.integer(charToRaw(setloc)) > 127L)) {
+	getloc <- Sys.getlocale("LC_TIME")
+	stopifnot(identical(Encoding(getloc), "UTF-8"),
+		  identical(Encoding(setloc), "UTF-8"))
+    }
+})
+
+
 
 
 ## PR#19112 -- writeChar() overflows its output buffer .. multibyte ..