Merge branch 'master' into openmp-doc

Author: MichaelChirico

.Rbuildignore

@@ -16,6 +16,7 @@
 ^\.devcontainer$
 ^\.graphics$
 ^\.github$
+^\.zed$
 
 ^\.gitlab-ci\.yml$
 
@@ -26,6 +27,7 @@
 ^src/Makevars$
 ^CODEOWNERS$
 ^GOVERNANCE\.md$
+^Seal_of_Approval\.md$
 
 ^\.RData$
 ^\.Rhistory$
@@ -45,3 +47,6 @@
 ^lib$
 ^library$
 ^devwd$
+
+# only the inst/po compressed files are needed, not raw .pot/.po
+^po$

.ci/.lintr.R

@@ -1,5 +1,5 @@
 dt_linters = new.env()
-for (f in list.files('.ci/linters', full.names=TRUE)) sys.source(f, dt_linters)
+for (f in list.files('.ci/linters/r', full.names=TRUE)) sys.source(f, dt_linters)
 rm(f)
 
 # NB: Could do this inside the linter definition, this separation makes those files more standardized

.ci/atime/tests.R

@@ -1,5 +1,7 @@
 # A list of performance tests.
 #
+# See documentation in https://github.com/Rdatatable/data.table/wiki/Performance-testing for best practices.
+#
 # Each entry in this list corresponds to a performance test and contains a sublist with three mandatory arguments:
 # - N: A numeric sequence of data sizes to vary.
 # - setup: An expression evaluated for every data size before measuring time/memory.
@@ -119,6 +121,42 @@ test.list <- atime::atime_test_list(
       data.table:::setDT(L)
     },
     Slow = "c4a2085e35689a108d67dacb2f8261e4964d7e12", # Parent of the first commit in the PR that fixes the issue (https://github.com/Rdatatable/data.table/commit/7cc4da4c1c8e568f655ab5167922dcdb75953801)
-    Fast = "1872f473b20fdcddc5c1b35d79fe9229cd9a1d15") # Last commit in the PR that fixes the issue (https://github.com/Rdatatable/data.table/pull/5427/commits)
-)
+    Fast = "1872f473b20fdcddc5c1b35d79fe9229cd9a1d15"), # Last commit in the PR that fixes the issue (https://github.com/Rdatatable/data.table/pull/5427/commits)
+
+  # Issue reported in: https://github.com/Rdatatable/data.table/issues/4200
+  # To be fixed in: https://github.com/Rdatatable/data.table/pull/4558
+  "DT[by] fixed in #4558" = atime::atime_test(
+    N = 10^seq(1, 20),
+    setup = {
+      d <- data.table(
+        id3 = sample(c(seq.int(N*0.9), sample( N*0.9, N*0.1, TRUE))),
+        v1 = sample(5L, N, TRUE),
+        v2 = sample(5L, N, TRUE)
+      )
+    },
+    expr = {
+      expr=data.table:::`[.data.table`(d, , max(v1) - min(v2), by = id3)
+    },
+    Before = "7a9eaf62ede487625200981018d8692be8c6f134", # Parent of the first commit (https://github.com/Rdatatable/data.table/commit/515de90a6068911a148e54343a3503043b8bb87c) in the PR (https://github.com/Rdatatable/data.table/pull/4164/commits) that introduced the regression
+    Regression = "c152ced0e5799acee1589910c69c1a2c6586b95d", # Parent of the first commit (https://github.com/Rdatatable/data.table/commit/15f0598b9828d3af2eb8ddc9b38e0356f42afe4f) in the PR (https://github.com/Rdatatable/data.table/pull/4558/commits) that fixes the regression
+    Fixed = "f750448a2efcd258b3aba57136ee6a95ce56b302"), # Second commit of the PR (https://github.com/Rdatatable/data.table/pull/4558/commits) that fixes the regression
+
+  # Issue with sorting again when already sorted: https://github.com/Rdatatable/data.table/issues/4498
+  # Fixed in: https://github.com/Rdatatable/data.table/pull/4501
+  "DT[,.SD] improved in #4501" = atime::atime_test(
+    N = 10^seq(1, 10, by=0.5),
+    setup = {
+      set.seed(1)
+      L = as.data.table(as.character(rnorm(N, 1, 0.5)))
+      setkey(L, V1)
+    },
+    ## New DT can safely retain key.
+    expr = {
+      data.table:::`[.data.table`(L, , .SD)
+    },
+    Fast = "353dc7a6b66563b61e44b2fa0d7b73a0f97ca461", # Close-to-last merge commit in the PR (https://github.com/Rdatatable/data.table/pull/4501/commits) that fixes the issue 
+    Slow = "3ca83738d70d5597d9e168077f3768e32569c790", # Circa 2024 master parent of close-to-last merge commit (https://github.com/Rdatatable/data.table/commit/353dc7a6b66563b61e44b2fa0d7b73a0f97ca461) in the PR (https://github.com/Rdatatable/data.table/pull/4501/commits) that fixes the issue 
+    Slower = "cacdc92df71b777369a217b6c902c687cf35a70d"), # Circa 2020 parent of the first commit (https://github.com/Rdatatable/data.table/commit/74636333d7da965a11dad04c322c752a409db098) in the PR (https://github.com/Rdatatable/data.table/pull/4501/commits) that fixes the issue 
+
+  NULL)
 # nolint end: undesirable_operator_linter.

