Merge pull request #12 from FabrizioSandri/fuzz-compiled

Fuzz only supported functions

Author: FabrizioSandri

R/analyze_binary.R

@@ -83,7 +83,7 @@ deepstate_fuzz_fun_analyze<- function(test_function,seed=-1, time.limit.seconds,
   log_file <- file.path(output_folder,paste0(seed,"_log"))
   valgrind.log.text <- file.path(output_folder,"seed_valgrind_log_text")
   if(!file.exists(test_harness.o)){
-    deepstate_compile_fun(test_function, verbose)
+    deepstate_compile_fun(test_function, verbose=verbose)
   }
   if(time.limit.seconds <= 0){
     stop("time.limit.seconds should always be greater than zero")

R/fun_harness_create.R

@@ -11,11 +11,7 @@
 ##' @return The TestHarness file that is generated
 ##' @export
 deepstate_fun_create<-function(package_path,function_name,sep="infun"){
-  fun_path <- file.path(package_path, "inst", "testfiles", function_name)
-  if(!dir.exists(fun_path)){
-    dir.create(fun_path, showWarnings = FALSE, recursive = TRUE)
-  }
-
+  
   packagename <- basename(package_path)
   functions.list <- deepstate_get_function_body(package_path)
   functions.list$argument.type<-gsub("Rcpp::","",functions.list$argument.type)
@@ -68,7 +64,12 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
   }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)
+  }
+
   if(sep == "generation" || sep == "checks"){
     write_to_file <- paste0(headers)
     makesep.path <- file.path(fun_path,paste0(sep,".Makefile"))

R/pkg_harness_compile.R

@@ -25,25 +25,19 @@ deepstate_harness_compile_run <- function(package_path,time.limit.seconds=5,seed
   functions.list <- Sys.glob(file.path(test_path,"*"))
   #no harness created
   if(length(functions.list)){
-    if(length(testharness) == length(basename(functions.list)) && 
-       length(intersect(basename(functions.list),testharness)) == length(testharness)){
-      uncompiled_count = 0
-      log_count = 0
-      for(fun.path in functions.list){
-        compile.res <- deepstate_fuzz_fun(package_path, basename(fun.path), time.limit.seconds, seed=seed, verbose=verbose)
-        if(!is.na(compile.res) && compile.res == basename(fun.path)){
-          compiled.code <-c(compiled.code,compile.res)
-        }
-        else{
-          uncompiled.code <- c(uncompiled.code,basename(fun.path))
-        }
+    for(fun.path in functions.list){
+      compile.res <- deepstate_fuzz_fun(package_path, basename(fun.path), time.limit.seconds, seed=seed, verbose=verbose)
+      if(!is.na(compile.res) && compile.res == basename(fun.path)){
+        compiled.code <-c(compiled.code,compile.res)
+      }else {
+        uncompiled.code <- c(uncompiled.code,basename(fun.path))
       }
-      if(length(uncompiled.code) > 0)
-        message(sprintf("Uncompiled functions : %s\n",paste(uncompiled.code, collapse=", ")))
-      return(as.character(compiled.code))
     }
-  }
-  else{
+    if(length(uncompiled.code) > 0)
+      message(sprintf("Uncompiled functions : %s\n",paste(uncompiled.code, collapse=", ")))
+    return(as.character(compiled.code))
+    
+  }else {
     stop("TestHarness are not created for all the function that are returned by pkg create")
   }
 }

inst/testpkgs/testSAN/R/RcppExports.R

@@ -5,6 +5,10 @@ rcpp_read_out_of_bound <- function(rbound) {
     .Call('_testSAN_rcpp_read_out_of_bound', PACKAGE = 'testSAN', rbound)
 }
 
+unsupported_datatype <- function(param) {
+    .Call('_testSAN_unsupported_datatype', PACKAGE = 'testSAN', param)
+}
+
 rcpp_use_after_deallocate <- function(array_size) {
     .Call('_testSAN_rcpp_use_after_deallocate', PACKAGE = 'testSAN', array_size)
 }

inst/testpkgs/testSAN/src/RcppExports.cpp

@@ -5,6 +5,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // rcpp_read_out_of_bound
 int rcpp_read_out_of_bound(int rbound);
 RcppExport SEXP _testSAN_rcpp_read_out_of_bound(SEXP rboundSEXP) {
@@ -16,6 +21,17 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// unsupported_datatype
+int unsupported_datatype(Rcpp::LogicalVector param);
+RcppExport SEXP _testSAN_unsupported_datatype(SEXP paramSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Rcpp::LogicalVector >::type param(paramSEXP);
+    rcpp_result_gen = Rcpp::wrap(unsupported_datatype(param));
+    return rcpp_result_gen;
+END_RCPP
+}
 // rcpp_use_after_deallocate
 int rcpp_use_after_deallocate(int array_size);
 RcppExport SEXP _testSAN_rcpp_use_after_deallocate(SEXP array_sizeSEXP) {
@@ -74,6 +90,7 @@ END_RCPP
 
 static const R_CallMethodDef CallEntries[] = {
     {"_testSAN_rcpp_read_out_of_bound", (DL_FUNC) &_testSAN_rcpp_read_out_of_bound, 1},
+    {"_testSAN_unsupported_datatype", (DL_FUNC) &_testSAN_unsupported_datatype, 1},
     {"_testSAN_rcpp_use_after_deallocate", (DL_FUNC) &_testSAN_rcpp_use_after_deallocate, 1},
     {"_testSAN_rcpp_use_after_free", (DL_FUNC) &_testSAN_rcpp_use_after_free, 1},
     {"_testSAN_rcpp_use_uninitialized", (DL_FUNC) &_testSAN_rcpp_use_uninitialized, 1},

inst/testpkgs/testSAN/src/unsupported_datatype.cpp

@@ -0,0 +1,10 @@
+#include <Rcpp.h>
+using namespace std;
+
+// [[Rcpp::export]]
+int unsupported_datatype(Rcpp::LogicalVector param){
+  
+  return param.size();
+  
+} 
+

tests/testthat/test-new-test.R

@@ -81,7 +81,8 @@ test_that("inputfolder files existence", {
 })
 
 functions.list <- deepstate_get_function_body(path)
-args.list <- gsub(" ","",functions.list$argument.name)
+compiled_functions.list <- functions.list[funName!="unsupported_datatype"]
+args.list <- gsub(" ","",compiled_functions.list$argument.name)
 path.args.list <- file.path(funpath.list,"inputs",paste0(args.list,".qs"))
 #print(path.args.list)
 #print(file.exists(path.args.list))

tests/testthat/test-debug-symbols.R renamed to tests/testthat/test-testSAN.R

@@ -3,7 +3,7 @@ library(RcppDeepState)
 testSAN_path <- system.file("testpkgs/testSAN", package = "RcppDeepState")
 
 
-test_that("Check debug symbols", {
+test_that("Test on the testSAN package", {
 
     # We choose seed=1000 since it has been demonstrated locally that 
     # RcppDeepState detects several issues when using this number.     
@@ -14,6 +14,8 @@ test_that("Check debug symbols", {
     # If debug symbols are included in the final binary, then the resulting 
     # table will contain some information. On the other hand, if the resulting 
     # table is empty, it means that the library is missing debug symbols.
+    # This test is also used to check if RcppDeepState returns correct analysis
+    # results when run on the testSAN package.
     logtable_is_empty <- all(sapply(result$logtable, function(table) nrow(table) == 0))
 
     expect_false(logtable_is_empty)