drop attributes except names, class and levels

Author: ben-schwen

inst/tests/tests.Rraw

@@ -18430,8 +18430,12 @@ test(2251.41, frev(x), rev(x))
 test(2251.42, setrev(x), x)
 # attributes
 x = structure(1:10, class = c("IDate", "Date"), att = 1L)
-test(2251.51, attr(frev(x), "att"), 1L)
-test(2251.52, attr(setrev(x), "att"), 1L)
+test(2251.51, attr(frev(x), "att"), attr(rev(x), "att"))
+test(2251.52, class(frev(x)), class(rev(x)))
+test(2251.53, attr(setrev(x), "att"), 1L)
+test(2251.54, class(setrev(x)), c("IDate", "Date"))
+x = structure(integer(0), att = 1L)
+test(2251.55, attr(frev(x), "att"), attr(rev(x), "att"))
 # errors
 test(2251.61, frev(data.table()), error="should not be data.frame or data.table")
 test(2251.62, frev(expression(1)), error="is not supported by frev")

src/utils.c

@@ -425,6 +425,7 @@ SEXP startsWithAny(const SEXP x, const SEXP y, SEXP start) {
 }
 
 SEXP frev(SEXP x, SEXP copyArg) {
+  SEXP names, klass, levels;
   if (INHERITS(x, char_dataframe))
     error(_("'x' should not be data.frame or data.table."));
   if (!isNull(getAttrib(x, R_DimSymbol)))
@@ -513,7 +514,16 @@ SEXP frev(SEXP x, SEXP copyArg) {
   default:
     error(_("Type '%s' is not supported by frev"), type2char(TYPEOF(x)));
   }
-  SEXP names = getAttrib(x, R_NamesSymbol);
+  names = PROTECT(getAttrib(x, R_NamesSymbol));
+  klass = PROTECT(getAttrib(x, R_ClassSymbol));
+  levels = PROTECT(getAttrib(x, R_LevelsSymbol));
+  nprotect += 3;
+  if (copy) {
+    SET_ATTRIB(x, R_NilValue);
+    setAttrib(x, R_NamesSymbol, names);
+    setAttrib(x, R_ClassSymbol, klass);
+    setAttrib(x, R_LevelsSymbol, levels);
+  }
   if (!isNull(names)) {
     frev(names, ScalarLogical(FALSE));
   }