.ci/linters/c/alloc_linter.R

@@ -0,0 +1,36 @@
+# Ensure that we check the result of malloc()/calloc() for success
+# More specifically, given that this is an AST-ignorant checker,
+#   1. Find groups of malloc()/calloc() calls
+#   2. Check the next line for a check like 'if (!x || !y)'
+alloc_linter = function(c_obj) {
+  lines = c_obj$lines
+  # Be a bit more precise to avoid mentions in comments
+  alloc_lines = grep(R"{=\s*([(]\w+\s*[*][)])?[mc]alloc[(]}", lines)
+  if (!length(alloc_lines)) return()
+  # int *tmp=(int*)malloc(...); or just int tmp=malloc(...);
+  alloc_keys = lines[alloc_lines] |>
+    strsplit(R"(\s*=\s*)") |>
+    vapply(head, 1L, FUN.VALUE="") |>
+    trimws() |>
+    # just normalize the more exotic assignments, namely 'type *restrict key = ...'
+    gsub(pattern = "[*]\\s*(restrict\\s*)?", replacement = "*") |>
+    strsplit("*", fixed=TRUE) |>
+    vapply(tail, 1L, FUN.VALUE="")
+  alloc_grp_id = cumsum(c(TRUE, diff(alloc_lines) != 1L))
+
+  # execute by group
+  tapply(seq_along(alloc_lines), alloc_grp_id, function(grp_idx) {
+    keys_regex = paste0("\\s*!\\s*", alloc_keys[grp_idx], "\\s*", collapse = "[|][|]")
+    check_regex = paste0("if\\s*\\(", keys_regex)
+    check_line = lines[alloc_lines[tail(grp_idx, 1L)] + 1L]
+    # Rarely (once in fread.c as of initialization), error checking is handled
+    #   but not immediately, so use 'NOCHECK' to escape.
+    if (!grepl(check_regex, check_line) && !grepl("NOCHECK", check_line, fixed=TRUE)) {
+      bad_lines_idx = seq(alloc_lines[grp_idx[1L]], length.out=length(grp_idx)+1L)
+      cat("FILE: ", c_obj$path, "; LINES: ", head(bad_lines_idx, 1L), "-", tail(bad_lines_idx, 1L), "\n", sep="")
+      writeLines(lines[bad_lines_idx])
+      cat(strrep("-", max(nchar(lines[bad_lines_idx]))), "\n", sep="")
+      stop("Expected the malloc()/calloc() usage above to be followed immediately by error checking.", call.=FALSE)
+    }
+  })
+}

.ci/linters/c/omp_set_nested_linter.R

@@ -0,0 +1,11 @@
+# Ensure no calls to omp_set_nested() as
+#   i) it's hard to fully honor OMP_THREAD_LIMIT as required by CRAN, and
+#   ii) a simpler non-nested approach is always preferable if possible, as has been the case so far
+omp_set_nested_linter = function(c_obj) {
+  idx = grep("omp_set_nested", c_obj$lines, fixed=TRUE)
+  if (!length(idx)) return()
+  stop(sprintf(
+    "In %s, found omp_set_nested() usage, please reconsider:\n%s",
+    c_obj$path, paste0("  ", format(idx), ":", c_obj$lines[idx], collapse = "\n")
+  ))
+}

.ci/linters/c/omp_set_num_threads_linter.R

@@ -0,0 +1,11 @@
+# Ensure no calls to omp_set_num_threads() [to avoid affecting other packages and base R]
+# Only comments referring to it should be in openmp-utils.c
+omp_set_num_threads_linter = function(c_obj) {
+  # strip comments, we only care if the function appears in actual code.
+  idx = grep("omp_set_num_threads", c_obj$preprocessed, fixed = TRUE)
+  if (!length(idx)) return()
+  stop(sprintf(
+    "In %s, found omp_set_num_threads() usage, which could affect other packages and base R:\n%s",
+    c_obj$path, paste0("  ", format(idx), ":", c_obj$preprocessed[idx], collapse = "\n")
+  ))
+}

.ci/linters/md/news_linter.R

