corpus_properties() and corpus_property() robust PolMine#69

Author: Andreas Blätte

DESCRIPTION

@@ -54,7 +54,7 @@ LinkingTo: Rcpp
 Biarch: true
 URL: https://github.com/PolMine/RcppCWB
 BugReports: https://github.com/PolMine/RcppCWB/issues
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.2
 Roxygen: list(markdown = TRUE)
 Collate:
   'RcppCWB_package.R'

NEWS.md

@@ -3,6 +3,8 @@
 * C++ code replaces `sprintf()` with `snprintf()` to address security issue.
 * Package now depends on Rcpp v1.0.10, which replaces one remaining `sprintf()`
 #70.
+* `corpus_properties()` and `corpus_property()` do not crash any more, if corpus
+is not loaded or not present #69.
 
 
 # RcppCWB 0.5.4

R/cl.R

@@ -467,7 +467,8 @@ corpus_s_attributes <- function(corpus, registry = Sys.getenv("CORPUS_REGISTRY")
 }
 
 #' @details `corpus_properties()` returns a `character` vector with the corpus
-#'   properties defined in the registry file.
+#'   properties defined in the registry file. If the corpus cannot be located,
+#'   `NA` is returned.
 #' @rdname registry_info
 #' @examples
 #' corpus_properties("REUTERS", registry = get_tmp_registry())
@@ -478,7 +479,8 @@ corpus_properties <- function(corpus, registry = Sys.getenv("CORPUS_REGISTRY")){
 }
 
 #' @details `corpus_property()` returns the value of a corpus property defined
-#'   in the registry file, or `NA` if the property requested is undefined.
+#'   in the registry file, or `NA` if the corpus does not exist, is not loaded 
+#'   of if the property requested is undefined.
 #' @param property A corpus property defined in the registry file (.
 #' @rdname registry_info
 #' @examples

man/registry_info.Rd

@@ -672,22 +672,31 @@ Rcpp::StringVector corpus_properties(SEXP corpus, SEXP registry){
   char* registry_dir = strdup(Rcpp::as<std::string>(registry).c_str());
   c = cl_new_corpus(registry_dir, corpus_id);
 
-  p = cl_first_corpus_property(c);
-  
-  
   n = 0;
-  while (p != NULL){
-    p = cl_next_corpus_property(p);
-    n++;
+  if (c){
+    p = cl_first_corpus_property(c);
+    
+    
+    while (p != NULL){
+      p = cl_next_corpus_property(p);
+      n++;
+    }
+  } else {
+    n = 1;
   }
+  
   Rcpp::StringVector properties(n);
 
-  p = cl_first_corpus_property(c);
-  i = 0;
-  while (p != NULL){
-    properties(i) = cl_strdup(p->property);
-    p = cl_next_corpus_property(p);
-    i++;
+  if (c){
+    p = cl_first_corpus_property(c);
+    i = 0;
+    while (p != NULL){
+      properties(i) = cl_strdup(p->property);
+      p = cl_next_corpus_property(p);
+      i++;
+    }
+  } else {
+    properties(0) = NA_STRING;
   }
 
   return(properties);
@@ -701,18 +710,24 @@ Rcpp::StringVector corpus_property(SEXP corpus, SEXP registry, SEXP property){
   Corpus * c;
   char* corpus_id  = strdup(Rcpp::as<std::string>(corpus).c_str());
   char* registry_dir = strdup(Rcpp::as<std::string>(registry).c_str());
+  char* prop = strdup(Rcpp::as<std::string>(property).c_str());
+  
   c = cl_new_corpus(registry_dir, corpus_id);
 
-  char* prop = strdup(Rcpp::as<std::string>(property).c_str());
-
-  CorpusProperty p = cl_first_corpus_property(c);
+  if (c){
+    CorpusProperty p = cl_first_corpus_property(c);
 
-  while (p != NULL && strcmp(prop, p->property)) p = cl_next_corpus_property(p);
-  
-  if (p != NULL)
-    result(0) =  p->value;
-  else
+    while (p != NULL && strcmp(prop, p->property))
+      p = cl_next_corpus_property(p);
+    
+    if (p != NULL)
+      result(0) =  p->value;
+    else
+      result(0) = NA_STRING;
+  } else {
     result(0) = NA_STRING;
+  }
+
 
   return(result);
 }

src/cl.cpp

@@ -67,6 +67,12 @@ test_that(
   {
     props <- corpus_properties(corpus = "REUTERS", registry = get_tmp_registry())
     expect_identical(props, c("language", "charset"))
+    
+    fail <- corpus_properties(
+      corpus = "NOTEXISTING",
+      registry = Sys.getenv("CORPUS_REGISTRY")
+    )
+    expect_true(is.na(fail))
   }
 )
 
@@ -94,6 +100,14 @@ test_that(
       property = "foo"
     )
     expect_identical(na, NA_character_)
+    
+    na <- corpus_property(
+      "NOTEXISTING",
+      registry = get_tmp_registry(),
+      property = "foo"
+    )
+    expect_identical(na, NA_character_)
+    
   }
 )