patch from Martin Maechler

src/include/Rinternals.h

@@ -129,8 +129,8 @@ typedef unsigned int SEXPTYPE;
 #define EXTPTRSXP 22 /* external pointer */
 #define WEAKREFSXP 23 /* weak reference */
 #define RAWSXP 24 /* raw bytes */
-#define OBJSXP 25 /* Object, non-vector */
-#define S4SXP 25 /* Same as OBJSXP, name retained for backwards compatability */
+#define OBJSXP 25 /* object, non-vector */
+#define S4SXP 25 /* same as OBJSXP, retained for back compatability */
 
 /* used for detecting PROTECT issues in memory.c */
 #define NEWSXP 30 /* fresh node created in new page */

src/main/coerce.c

@@ -1955,11 +1955,10 @@ Rcomplex asComplex(SEXP x)
 attribute_hidden SEXP do_typeof(SEXP call, SEXP op, SEXP args, SEXP rho)
 {
  checkArity(op, args);
- SEXP x = CAR(args);
- if(TYPEOF(x) == OBJSXP && !IS_S4_OBJECT(x))
- return mkString("object");
- else
- return type2rstr(TYPEOF(x));
+ if(TYPEOF(CAR(args)) == OBJSXP && !IS_S4_OBJECT(CAR(args)))
+ return mkString("object");
+ else
+ return type2rstr(TYPEOF(CAR(args)));
 }
 
 /* Define many of the <primitive> "is.xxx" functions :

src/main/memory.c

@@ -215,7 +215,7 @@ const char *sexptype2char(SEXPTYPE type) {
  case BCODESXP: return "BCODESXP";
  case EXTPTRSXP: return "EXTPTRSXP";
  case WEAKREFSXP: return "WEAKREFSXP";
- case OBJSXP: return "OBJSXP";
+ case OBJSXP: return "OBJSXP"; /* was S4SXP */
  case RAWSXP: return "RAWSXP";
  case NEWSXP: return "NEWSXP"; /* should never happen */
  case FREESXP: return "FREESXP";

src/main/print.c

@@ -1,6 +1,6 @@
 /*
  * R : A Computer Language for Statistical Data Analysis
- * Copyright (C) 2000-2022 The R Core Team.
+ * Copyright (C) 2000-2023 The R Core Team.
  * Copyright (C) 1995-1998 Robert Gentleman and Ross Ihaka.
  *
  * This program is free software; you can redistribute it and/or modify
@@ -968,15 +968,15 @@ attribute_hidden void PrintValueRec(SEXP s, R_PrintData *data)
  Rprintf("<weak reference>\n");
  break;
  case OBJSXP:
-  if(IS_S4_OBJECT(s)) {
- /* we got here because no show method, usually no class.
-  Print the "slots" as attributes, since we don't know the class.
- */
-  Rprintf("<S4 Type Object>\n");
- } else {
-  /* OBJSXP type, S4 obj bit not set*/
-  Rprintf("<object>\n");
- }
+ if(IS_S4_OBJECT(s)) {
+ /* we got here because no show method, usually no class.
+  Print the "slots" as attributes, since we don't know the class.
+ */
+ Rprintf("<S4 Type Object>\n");
+ } else {
+ /* OBJSXP type, S4 obj bit not set*/
+ Rprintf("<object>\n");
+ }
  break;
  default:
  UNIMPLEMENTED_TYPE("PrintValueRec", s);

src/main/util.c

@@ -219,6 +219,7 @@ TypeTable[] = {
  { "weakref", WEAKREFSXP },
  { "raw", RAWSXP },
  { "S4", S4SXP },
+ { "object", OBJSXP }, /* == S4SXP */
  /* aliases : */
  { "numeric", REALSXP },
  { "name", SYMSXP },
@@ -234,6 +235,9 @@ SEXPTYPE str2type(const char *s)
  if (!strcmp(s, TypeTable[i].str))
  return (SEXPTYPE) TypeTable[i].type;
  }
+ if (!strcmp(s, "object"))
+ return (SEXPTYPE) OBJSXP;
+
  /* SEXPTYPE is an unsigned int, so the compiler warns us w/o the cast. */
  return (SEXPTYPE) -1;
 }