Skip to content

Commit b2f6a06

Browse files
FabrizioSandriFabrizioSandri
authored
Merge pull request #16 from FabrizioSandri/harness-creation-improvements
Harness creation improvements - 2
2 parents bfa7657 + 4290e80 commit b2f6a06

File tree

1 file changed

+78
-43
lines changed

1 file changed

+78
-43
lines changed

‎R/fun_harness_create.R‎

Lines changed: 78 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -2,22 +2,22 @@
22
##' @param package_path to the test package
33
##' @param function_name from the test package
44
##' @param sep infun default
5-
##' @description The function creates Testharness for the provided function name.
5+
##' @description The function creates Testharness for the provided function name
66
##' @examples
77
##' path <- system.file("testpkgs/testSAN", package = "RcppDeepState")
88
##' function_name <- "rcpp_read_out_of_bound"
99
##' function.harness <- deepstate_fun_create(path,function_name)
1010
##' print(function.harness)
1111
##' @return The TestHarness file that is generated
1212
##' @export
13-
deepstate_fun_create<-function(package_path,function_name,sep="infun"){
13+
deepstate_fun_create<-function(package_path, function_name, sep="infun"){
1414

1515
packagename <- basename(package_path)
1616
functions.list <- deepstate_get_function_body(package_path)
17-
functions.list$argument.type<-gsub("Rcpp::","",functions.list$argument.type)
17+
functions.list$argument.type <- gsub("Rcpp::","",functions.list$argument.type)
1818
prototypes_calls <- deepstate_get_prototype_calls(package_path)
1919

20-
if(sep=="generation" || sep == "checks"){
20+
if(sep == "generation" || sep == "checks"){
2121
if(is.null(functions.list) || length(functions.list) < 1){
2222
stop("No Rcpp Function to test in the package")
2323
}
@@ -41,7 +41,9 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
4141
datatype("mat", NA, NA))
4242
setkey(types_table, "ctype")
4343

44-
headers <- "#include <fstream>\n#include <RInside.h>\n#include <iostream>\n#include <RcppDeepState.h>\n#include <qs.h>\n#include <DeepState.hpp>\n"
44+
headers <- paste("#include <fstream>", "#include <RInside.h>",
45+
"#include <iostream>", "#include <RcppDeepState.h>",
46+
"#include <qs.h>", "#include <DeepState.hpp>\n\n", sep="\n")
4547
functions.rows <- functions.list[functions.list$funName == function_name,]
4648
params <- gsub(" ","", functions.rows$argument.type)
4749
params <- gsub("const","",params)
@@ -54,7 +56,10 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
5456
unsupported_datatypes <- params[!matched]
5557
if(length(unsupported_datatypes) > 0){
5658
unsupported_datatypes <- paste(unsupported_datatypes, collapse=",")
57-
message(sprintf("We can't test the function - %s - due to the following datatypes falling out of the allowed ones: %s\n", function_name, unsupported_datatypes))
59+
error_msg <- paste0("We can't test the function - ", function_name,
60+
" - due to the following datatypes falling out of the ",
61+
"allowed ones: ", unsupported_datatypes, "\n")
62+
message(error_msg)
5863
return(NA_character_)
5964
}
6065

@@ -80,33 +85,47 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
8085
}else{
8186
deepstate_create_makefile(package_path,function_name)
8287
}
88+
89+
default_harness <- paste0(function_name,"_DeepState_TestHarness")
90+
generation_harness <- paste0(function_name,"_DeepState_TestHarness_",sep)
8391
makefile_lines <- readLines(file.path(fun_path,"Makefile"),warn=FALSE)
84-
makefile_lines <- gsub(file.path(fun_path,paste0(function_name,"_DeepState_TestHarness")),
85-
file.path(fun_path,paste0(function_name,"_DeepState_TestHarness_",sep)),makefile_lines,fixed=TRUE)
86-
file.create(makesep.path,recursive=TRUE)
92+
makefile_lines <- gsub(file.path(fun_path, default_harness),
93+
file.path(fun_path, generation_harness),
94+
makefile_lines, fixed=TRUE)
95+
96+
file.create(makesep.path, recursive=TRUE)
8797
cat(makefile_lines, file=makesep.path, sep="\n")
88-
unlink(file.path(fun_path,"Makefile"))
89-
dir.create(file.path(fun_path,paste0(function_name,"_output","_",sep)),showWarnings = FALSE)
98+
unlink(file.path(fun_path, "Makefile"))
99+
gen_output <- file.path(fun_path, paste0(function_name, "_output","_", sep))
100+
dir.create(gen_output, showWarnings=FALSE)
90101
}else{
91-
comment <- paste0("// AUTOMATICALLY GENERATED BY RCPPDEEPSTATE PLEASE DO NOT EDIT BY HAND, INSTEAD EDIT\n// ",
92-
function_name,"_DeepState_TestHarness_generation.cpp and ",function_name,"_DeepState_TestHarness_checks.cpp\n\n")
102+
comment <- paste0("// AUTOMATICALLY GENERATED BY RCPPDEEPSTATE PLEASE DO",
103+
"NOT EDIT BY HAND, INSTEAD EDIT\n// ", function_name,
104+
"_DeepState_TestHarness_generation.cpp and ",
105+
function_name, "_DeepState_TestHarness_checks.cpp\n\n")
93106
write_to_file <- paste0(comment,headers)
94107
file_path <- file.path(fun_path,filename)
95108
file.create(file_path,recursive=TRUE)
96109
deepstate_create_makefile(package_path,function_name)
97110
}
98111

99-
write_to_file <- paste0(write_to_file,"RInside Rinstance;\n\n") # create a single RInside instance at the beginning
100-
write_to_file <-paste0(write_to_file,pt[1,pt$prototype],"\n")
112+
# create a single RInside instance at the beginning
113+
write_to_file <- paste0(write_to_file, "RInside Rinstance;", "\n\n")
114+
write_to_file <- paste0(write_to_file, pt[1,pt$prototype], "\n\n")
101115

102-
unittest <- gsub(".","",packagename, fixed=TRUE)
103-
generator_harness_header <- paste0("\n\n","TEST(",unittest,", generator)","{","\n")
104-
runner_harness_header <- paste0("\n\n","TEST(",unittest,", runner)","{","\n")
116+
unittest <- gsub(".","", packagename, fixed=TRUE)
117+
generator_header <- paste0("\n\n","TEST(",unittest,", generator)","{","\n")
118+
runner_header <- paste0("\n\n","TEST(",unittest,", runner)","{","\n")
105119

106120
# Test harness body
121+
generation_comment <- if(sep == "generation") "// RANGES CAN BE ADDED HERE\n"
122+
else ""
107123
indent <- " "
108-
generator_harness_body <- paste0(indent,'std::cout << "input starts" << std::endl;\n')
109-
runner_harness_body <- paste0(indent,'std::cout << "input starts" << std::endl;\n')
124+
inputs <- "#define INPUTS \\\n"
125+
inputs_dump <- ""
126+
print_values <- paste0("\n\n#define PRINT_INPUTS \\\n", indent,
127+
"std::cout << \"input starts\" << std::endl;\\\n")
128+
110129
proto_args <-""
111130
for(argument.i in 1:nrow(functions.rows)){
112131
arg.type <- gsub(" ","",functions.rows [argument.i,argument.type])
@@ -116,20 +135,19 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
116135
type.arg <-gsub("arma::","",type.arg)
117136
type.arg <-gsub("std::","",type.arg)
118137

119-
generation_comment1 <- ""
120-
generation_comment2 <- ""
121138
if(sep == "generation" && !is.na(types_table[type.arg]$args)){
122-
generation_comment1 <- paste0(indent, "//RcppDeepState_", type.arg, types_table[type.arg]$args,"\n")
123-
generation_comment2 <- " //RANGE OF THE VECTOR CAN BE ADDED HERE"
139+
generation_comment <- paste0(generation_comment, "// RcppDeepState_",
140+
type.arg, types_table[type.arg]$args, "\n")
124141
}
125142

126143
# generate the inputs
127144
if (!is.na(types_table[type.arg]$rtype)){
128-
variable <- paste0(indent, types_table[type.arg]$rtype, " ", arg.name,"(1);", "\n", generation_comment1, indent, arg.name, "[0]")
145+
variable <- paste0(indent, types_table[type.arg]$rtype, " ", arg.name,
146+
"(1);", " \\\n", indent, arg.name, "[0]")
129147
}else{
130-
variable <- paste0(generation_comment1, indent, arg.type, " ", arg.name)
148+
variable <- paste0(indent, arg.type, " ", arg.name)
131149
}
132-
variable <- paste0(variable, "= RcppDeepState_", type.arg, "();", generation_comment2, "\n")
150+
variable <- paste0(variable, "= RcppDeepState_", type.arg, "();", " \\\n")
133151
variable <- gsub("const","",variable)
134152

135153
# save the inputs
@@ -139,21 +157,24 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
139157
}
140158
if(type.arg == "mat"){
141159
input_vals <- file.path(inputs_path,arg.name)
142-
save_inputs <- paste0("std::ofstream ", gsub(" ","",arg.name),"_stream",";\n", indent, arg.name,'_stream.open("',input_vals,'" );\n',
143-
indent, arg.name,'_stream << ', arg.name,';\n', indent, arg.name,'_stream.close(); \n')
160+
save_inputs <- paste0("std::ofstream ", gsub(" ", "", arg.name),
161+
"_stream", ";\n", indent, arg.name,
162+
'_stream.open("', input_vals, '" );\n', indent,
163+
arg.name, '_stream << ', arg.name, ';\n', indent,
164+
arg.name, '_stream.close(); \n')
144165
}else{
145166
input_file <- paste0(arg.name,".qs")
146167
input_vals <- file.path(inputs_path, input_file)
147-
save_inputs <- paste0('qs::c_qsave(',arg.name,',"',input_vals,'",\n','\t\t"high", "zstd", 1, 15, true, 1);\n')
168+
save_inputs <- paste0('qs::c_qsave(',arg.name, ',"', input_vals, '",\n',
169+
'\t\t"high", "zstd", 1, 15, true, 1);\n')
148170
}
149171

150-
# print the inputs
151-
print_values <- paste0('std::cout << "',arg.name,' values: " << ',arg.name, ' << std::endl;\n')
152-
153-
generator_harness_body <- paste0(generator_harness_body, variable, indent, print_values)
154-
runner_harness_body <- paste0(runner_harness_body, variable, indent, save_inputs, indent, print_values)
155-
156-
proto_args <- gsub(" ","",paste0(proto_args, arg.name))
172+
inputs <- paste0(inputs, variable)
173+
inputs_dump <- paste0(inputs_dump, indent, save_inputs)
174+
print_values <- paste0(print_values, indent, 'std::cout << "', arg.name,
175+
' values: " << ', arg.name, ' << std::endl; \\\n')
176+
177+
proto_args <- gsub(" ", "", paste0(proto_args, arg.name))
157178
if(argument.i <= nrow(functions.rows)) {
158179
if(type.arg == "int" || type.arg == "double"){
159180
proto_args <- paste0(proto_args,"[0],")
@@ -165,14 +186,28 @@ deepstate_fun_create<-function(package_path,function_name,sep="infun"){
165186
}
166187

167188
}
168-
generator_harness_body<-paste0(generator_harness_body,indent,'std::cout << "input ends" << std::endl;\n')
169-
runner_harness_body<-paste0(runner_harness_body,indent,'std::cout << "input ends" << std::endl;\n')
170-
runner_harness_body<-paste0(runner_harness_body,indent,"try{\n",indent,indent,function_name,"(",gsub(",$","",proto_args),");\n")
189+
190+
inputs <- gsub("\\\\\n$", "", inputs)
191+
print_values <- paste0(print_values, indent,
192+
'std::cout << "input ends" << std::endl;\n')
193+
194+
generator_body <- paste0(indent, "INPUTS\n", indent, "PRINT_INPUTS\n")
195+
runner_body <- paste0(indent, "INPUTS\n", indent,"PRINT_INPUTS\n",inputs_dump)
196+
197+
runner_body <- paste0(runner_body, indent, "try{\n", indent, indent,
198+
function_name, "(", gsub(",$","",proto_args), ");\n")
171199
if(sep == "checks"){
172-
runner_harness_body<-paste0(runner_harness_body,indent,indent,"//ASSERT CONDITIONS CAN BE ADDED HERE\n")
200+
assert_comment <- "//ASSERT CONDITIONS CAN BE ADDED HERE\n"
201+
runner_body <- paste0(runner_body, indent, indent, assert_comment)
173202
}
174-
runner_harness_body<-paste0(runner_harness_body,indent,"}catch(Rcpp::exception& e){\n",indent,indent,'std::cout<<"Exception Handled"<<std::endl;\n',indent,"}")
175-
write_to_file<-paste0(write_to_file, generator_harness_header, generator_harness_body,"}", runner_harness_header, runner_harness_body, "\n}")
203+
runner_body <- paste0(runner_body, indent, "}catch(Rcpp::exception& e){\n",
204+
indent, indent, 'std::cout<<"Exception Handled"',
205+
"<<std::endl;\n", indent, "}")
206+
207+
write_to_file<-paste0(write_to_file, generation_comment, inputs, print_values,
208+
generator_header, generator_body, "}", runner_header,
209+
runner_body, "\n}")
210+
176211
write(write_to_file,file_path,append=TRUE)
177212

178213
return(filename)

0 commit comments

Comments
 (0)