@@ -0,0 +1,61 @@
+any_mismatch = FALSE
+
+# ensure that numbered list in each section is in sequence
+check_section_numbering = function(news) {
+  # plain '#' catches some examples; 'd' for 'data.table'
+  sections = grep("^#+ [A-Zd]", news)
+  entries = grep("^[0-9]+[.]", news)
+  entry_value = as.integer(gsub("^([0-9]+)[.].*", "\\1", news[entries]))
+  section_id = findInterval(entries, sections)
+  
+  any_mismatch = FALSE
+  for (id in unique(section_id)) {
+    section_entries = entry_value[section_id == id]
+    intended_value = seq_along(section_entries)
+    matched = section_entries == intended_value
+    if (all(matched)) next
+    any_mismatch = TRUE
+    section_header = news[sections[id]]
+    cat(sprintf(
+      "In section '%s' (line %d), bad numbering:\n%s\n",
+      section_header, sections[id],
+      paste0("  [", section_entries[!matched], " --> ", intended_value[!matched], "]", collapse="\n")
+    ))
+  }
+  return(any_mismatch)
+}
+
+# ensure that GitHub link text & URL actually agree
+check_gh_links = function(news) {
+  gh_links_info = gregexpr(
+    "\\[#(?<md_number>[0-9]+)\\]\\(https://github.com/Rdatatable/data.table/(?<link_type>[^/]+)/(?<link_number>[0-9]+)\\)",
+    news,
+    perl=TRUE # required for within-group indices
+  )
+  gh_link_metadata = do.call(rbind, lapply(seq_along(gh_links_info), function(idx) {
+    x = gh_links_info[[idx]]
+    if (x[1L] <= 0L) return(NULL)
+    match_mat = attr(x, "capture.start") # matrix seeded with the correct dimensions
+    match_mat[] = substring(news[idx], match_mat, match_mat + attr(x, "capture.length") - 1L)
+    match_df = data.frame(match_mat)
+    match_df$line_number = idx
+    match_df
+  }))
+  matched = gh_link_metadata$md_number == gh_link_metadata$link_number
+  if (all(matched)) return(FALSE)
+
+  cat(sep = "", with(gh_link_metadata[!matched, ], sprintf(
+    "In line %d, link pointing to %s %s is written #%s\n",
+    line_number, link_type, link_number, md_number
+  )))
+  return(TRUE)
+}
+
+any_error = FALSE
+for (news in list.files(pattern = "NEWS")) {
+  cat(sprintf("Checking NEWS file %s...\n", news))
+  news_lines = readLines(news)
+  any_error = check_section_numbering(news_lines) || any_error
+  any_error = check_gh_links(news_lines) || any_error
+}
+if (any_error) stop("Please fix the NEWS issues above.")

.ci/linters/po/msgfmt_linter.R

@@ -0,0 +1,42 @@
+# Use msgfmt to check for untranslated/fuzzy messages, and for whether
+#   the implied .mo compiled form matches that which is already checked in
+msgfmt_linter <- function(po_file) {
+  mo_tmp <- tempfile()
+  on.exit(unlink(mo_tmp))
+
+  res = system2("msgfmt", c("--statistics", po_file, "-o", mo_tmp), stdout=TRUE, stderr=TRUE)
+  if (any(grepl("untranslated message|fuzzy translation", res))) {
+    cat(sprintf("In %s, found incomplete translations:\n%s\n", po_file, paste(res, collapse="\n")))
+    stop("Please fix.")
+  }
+
+  mo_ref = sprintf(
+    "inst/%s/LC_MESSAGES/%sdata.table.mo",
+    gsub("^R-|[.]po$", "", po_file),
+    if (startsWith(basename(po_file), "R-")) "R-" else ""
+  )
+
+  if (!file.exists(mo_ref)) {
+    stop(po_file, " has not been compiled as ", mo_ref, ". Please fix.")
+  }
+  if (tools::md5sum(mo_ref) == tools::md5sum(mo_tmp)) return(invisible())
+
+  # NB: file.mtime() will probably be wrong, it will reflect the check-out time of the git repo.
+  last_edit_time = system2("git",
+    c("log", "-1", '--format="%ad"', "--date=format:'%Y-%m-%d %H:%M:%S'", "--", mo_ref),
+    stdout=TRUE
+  )
+  cat(sprintf(
+    ".mo compilation %s of .po translation %s appears out of date! It was last updated %s\n",
+    mo_ref, po_file, last_edit_time
+  ))
+
+  unmo_tmp = tempfile()
+  unmo_ref = tempfile()
+  on.exit(unlink(c(unmo_tmp, unmo_ref), add=TRUE))
+  system2("msgunfmt", c(mo_tmp, "-o", unmo_tmp))
+  system2("msgunfmt", c(mo_ref, "-o", unmo_ref))
+  cat("Here are the observed differences after converting back to .po:\n\n")
+  system2("diff", c(unmo_tmp, unmo_ref))
+  stop("Please fix.")
+}

.ci/linters/po/tools_check_linter.R

@@ -0,0 +1,7 @@
+tools_check_linter = function(po_file) {
+  res = tools::checkPoFile(po_file, strictPlural=TRUE)
+  if (NROW(res)) {
+    print(res)
+    stop("Fix the above .po file issues.")
+  }
+}

.ci/linters/po/utf8_linter.R

@@ -0,0 +1,4 @@
+utf8_linter <- function(po_file) {
+  if (!any(grepl("charset=UTF-8", readLines(po_file), fixed=TRUE)))
+    stop("In ", po_file, ", please use charset=UTF-8.")
+}