Harness unit test name

NAMESPACE

@@ -14,7 +14,6 @@ export(deepstate_fuzz_fun_analyze)
 export(deepstate_get_function_body)
 export(deepstate_get_package_details)
 export(deepstate_get_prototype_calls)
-export(deepstate_get_unsupported_datatypes)
 export(deepstate_harness_analyze_pkg)
 export(deepstate_harness_compile_run)
 export(deepstate_harness_files)
@@ -24,6 +23,7 @@ export(deepstate_list_package_args)
 export(deepstate_make_run)
 export(deepstate_pkg_create)
 export(deepstate_read_valgrind_xml)
+export(get_package_name)
 export(inputs.table)
 export(issues.table)
 import(Rcpp)

R/analyze_binary.R

@@ -23,7 +23,7 @@ deepstate_harness_analyze_pkg <- function(path, testfiles="all", max_inputs="all
   }
   test_path <- file.path(inst_path,"testfiles")
   if(file.exists(test_path)){
-    packagename <- basename(package_name)
+    packagename <- get_package_name(package_name)
     test.files <- Sys.glob(paste0(test_path,"/*"))
     if(testfiles != "all"){
       test.files <- test.files[1:testfiles]

R/fun_harness_create.R

@@ -10,9 +10,9 @@
 ##' print(function.harness)
 ##' @return The TestHarness file that is generated
 ##' @export
-deepstate_fun_create<-function(package_path, function_name, sep="infun"){
+deepstate_fun_create <- function(package_path, function_name, sep="infun"){
 
-  packagename <- basename(package_path)
+  packagename <- get_package_name(package_path)
   functions.list <- deepstate_get_function_body(package_path)
   functions.list$argument.type <- gsub("Rcpp::","",functions.list$argument.type)
   prototypes_calls <- deepstate_get_prototype_calls(package_path)
@@ -23,24 +23,24 @@ deepstate_fun_create<-function(package_path, function_name, sep="infun"){
       stop("No Rcpp Function to test in the package")
     }
   }
-	
+  
   # Each row of the "types_table" table corresponds to a supported datatype and
   # provides details for each datatype. The first column contains an alternative 
   # datatype to be used when running `qs::c_qsave`, whereas the second column 
   # correspond to the associated generation function with a range. When a 
   # datatype contains a value of NA in both columns, it is supported, utilizes 
   # itself when executing `qs::c_qsave` and lacks a range function. 
-	datatype <- function(ctype, rtype, args) data.table(ctype, rtype, args)
-	types_table <- rbind(
-		datatype("int", "IntegerVector", "(low,high)"),
-		datatype("double", "NumericVector", "(low,high)"),
-		datatype("string", "CharacterVector", NA),
-		datatype("NumericVector", NA, "(size,low,high)"),
-		datatype("IntegerVector", NA, "(size,low,high)"),
-		datatype("NumericMatrix", NA, "(size,low,high)"),
-		datatype("CharacterVector", NA, NA),
-		datatype("mat", NA, NA))
-	setkey(types_table, "ctype")
+  datatype <- function(ctype, rtype, args) data.table(ctype, rtype, args)
+  types_table <- rbind(
+    datatype("int", "IntegerVector", "(low,high)"),
+    datatype("double", "NumericVector", "(low,high)"),
+    datatype("string", "CharacterVector", NA),
+    datatype("NumericVector", NA, "(size,low,high)"),
+    datatype("IntegerVector", NA, "(size,low,high)"),
+    datatype("NumericMatrix", NA, "(size,low,high)"),
+    datatype("CharacterVector", NA, NA),
+    datatype("mat", NA, NA))
+  setkey(types_table, "ctype")
 
   headers <- paste("#include <fstream>", "#include <RInside.h>", 
                    "#include <iostream>", "#include <RcppDeepState.h>", 

R/fun_harness_fuzz.R

@@ -17,7 +17,7 @@
 ##' @return The executed function.
 ##' @export
 deepstate_fuzz_fun<-function(package_path,fun_name,seed=-1,time.limit.seconds=2,sep="infun", verbose=getOption("verbose")){
-  packagename <- basename(package_path)
+  packagename <- get_package_name(package_path)
 
   if(!dir.exists(file.path(package_path,"inst/testfiles"))){
     stop("Missing testfiles directory")

R/package_details.R

@@ -61,4 +61,37 @@ deepstate_get_prototype_calls <-function(package_path){
   codes <- funs[,{nc::capture_all_str(code,"::wrap",calls ="(?:.*)")},by=funName]
   prototypes <-funs[,.(funName,prototype,calls=codes$calls)]
   return(prototypes)
-}
+}
+
+
+##' @title get_package_name
+##' @description gets the name of a package from its DESCRIPTION file
+##' @param package_path location of the package in the filesystem
+##' @export
+get_package_name <- function(package_path){
+  description_file <- file.path(package_path, "DESCRIPTION")
+  if (!file.exists(description_file)) {
+    message(paste0("ERROR: ", location, " doesn't contain a valid package with",
+                    " a DESCRIPTION file"))
+    return(NA_character_)
+  }
+
+  # parse the DESCRIPTION file in order to get the package name
+  description_lines <- readLines(description_file)
+  package_name_line <- description_lines[grepl("^Package:", description_lines)]
+  package_name <- gsub("Package: ", "", package_name_line[1])
+
+}
+
+
+
+globalVariables(c("argument.name","funName","argument.type","calls"
+                  ,"code","funName",".","error.i","src.file.lines",
+                  "heapsum","file.line","arg.name","value",":=",".N","f","fun_name"
+                  ,"read.table","new.i.vec","download.file","result","inputs",
+                  "rest","status","fun","max_inputs","package_name","pkg.list","testfiles.res"))
+
+globalVariables(c("error.i","error.type","sanitizer","function.i",
+                  "src.file.lines","heapsum","file.line","arg.name",
+                  "value",".N",":=","prototype","data.table"))
+