only coerce UTF8 factors if needed

Author: ben-schwen

inst/tests/tests.Rraw

@@ -21265,6 +21265,9 @@ DT[1, V1 := samelevel]
 test(2311.1, nlevels(DT$V1), 1L) # used to be 2
 DT[1, V1 := factor("a", levels = c("a", samelevel))]
 test(2311.2, nlevels(DT$V1), 2L) # used to be 3
+# runs instant without regression but takes ages with #7404
+dt = data.table(id = as.factor(rep(seq_len(1e6), each = 100)), V1 = 1)
+test(2311.3, dt[, base::max(V1, na.rm = TRUE), by = id], dt[, max(V1), by = id])
 
 # avoid translateChar*() in OpenMP threads, #6883
 DF = list(rep(iconv("\uf8", from = "UTF-8", to = "latin1"), 2e6))

src/assign.c

@@ -755,10 +755,14 @@ const char *memrecycle(const SEXP target, const SEXP where, const int start, con
       SEXP targetLevels = PROTECT(getAttrib(target, R_LevelsSymbol)); protecti++;
       SEXP sourceLevels = source;  // character source
       if (sourceIsFactor) { sourceLevels=PROTECT(getAttrib(source, R_LevelsSymbol)); protecti++; }
-      sourceLevels = PROTECT(coerceUtf8IfNeeded(sourceLevels)); protecti++;
-      if (!sourceIsFactor || !R_compute_identical(sourceLevels, targetLevels, 0)) {  // !sourceIsFactor for test 2115.6
-        const int nTargetLevels=length(targetLevels), nSourceLevels=length(sourceLevels);
+      bool needUtf8Coerce = !sourceIsFactor || !R_compute_identical(sourceLevels, targetLevels, 0);
+      if (needUtf8Coerce) {
+        sourceLevels = PROTECT(coerceUtf8IfNeeded(sourceLevels)); protecti++;
         targetLevels = PROTECT(coerceUtf8IfNeeded(targetLevels)); protecti++;
+        if (sourceIsFactor && R_compute_identical(sourceLevels, targetLevels, 0)) needUtf8Coerce = false;
+      }
+      if (needUtf8Coerce) {
+        const int nTargetLevels=length(targetLevels), nSourceLevels=length(sourceLevels);
         const SEXP *targetLevelsD=STRING_PTR_RO(targetLevels), *sourceLevelsD=STRING_PTR_RO(sourceLevels);
         SEXP newSource = PROTECT(allocVector(INTSXP, length(source))); protecti++;
         savetl_init();