diff --git a/src/library/stats/src/model.c b/src/library/stats/src/model.c index ab27b5963a8..06143aeedeb 100644 --- a/src/library/stats/src/model.c +++ b/src/library/stats/src/model.c @@ -1749,6 +1749,13 @@ static int TermCode(SEXP termlist, SEXP thisterm, int whichbit, SEXP term) } +int isOffset(const char *s) { + if (!strncmp(s, "offset(", 7)) return 1; + if (strncmp(s, "stats::", 7)) return 0; + int callStart = strncmp(s+7, ":", 1) ? 7 : 8; + return !strncmp(s+callStart, "offset(", 7); +} + /* Internal code for the ``terms'' function */ /* The value is a formula with an assortment */ /* of useful attributes. */ @@ -1897,8 +1904,9 @@ SEXP termsform(SEXP args) /* first see if any of the variables are offsets */ R_xlen_t k = 0; - for (R_xlen_t l = response; l < nvar; l++) - if (!strncmp(CHAR(STRING_ELT(varnames, l)), "offset(", 7)) k++; + for (R_xlen_t l = response; l < nvar; l++) { + if (isOffset(CHAR(STRING_ELT(varnames, l)))) k++; + } if (k > 0) { #ifdef DEBUG_terms Rprintf(" step 2b: found k=%ld offset(.)s\n", k); @@ -1907,7 +1915,7 @@ SEXP termsform(SEXP args) /* allocate the "offsets" attribute */ SETCAR(a, v = allocVector(INTSXP, k)); for (int l = response, k = 0; l < nvar; l++) - if (!strncmp(CHAR(STRING_ELT(varnames, l)), "offset(", 7)) + if (isOffset(CHAR(STRING_ELT(varnames, l)))) INTEGER(v)[k++] = l + 1; SET_TAG(a, install("offset")); a = CDR(a); @@ -1923,7 +1931,7 @@ SEXP termsform(SEXP args) if(length(thisterm) == 0) break; for (int i = 1; i <= nvar; i++) if (GetBit(CAR(thisterm), i) && - !strncmp(CHAR(STRING_ELT(varnames, i-1)), "offset(", 7)) { + isOffset(CHAR(STRING_ELT(varnames, i-1)))) { have_offset = TRUE; #ifdef DEBUG_terms Rprintf(" i=%d: have_offset, ", i); diff --git a/src/library/stats/tests/offsets.R b/src/library/stats/tests/offsets.R index ac018cefd2d..0c9a7c85630 100644 --- a/src/library/stats/tests/offsets.R +++ b/src/library/stats/tests/offsets.R @@ -37,3 +37,10 @@ stopifnot(exprs = { is.null(model.weights(model.frame(fit5))) }) ## these were all (even the model fit!) wrong in R <= 4.2.1 + +## via formula, with stats:: namespace-qualification (#18706) +dropIrrelevant <- \(x) x[!names(x) %in% c("variables", ".Environment")] +termAttr1 <- dropIrrelevant(attributes(terms(y ~ 1 + offset(x)))) +termAttr2 <- dropIrrelevant(attributes(terms(y ~ 1 + stats::offset(x)))) +termAttr3 <- dropIrrelevant(attributes(terms(y ~ 1 + stats:::offset(x)))) +stopifnot(identical(termAttr1, termAttr2), identical(termAttr2, termAttr3))