Handle inheritance for S4 objects

r-lib · Nov 30, 2023 · dcad635 · dcad635
1 parent 6d4c8e0
commit dcad635
Showing 1 changed file with 24 additions and 0 deletions.
diff --git a/src/xml2_utils.h b/src/xml2_utils.h
@@ -15,7 +15,31 @@ enum NodeType {
   nodeset = 3,
 };
 
+
+inline int inherits3(SEXP x, const char *name) {
+  SEXP expr = PROTECT(Rf_lang3(Rf_install("inherits"), x, Rf_mkString(name)));
+  SEXP result = PROTECT(Rf_eval(expr, R_GlobalEnv));
+
+  int out = LOGICAL(result)[0];
+  UNPROTECT(2);
+  return out;
+}
+
 inline const NodeType getNodeType(SEXP x) {
+
+  // for fhircrackr
+  if (IS_S4_OBJECT(x)) {
+    if (inherits3(x, "xml_node")) {
+      return(NodeType::node);
+    } else if (inherits3(x, "xml_nodeset")) {
+      return(NodeType::nodeset);
+    } else if (inherits3(x, "xml_missing")) {
+      return(NodeType::missing);
+    } else {
+      Rf_error("Unexpected node type");
+    }
+  }
+
   if (Rf_inherits(x, "xml_node")) {
     return(NodeType::node);
   } else if (Rf_inherits(x, "xml_nodeset")) {