diff --git a/R/analyze_binary.R b/R/analyze_binary.R index 51a42ba9..b8d80608 100644 --- a/R/analyze_binary.R +++ b/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") diff --git a/R/fun_harness_create.R b/R/fun_harness_create.R index 6c57b056..2f5984ec 100644 --- a/R/fun_harness_create.R +++ b/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")) diff --git a/R/pkg_harness_compile.R b/R/pkg_harness_compile.R index 57f9b127..8c2935c2 100644 --- a/R/pkg_harness_compile.R +++ b/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") } } diff --git a/inst/testpkgs/testSAN/R/RcppExports.R b/inst/testpkgs/testSAN/R/RcppExports.R index 3364f480..7b7e97dd 100644 --- a/inst/testpkgs/testSAN/R/RcppExports.R +++ b/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) } diff --git a/inst/testpkgs/testSAN/src/RcppExports.cpp b/inst/testpkgs/testSAN/src/RcppExports.cpp index ae517bdc..0334dc14 100644 --- a/inst/testpkgs/testSAN/src/RcppExports.cpp +++ b/inst/testpkgs/testSAN/src/RcppExports.cpp @@ -5,6 +5,11 @@ using namespace Rcpp; +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& 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}, diff --git a/inst/testpkgs/testSAN/src/unsupported_datatype.cpp b/inst/testpkgs/testSAN/src/unsupported_datatype.cpp new file mode 100644 index 00000000..1503b61a --- /dev/null +++ b/inst/testpkgs/testSAN/src/unsupported_datatype.cpp @@ -0,0 +1,10 @@ +#include +using namespace std; + +// [[Rcpp::export]] +int unsupported_datatype(Rcpp::LogicalVector param){ + + return param.size(); + +} + diff --git a/tests/testthat/test-new-test.R b/tests/testthat/test-new-test.R index f4431f6e..64bc777a 100644 --- a/tests/testthat/test-new-test.R +++ b/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)) diff --git a/tests/testthat/test-debug-symbols.R b/tests/testthat/test-testSAN.R similarity index 81% rename from tests/testthat/test-debug-symbols.R rename to tests/testthat/test-testSAN.R index 778c55e0..6aa57dfe 100644 --- a/tests/testthat/test-debug-symbols.R +++ b/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)