move check to internal installAttrib() preventing e.g. also attr<- to mutate primitives via attributes

git-svn-id: https://svn.r-project.org/R/trunk@88060 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: maechler

src/library/base/man/attr.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/attr.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2017 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{attr}
@@ -25,7 +25,9 @@ attr(x, which) <- value
 \details{
   These functions provide access to a single attribute of an object.
   The replacement form causes the named attribute to take the value
-  specified (or create a new attribute with the value given).
+  specified (or create a new attribute with the value given), unless
+  the object is \code{\link{NULL}}, a \code{\link{symbol}} (aka \sQuote{\code{name}})
+  or a \code{\link{primitive}} function.
 
   The extraction function first looks for an exact match to \code{which}
   amongst the attributes of \code{x}, then (unless \code{exact = TRUE})
@@ -67,5 +69,8 @@ attr(x, which) <- value
 # create a 2 by 5 matrix
 x <- 1:10
 attr(x,"dim") <- c(2, 5)
+
+S <- sum
+try( attr(S, "foo") <- NA ) # no longer possible to mutate primitive functions
 }
 \keyword{attribute}

src/library/base/man/attributes.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/attributes.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2018 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{attributes}
@@ -20,13 +20,15 @@ attributes(x) <- value
 mostattributes(x) <- value
 }
 \arguments{
-  \item{x}{any \R object.}
+  \item{x}{any \R object; for the replacement functions, not a
+    \code{\link{symbol}} (aka \sQuote{\code{name}}) nor a \code{\link{primitive}} function.}
   \item{value}{an appropriate named \code{\link{list}} of attributes, or
     \code{NULL}.}
 }
 \details{
-  Unlike \code{\link{attr}} it is not an error to set attributes on a
-  \code{NULL} object: it will first be coerced to an empty list.
+  Unlike \code{\link{attr}} it is currently not an error to set attributes
+  on a \code{NULL} object: it will first be coerced to an empty
+  \code{\link{list}}.
 
   Note that some attributes (namely \code{\link{class}},
   \code{\link{comment}}, \code{\link{dim}}, \code{\link{dimnames}},

src/main/attrib.c

@@ -353,10 +353,18 @@ static SEXP installAttrib(SEXP vec, SEXP name, SEXP val)
 {
     SEXP t = R_NilValue; /* -Wall */
 
-    if(TYPEOF(vec) == CHARSXP)
+    switch(TYPEOF(vec)) {
+    case CHARSXP:
 	error("cannot set attribute on a CHARSXP");
-    if (TYPEOF(vec) == SYMSXP)
-	error(_("cannot set attribute on a symbol"));
+	break;
+    case SYMSXP:
+    case BUILTINSXP:
+    case SPECIALSXP:
+	error(_("cannot set attribute on a '%s'"), R_typeToChar(vec));
+    default:
+	break;
+    }
+
     /* this does no allocation */
     for (SEXP s = ATTRIB(vec); s != R_NilValue; s = CDR(s)) {
 	if (TAG(s) == name) {
@@ -1348,8 +1356,6 @@ attribute_hidden SEXP do_attributesgets(SEXP call, SEXP op, SEXP args, SEXP env)
     /* Do checks before duplication */
     if (!isNewList(attrs))
 	error(_("attributes must be a list or NULL"));
-    if (isPrimitive(object))
-	error(_("Cannot modify attributes on primitive functions"));
     int i, nattrs = length(attrs);
     if (nattrs > 0) {
 	names = getAttrib(attrs, R_NamesSymbol);

tests/reg-tests-1e.R

@@ -1916,7 +1916,10 @@ stopifnot(is.primitive(sum))
 msum <- sum
 assertErrV(void <- structure(sum, foo = TRUE))
 assertErrV(attributes(msum) <- list(foo = NA))
-## both examples, the first a special case of the 2nd, did not error, but *modified* the base::sum primitive
+## a few days later:  Disable working via  attr(*, "<name>") <- value  as well:
+assertErrV( attr(msum, "foo") <- NA )
+stopifnot(identical(sum, msum), is.null(attributes(msum)))
+## all 3 examples, the first a special case of the 2nd, did not error, but *modified* the base::sum primitive