Implement xml_name.xml_nodeset() in C

r-lib · Aug 23, 2023 · d2db44c · d2db44c
1 parent ef2310b
commit d2db44c
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 1 deletion.
diff --git a/R/xml_name.R b/R/xml_name.R
@@ -28,7 +28,7 @@ xml_name.xml_missing <- function(x, ns = character()) {
 
 #' @export
 xml_name.xml_nodeset <- function(x, ns = character()) {
-  vapply(x, xml_name, ns = ns, FUN.VALUE = character(1))
+  .Call(nodeset_name, x, ns)
 }
 
 #' @export

diff --git a/src/init.c b/src/init.c
@@ -38,6 +38,7 @@ extern SEXP node_copy(SEXP);
 extern SEXP node_has_children(SEXP, SEXP);
 extern SEXP node_length(SEXP, SEXP);
 extern SEXP node_name(SEXP, SEXP);
+extern SEXP nodeset_name(SEXP, SEXP);
 extern SEXP node_new(SEXP);
 extern SEXP node_new_dtd(SEXP, SEXP, SEXP, SEXP);
 extern SEXP node_new_ns(SEXP, SEXP);
@@ -103,6 +104,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"node_has_children",         (DL_FUNC) &node_has_children,         2},
     {"node_length",               (DL_FUNC) &node_length,               2},
     {"node_name",                 (DL_FUNC) &node_name,                 2},
+    {"nodeset_name",              (DL_FUNC) &nodeset_name,              2},
     {"node_new",                  (DL_FUNC) &node_new,                  1},
     {"node_new_dtd",              (DL_FUNC) &node_new_dtd,              4},
     {"node_new_ns",               (DL_FUNC) &node_new_ns,               2},

diff --git a/src/xml2_node.cpp b/src/xml2_node.cpp
@@ -37,6 +37,36 @@ extern "C" SEXP node_name(SEXP node_sxp, SEXP nsMap) {
   END_CPP
 }
 
+// [[export]]
+extern "C" SEXP nodeset_name(SEXP node_sxp, SEXP nsMap) {
+  BEGIN_CPP
+
+  int n = Rf_xlength(node_sxp);
+
+  SEXP out = PROTECT(Rf_allocVector(STRSXP, n));
+
+  for (int i = 0; i < n; ++i) {
+    SEXP node_sxp_i = VECTOR_ELT(node_sxp, i);
+
+    if (Rf_inherits(node_sxp_i, "xml_node")) {
+      SEXP node_field_i = VECTOR_ELT(node_sxp_i, 0);
+      XPtrNode node_i(node_field_i);
+      std::string name_i = nodeName(node_i.checked_get(), nsMap);
+      SET_STRING_ELT(out, i, Rf_mkCharLenCE(name_i.c_str(), name_i.size(), CE_UTF8));
+    } else if (Rf_inherits(node_sxp_i, "xml_missing")) {
+      SET_STRING_ELT(out, i, NA_STRING);
+    } else {
+      // xml_nodeset can't appear
+      Rf_error("Unexpected node type");
+    }
+  }
+
+  UNPROTECT(1);
+  return out;
+
+  END_CPP
+}
+
 // [[export]]
 extern "C" SEXP node_set_name(SEXP node_sxp, SEXP value) {
   BEGIN_CPP