altsxp: two fixes from the fifteenth review round

- The one-argument seq() over a length-1 opaque value asks the class for
  1:x, and the class declines for an NA endpoint.  Control then fell into
  the "one element, so count along it" branch and answered 1L, where the
  same call on an ordinary NA is an error.  A numeric opaque vector now
  takes the length-1 endpoint route instead; a non-numeric one still
  falls through, since 1L is what base R answers for any other length-1
  object.  seq() never showed this because seq.default checks is.finite()
  in R first -- seq.int() goes straight to do_seq.

- R_altsxp_format_common() allocated a scratch buffer per padded element
  inside one vmaxget/vmaxset pair, so a whole pass held O(n * w) bytes
  that were dead as soon as mkChar() had copied them out.  One buffer,
  sized from the widest rendering measured in the pass that already
  measures the widest column: formatting 2e6 int64 values went from 84 MB
  of Vcells to 53 MB, with identical output.

Author: kevinushey

src/main/altrep.c

@@ -1097,17 +1097,29 @@ attribute_hidden SEXP R_altsxp_format_common(SEXP fmt, Rboolean trim, int width)
     const char *na = CHAR(R_print.na_string);
     int na_w = R_print.na_width;
     int w = 0;
+    /* the widest rendering in bytes, which is not the widest in columns once
+       a multibyte encoding is in play */
+    size_t maxb = strlen(na);
 
     for (R_xlen_t i = 0; i < n; i++) {
 	SEXP e = STRING_ELT(fmt, i);
 	int wi = (e == NA_STRING) ? na_w : Rstrlen(e, 0);
 	if (wi > w) w = wi;
+	if (e != NA_STRING) {
+	    size_t b = strlen(CHAR(e));
+	    if (b > maxb) maxb = b;
+	}
     }
     if (trim) w = 0;
     if (w < width) w = width;
 
     SEXP ans = PROTECT(allocVector(STRSXP, n));
     const void *vmax = vmaxget();
+    /* One buffer for the whole pass: mkChar() copies out of it immediately,
+       so the bytes are dead by the next iteration.  Allocating per element
+       would hold O(n * w) of them live until the vmaxset() below. */
+    size_t bufsz = (size_t) w + maxb + 1;
+    char *buf = R_alloc(bufsz, 1);
     for (R_xlen_t i = 0; i < n; i++) {
 	SEXP e = STRING_ELT(fmt, i);
 	const char *s = (e == NA_STRING) ? na : CHAR(e);
@@ -1116,8 +1128,7 @@ attribute_hidden SEXP R_altsxp_format_common(SEXP fmt, Rboolean trim, int width)
 	if (wi >= w)
 	    SET_STRING_ELT(ans, i, (e == NA_STRING) ? mkChar(s) : e);
 	else {
-	    char *buf = R_alloc((size_t) w + strlen(s) + 1, 1);
-	    snprintf(buf, (size_t) w + strlen(s) + 1, "%*s%s", w - wi, "", s);
+	    snprintf(buf, bufsz, "%*s%s", w - wi, "", s);
 	    SET_STRING_ELT(ans, i, mkChar(buf));
 	}
     }

src/main/seq.c

@@ -998,6 +998,21 @@ attribute_hidden SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)
 	    ans = altsxp_seq(call, one, from, NULL);
 	    UNPROTECT(1);
 	    if(ans != NULL) goto done;
+
+	    /* The class declined: an NA endpoint, or no exact arithmetic to
+	       do it with.  A numeric one is still an endpoint, so it takes
+	       the length-1 route below rather than the "one element, so
+	       count along it" branch, which would answer 1L for
+	       seq.int(as.int64(NA)) where seq.int(NA_integer_) is an error.
+	       A non-numeric opaque vector does fall through, since 1L is
+	       what base R answers for any other length-1 object. */
+	    if(isNumeric(from)) {
+		double rfrom = asReal(from);
+		if (!R_FINITE(rfrom))
+		    errorcall(call, _("'%s' must be a finite number"), "from");
+		ans = seq_colon(1.0, rfrom, call);
+		goto done;
+	    }
 	}
 	if(lf == 1 && (TYPEOF(from) == INTSXP || TYPEOF(from) == REALSXP)) {
 	    double rfrom = asReal(from);

tests/altsxp.R

@@ -2396,6 +2396,26 @@ local({
               identical(sort(dec, decreasing = TRUE), dec))
 })
 
+## The one-argument seq() over an opaque value asks the class for 1:x, and
+## the class declines for an NA endpoint.  Control then fell into the "one
+## element, so count along it" branch and answered 1L, where the same call on
+## an ordinary NA is an error.  seq() itself never showed it -- seq.default
+## checks is.finite() in R first -- but seq.int() goes straight to the C.
+local({
+    ref <- tryCatch(seq.int(NA_integer_), error = conditionMessage)
+    for (v in list(as.int64(NA), as.uint64(NA)))
+        stopifnot(identical(tryCatch(seq.int(v), error = conditionMessage), ref),
+                  identical(tryCatch(seq(v), error = conditionMessage), ref))
+
+    ## the cases that do work are unchanged, and still exact
+    stopifnot(identical(as.double(seq.int(as.int64(5))), c(1, 2, 3, 4, 5)),
+              identical(as.double(seq.int(as.int64(-3))), c(1, 0, -1, -2, -3)),
+              identical(typeof(seq.int(as.int64(5))), "int64"),
+              identical(as.double(seq.int(as.int64(0))), c(1, 0)),
+              ## a length > 1 argument counts along it, as for any vector
+              identical(seq.int(as.int64(c(4, 9))), 1:2))
+})
+
 ## --- generic ALTSXP region-contract regressions ----------------------
 
 ## Source-tree tests build a tiny pointer-less ALTSXP class whose Get/Set