Ticket #32837: patch-rkward-rbackend-rkstructuregetter.cpp.diff

rkward/rbackend/rkstructuregetter.cpp

@@ -193 +193 @@
 
         // get classes
         SEXP classes_s;
+        QStringList classes;
 
         if ((TYPEOF (value) == LANGSXP) || (TYPEOF (value) == SYMSXP)) {        // if it's a call, we should NEVER send it through eval
-                extern SEXP R_data_class (SEXP, Rboolean);
-                classes_s = R_data_class (value, (Rboolean) 0);
+                // stripped down and adjusted from R_data_class
+                PROTECT (classes_s = Rf_getAttrib (value, R_ClassSymbol));
+                if (Rf_length (classes_s)) classes = RKRSupport::SEXPToStringList(classes_s);
+                UNPROTECT (1);
+                if (classes.isEmpty ()) {
+                        if (TYPEOF (value) == LANGSXP) {
+                                SEXP symb = PROTECT (CAR (value));
+                                QString cl;
+                                if (TYPEOF (symb) == SYMSXP) cl = CHAR (PRINTNAME (symb));
+                                UNPROTECT (1);
+                                if ((cl != "if") && (cl != "while") && (cl != "for") && (cl != "=") && (cl != "<-") && (cl != "(") && (cl != "{")) cl = "call";
+                                classes = QStringList (cl);
+                        } else {
+                                classes = QStringList ("name");
+                        }
+                }
 
                 REPROTECT (value = Rf_coerceVector (value, EXPRSXP), value_index);      // make sure the object is safe for everything to come
-
-                PROTECT (classes_s);
         } else {
-                classes_s = RKRSupport::callSimpleFun (class_fun, value, baseenv);
-                PROTECT (classes_s);
+                PROTECT (classes_s = RKRSupport::callSimpleFun (class_fun, value, baseenv));
+                classes = RKRSupport::SEXPToStringList (classes_s);
+                UNPROTECT (1);
         }
 
-        QStringList classes = RKRSupport::SEXPToStringList (classes_s);
-        UNPROTECT (1);  /* classes_s */
-
         // store classes
         RData *classdata = new RData;
         classdata->setData (classes);