Merge pull request #17 from FabrizioSandri/custom-harness

FabrizioSandri · web-flow · commit 55424cac0568 · 2022-08-06T21:59:21.000+02:00
Custom test harness
diff --git a/R/fun_harness_create.R b/R/fun_harness_create.R
@@ -16,7 +16,8 @@ deepstate_fun_create<-function(package_path, function_name, sep="infun"){
   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)
-  
+  fun_path <- file.path(package_path, "inst", "testfiles", function_name)
+
   if(sep == "generation" || sep == "checks"){ 
     if(is.null(functions.list) || length(functions.list) < 1){
       stop("No Rcpp Function to test in the package")
@@ -51,10 +52,22 @@ deepstate_fun_create<-function(package_path, function_name, sep="infun"){
   params <- gsub("arma::","",params)
   params <- gsub("std::","",params)
 
+  filename <- if(sep == "generation" || sep == "checks"){
+    paste0(function_name,"_DeepState_TestHarness_",sep,".cpp")
+  }else{
+    paste0(function_name,"_DeepState_TestHarness.cpp")
+  }
+
   # check if the parameters are allowed or not
   matched <- params %in% types_table$ctype
   unsupported_datatypes <- params[!matched]
-  if(length(unsupported_datatypes) > 0){
+  if(file.exists(file.path(fun_path, filename))){
+    deepstate_create_makefile(package_path,function_name)
+    warn_msg <- paste0("Test harness already exists for the function - ",
+                       function_name, " - using the existing one\n")
+    message(warn_msg)
+    return(filename)
+  }else if(length(unsupported_datatypes) > 0){
     unsupported_datatypes <- paste(unsupported_datatypes, collapse=",")
     error_msg <- paste0("We can't test the function - ", function_name,
                         " - due to the following datatypes falling out of the ",
@@ -64,13 +77,7 @@ deepstate_fun_create<-function(package_path, function_name, sep="infun"){
   }
 
   pt <- prototypes_calls[prototypes_calls$funName == function_name,]
-  filename <- if(sep == "generation" || sep == "checks"){
-    paste0(function_name,"_DeepState_TestHarness_",sep,".cpp")
-  }else{
-    paste0(function_name,"_DeepState_TestHarness.cpp")
-  }
 
-  fun_path <- file.path(package_path, "inst", "testfiles", function_name)
   if(!dir.exists(fun_path)){
     dir.create(fun_path, showWarnings = FALSE, recursive = TRUE)
   }
diff --git a/R/fun_makefile_create.R b/R/fun_makefile_create.R
@@ -68,9 +68,9 @@ deepstate_create_makefile <-function(package,fun_name){
  
   # Makefile rules : compile lines
   write_to_file<-paste0(write_to_file, "\n\n", test_harness_path, " : ", test_harness.o_path)
-  write_to_file<-paste0(write_to_file, "\n\t", "clang++ -g ", test_harness.o_path, " ${CPPFLAGS} ", " ${LDFLAGS} ", " ${LDLIBS} ", obj.file.path, " -o ", test_harness_path) #," ",objs.add)
+  write_to_file<-paste0(write_to_file, "\n\t", "clang++ -g -gdwarf-4 ", test_harness.o_path, " ${CPPFLAGS} ", " ${LDFLAGS} ", " ${LDLIBS} ", obj.file.path, " -o ", test_harness_path) #," ",objs.add)
   write_to_file<-paste0(write_to_file, "\n\n", test_harness.o_path, " : ", test_harness.cpp_path)
-  write_to_file<-paste0(write_to_file, "\n\t", "clang++ -g -c ", " ${CPPFLAGS} ", test_harness.cpp_path, " -o ", test_harness.o_path)
+  write_to_file<-paste0(write_to_file, "\n\t", "clang++ -g -gdwarf-4 -c ", " ${CPPFLAGS} ", test_harness.cpp_path, " -o ", test_harness.o_path)
   
   write(write_to_file, makefile_path, append=TRUE)
 
diff --git a/R/pkg_harness_create.R b/R/pkg_harness_create.R
@@ -1,89 +1,117 @@
 ##' @title TestHarness for the package
 ##' @param package_path path to the test package
 ##' @param verbose used to deliver more in depth information
-##' @description Creates Testharness for all the functions in the package that you want to test
+##' @description Creates Testharness for all the functions in the package that
+##' you want to test
 ##' using RcppDeepState.
-##' @examples 
+##' @examples
 ##' path <- system.file("testpkgs/testSAN", package = "RcppDeepState")
 ##' harness.list <- deepstate_pkg_create(path)
 ##' print(harness.list)
 ##' @import RcppArmadillo
 ##' @return A character vector of TestHarness files that are generated
 ##' @export
-deepstate_pkg_create<-function(package_path, verbose=getOption("verbose")){
-  package_path <-normalizePath(package_path, mustWork=TRUE)
-  package_path <- sub("/$","",package_path)
-  inst_path <- file.path(package_path, "inst")
-  test_path <- file.path(inst_path,"testfiles")
+deepstate_pkg_create <- function(package_path, verbose=getOption("verbose")) {
+  package_path <- normalizePath(package_path, mustWork=TRUE)
+  package_path <- sub("/$", "", package_path)
+  test_path <- file.path(package_path, "inst", "testfiles")
 
   # Test directory structure initialization
-  unlink(test_path, recursive = TRUE)
-  if(!dir.exists(inst_path)) {
-    dir.create(inst_path)
+  if (!dir.exists(test_path)) {
+    dir.create(test_path, showWarnings=FALSE, recursive=TRUE)
+  }else {
+    # delete all the existing files except for the harness
+    for (function_name in list.files(test_path)) {
+      fun_path <- file.path(test_path, function_name)
+      filename <- paste0(function_name, "_DeepState_TestHarness", ".cpp")
+      harness_path <- file.path(fun_path, filename)
+
+      # delete all the files and directories except the harness file
+      if (file.exists(harness_path)) {
+        delete_content <- setdiff(list.files(fun_path), filename)
+        unlink(file.path(fun_path, delete_content), recursive=TRUE)
+      }
+    }
   }
-  dir.create(test_path,showWarnings = FALSE)
 
-  if(!file.exists(file.path(package_path,"src/*.so"))) {
-    # ensure that the debugging symbols are embedded in the resulting shared object
+  if (!file.exists(file.path(package_path, "src/*.so"))) {
+    # ensure that the debugging symbols are embedded in the shared object
     makevars_file <- file.path(package_path, "src", "Makevars")
-    if (dir.exists(file.path(package_path, "src"))){
+    if (dir.exists(file.path(package_path, "src"))) {
         makevars_content <- "PKG_CXXFLAGS += -g "
         write(makevars_content, makevars_file, append=FALSE)
     }
 
-    system(paste0("R CMD INSTALL ",package_path),intern = FALSE, ignore.stdout=!verbose, ignore.stderr=!verbose)
+    system(paste0("R CMD INSTALL ", package_path), intern=FALSE,
+           ignore.stdout=!verbose, ignore.stderr=!verbose)
     unlink(makevars_file, recursive = FALSE)
   }
 
-  if(!(file.exists("~/.RcppDeepState/deepstate-master/build/libdeepstate32.a") &&
-       file.exists("~/.RcppDeepState/deepstate-master/build/libdeepstate.a")))
-  {
+  # download and build deepstate
+  libdeepstate32 <- "~/.RcppDeepState/deepstate-master/build/libdeepstate32.a"
+  libdeepstate <- "~/.RcppDeepState/deepstate-master/build/libdeepstate.a"
+  if (!(file.exists(libdeepstate32) && file.exists(libdeepstate))) {
     deepstate_make_run(verbose)
   }
+
   Rcpp::compileAttributes(package_path)
   harness <- list()
   failed.harness <- list()
 
   functions.list <-  deepstate_get_function_body(package_path)
-  if(!is.null(functions.list) && length(functions.list) > 1){
-    functions.list$argument.type<-gsub("Rcpp::","",functions.list$argument.type)
+  if (!is.null(functions.list) && length(functions.list) > 1) {
+    functions.list$argument.type <- gsub("Rcpp::", "",
+                                         functions.list$argument.type)
     match_count <- 0
     mismatch_count <- 0
     
     fun_names <- unique(functions.list$funName)
-    for(function_name.i in fun_names) {
-      functions.rows  <- functions.list [functions.list$funName == function_name.i,]
-      params <- c(functions.rows$argument.type)
-      filepath <-deepstate_fun_create(package_path,function_name.i)
-      filename <- paste0(function_name.i,"_DeepState_TestHarness",".cpp")
+    for (function_name in fun_names) {
+      fun_path <- file.path(test_path, function_name)
+      filename <- paste0(function_name, "_DeepState_TestHarness", ".cpp")
+      harness_path <- file.path(fun_path, filename)
 
-      if(!is.na(filepath) && basename(filepath) ==  filename ){
-        match_count = match_count + 1
-        harness <- c(harness,filename) 
+      functions.rows <- functions.list[functions.list$funName == function_name,]
+      params <- c(functions.rows$argument.type)
+      filepath <- deepstate_fun_create(package_path, function_name)
+      
+      if (!is.na(filepath) && basename(filepath) == filename) {
+        match_count <- match_count + 1
+        harness <- c(harness, filename)
       }else {
-        mismatch_count = mismatch_count + 1
-        failed.harness <- c(failed.harness,function_name.i)
+        mismatch_count <- mismatch_count + 1
+        failed.harness <- c(failed.harness, function_name)
       }
       
     }
     
-    if(match_count > 0 && match_count == length(fun_names)){
-      message(sprintf("Testharness created for %d functions in the package\n",match_count))
+
+    # harness generated for all of the functions
+    if (match_count > 0 && match_count == length(fun_names)) {
+      message(paste0("Testharness created for ", match_count, 
+                     " functions in the package\n"))
       return(as.character(harness))
     }
-    else{
-      if(mismatch_count < length(fun_names) && length(failed.harness) > 0 && match_count != 0){
-        message(sprintf("Failed to create testharness for %d functions in the package - %s\n",mismatch_count,paste(failed.harness, collapse=", ")))
-        message(sprintf("Testharness created for %d functions in the package\n",match_count))
-        return(as.character(harness))
-      }  
+
+    # harness generated for some function
+    if (mismatch_count < length(fun_names) && length(failed.harness) > 0
+        && match_count != 0) {
+      failed_str <- paste(failed.harness, collapse=", ")
+      message(paste0("Failed to create testharness for ", mismatch_count,
+                     " functions in the package - ", failed_str))
+
+      message(paste0("Testharness created for ", match_count,
+                     " functions in the package\n"))
+      return(as.character(harness))
     }
-    if(mismatch_count == length(fun_names)){
-      stop("Testharnesses cannot be created for the package - datatypes fall out of specified list!!")
+
+    # harness not generated for any function
+    if (mismatch_count == length(fun_names)) {
+      stop("Testharnesses cannot be created for the package")
       return(as.character(failed.harness))
     }
+
+  }else {
+    stop("No Rcpp function to test in the package")
   }
-  else{
-    stop("No Rcpp Functions to test in the package")
-  }
-}   
+}
