WIP: convert test-translate-package to snapshots

DESCRIPTION

@@ -5,7 +5,7 @@ Version: 0.2.3
 Author: Michael Chirico
 Depends: R (>= 4.0.0)
 Imports: data.table
-Suggests: crayon, knitr, rmarkdown, testthat (>= 3.0.0)
+Suggests: crayon, knitr, mockery, rmarkdown, testthat (>= 3.0.0)
 SystemRequirements: gettext
 Maintainer: Michael Chirico <MichaelChirico4@gmail.com>
 Description: Translating messages in R packages is managed using the po top-level directory and the 'gettext' program. This package provides some helper functions for building this support in R packages, e.g. common validation & I/O tasks.

R/find_fuzzy_messages.R

@@ -2,7 +2,7 @@ find_fuzzy_messages <- function(message_data, lang_file) {
   old_message_data = get_po_messages(lang_file)
 
   if (any(idx <- old_message_data$fuzzy == 2L)) {
-    messagef('Found %d translations marked as deprecated in %s.', sum(idx), lang_file)
+    messagef('Found %d translations marked as deprecated in ./po/%s.', sum(idx), basename(lang_file))
     message('Typically, this means the corresponding error messages have been refactored.')
     message('Reproducing these messages here for your reference since they might still provide some utility.')
 

R/msgmerge.R

@@ -1,8 +1,11 @@
 # split off from tools::update_pkg_po() to only run the msgmerge & checkPoFile steps
-run_msgmerge = function(po_file, pot_file) {
-  if (system(sprintf("msgmerge --update %s %s", po_file, shQuote(pot_file))) != 0L) {
+run_msgmerge = function(po_file, pot_file, verbose) {
+  val = system2("msgmerge", c("--update", shQuote(po_file), shQuote(pot_file)), stdout = TRUE, stderr = TRUE)
+  if (!identical(attr(val, "status", exact = TRUE), NULL)) {
     # nocov these warnings? i don't know how to trigger them as of this writing.
-    warningf("Running msgmerge on '%s' failed.", po_file)
+    warningf("Running msgmerge on './po/%s' failed:\n  %s", basename(po_file), paste(val, collapse = "\n"))
+  } else if (verbose) {
+    messagef("Running msgmerge on './po/%s' succeeded:\n  %s", basename(po_file), paste(val, collapse = "\n"))
   }
 
   res <- tools::checkPoFile(po_file, strictPlural = TRUE)
@@ -14,19 +17,24 @@ run_msgmerge = function(po_file, pot_file) {
 }
 
 run_msgfmt = function(po_file, mo_file, verbose) {
-  use_stats <- if (verbose) '--statistics' else ''
-  # See #218. Solaris msgfmt doesn't support -c or --statistics
-  if (Sys.info()[["sysname"]] == "SunOS") {
-    cmd = sprintf("msgfmt -o %s %s", shQuote(mo_file), shQuote(po_file)) # nocov
-  } else {
-    cmd = sprintf("msgfmt -c %s -o %s %s", use_stats, shQuote(mo_file), shQuote(po_file))
+  # See #218. Solaris msgfmt (non-GNU on CRAN) doesn't support --check or --statistics;
+  #   see also https://bugs.r-project.org/show_bug.cgi?id=18150
+  args = character()
+  if (is_gnu_gettext()) {
+    args = c("--check", if (verbose) '--statistics')
   }
-  if (system(cmd) != 0L) {
+  val = system2("msgfmt", c(args, "-o", shQuote(mo_file), shQuote(po_file)), stdout = TRUE, stderr = TRUE)
+  if (!identical(attr(val, "status", exact = TRUE), NULL)) {
     warningf(
-      "running msgfmt on %s failed.\nHere is the po file:\n%s",
-      basename(po_file), paste(readLines(po_file), collapse = "\n"),
+      "running msgfmt on %s failed; output:\n  %s\nHere is the po file:\n%s",
+      basename(po_file), paste(val, collapse = "\n"), paste(readLines(po_file), collapse = "\n"),
       immediate. = TRUE
     )
+  } else if (verbose) {
+    messagef(
+      "running msgfmt on %s succeeded; output:\n  %s",
+      basename(po_file), paste(val, collapse = "\n")
+    )
   }
   return(invisible())
 }
@@ -58,15 +66,16 @@ update_en_quot_mo_files <- function(dir, verbose) {
   mo_dir <- file.path(dir, "inst", "po", "en@quot", "LC_MESSAGES")
   dir.create(mo_dir, recursive = TRUE, showWarnings = FALSE)
   for (pot_file in pot_files) {
-    po_file <- tempfile()
+    # don't use tempfile() -- want a static basename() to keep verbose output non-random
+    po_file <- file.path(tempdir(), if (startsWith(basename(pot_file), "R-")) "R-en@quot.po" else "en@quot.po")
+    on.exit(unlink(po_file))
     # tools:::en_quote is blocked, but we still need it for now
     get("en_quote", envir=asNamespace("tools"))(pot_file, po_file)
     run_msgfmt(
       po_file = po_file,
       mo_file = file.path(mo_dir, gsub("\\.pot$", ".mo", basename(pot_file))),
       verbose = verbose
     )
-    unlink(po_file)
   }
   return(invisible())
 }

R/translate_package.R

@@ -44,7 +44,7 @@ translate_package = function(
       messagef(
         "Updating translation template for package '%s' (last updated %s)",
         package,
-        format(file.info(r_potfile)$atime)
+        get_atime(r_potfile)
       )
     } else {
       messagef("Starting translations for package '%s'", package)
@@ -110,11 +110,11 @@ translate_package = function(
     if (update && file.exists(lang_file)) {
       if (verbose) {
         messagef(
-          'Found existing R translations for %s (%s/%s) in %s. Running msgmerge...',
-          language, metadata$full_name_eng, metadata$full_name_native, lang_file
+          'Found existing R translations for %s (%s/%s) in ./po/%s. Running msgmerge...',
+          language, metadata$full_name_eng, metadata$full_name_native, basename(lang_file)
         )
       }
-      run_msgmerge(lang_file, r_potfile)
+      run_msgmerge(lang_file, r_potfile, verbose)
 
       find_fuzzy_messages(message_data, lang_file)
     } else {
@@ -125,11 +125,11 @@ translate_package = function(
     if (update && file.exists(lang_file)) {
       if (verbose) {
         messagef(
-          'Found existing src translations for %s (%s/%s) in %s. Running msgmerge...',
-          language, metadata$full_name_eng, metadata$full_name_native, lang_file
+          'Found existing src translations for %s (%s/%s) in ./po/%s. Running msgmerge...',
+          language, metadata$full_name_eng, metadata$full_name_native, basename(lang_file)
         )
       }
-      run_msgmerge(lang_file, src_potfile)
+      run_msgmerge(lang_file, src_potfile, verbose)
 
       find_fuzzy_messages(message_data, lang_file)
     } else {

R/utils.R

@@ -156,3 +156,8 @@ get_lang_metadata = function(language) {
 }
 
 is_testing = function() identical(Sys.getenv("TESTTHAT"), "true")
+
+is_gnu_gettext = function() any(grepl("GNU gettext", system('gettext --version', intern=TRUE)))
+
+# wrapper function to facilitate mocking, else tests --> stochastic output
+get_atime <- function(f) format(file.info(f, extra_cols = FALSE)$atime)