diff --git a/nCompiler/R/NC.R b/nCompiler/R/NC.R index 0d4425c9..a8f791e7 100644 --- a/nCompiler/R/NC.R +++ b/nCompiler/R/NC.R @@ -98,7 +98,7 @@ nClass <- function(classname, # exportName: name of the R function to call the # C/C++ function for a new object. Defaults to paste0("new_", classname) # interface ("full"): "full", "generic" or "none". First two: build interface. Fine-grained control possible in future. - # interfaceMembers(NULL): character vector of which members (variables and methods) to include. Default to all + # interfaceInclude(NULL): character vector of which members (variables and methods) to include. Default to all # depends (list()): Values for Cpp::depends. # inherit: list of C++ class inheritances (all public inheritance). # If one is named "base", it will replace the inheritance from @@ -150,7 +150,7 @@ nClass <- function(classname, # object by anything but a default constructor. compileInfo <- updateDefaults( list(exportName = NULL, interface = "full", - interfaceMembers = NULL, + interfaceInclude = NULL, depends = list(), inherit = list(), nClass_inherit = list(), diff --git a/nCompiler/R/NC_InternalsClass.R b/nCompiler/R/NC_InternalsClass.R index ab3c81f3..fbf0354f 100644 --- a/nCompiler/R/NC_InternalsClass.R +++ b/nCompiler/R/NC_InternalsClass.R @@ -18,7 +18,7 @@ NC_InternalsClass <- R6::R6Class( compileInfo = list(), inherit_base_provided = FALSE, # compileInfo will include interface ("full", "generic", or "none"), - # interfaceMembers, exportName, and depends + # interfaceInclude, exportName, and depends depends = list(), RcppPacket = NULL, isOnlyC = FALSE, ## somewhat redundant but perhaps convenient - TBD. diff --git a/nCompiler/R/cppDefs_core.R b/nCompiler/R/cppDefs_core.R index c203eea6..0e767d20 100644 --- a/nCompiler/R/cppDefs_core.R +++ b/nCompiler/R/cppDefs_core.R @@ -342,12 +342,22 @@ addGenericInterface_impl <- function(self) { while(!done) { NCint <- NCinternals(current_NCgen) NCcompInfo <- NCint$compileInfo - interfaceMembers <- NCcompInfo$interfaceMembers - useIM <- !is.null(interfaceMembers) + interfaceInclude <- NCcompInfo$interfaceInclude + interfaceExclude <- NCcompInfo$interfaceExclude + useIM <- !is.null(interfaceInclude) || !is.null(interfaceExclude) + if(useIM) { + if(!is.null(interfaceExclude) && !is.null(interfaceInclude)) { + stop("interfaceExclude and interfaceInclude cannot both be non-null. Something is wrong.") + } + use_include <- !is.null(interfaceInclude) + } methodNames <- NCint$methodNames for(mName in methodNames) { if(mName %in% outputMethodNames) next - if(useIM && !(mName %in% interfaceMembers)) next + if(useIM) { + if(use_include && !(mName %in% interfaceInclude)) next + if(!use_include && (mName %in% interfaceExclude)) next + } NFint <- NFinternals(NC_get_Cpub_class(current_NCgen)$public_methods[[mName]]) NFcompInfo <- NFint$compileInfo if(!useIM && !isTRUE(NFcompInfo$callFromR)) next @@ -379,8 +389,16 @@ addGenericInterface_impl <- function(self) { # I am belaboring what could be done with unique or setdiff to be more # sure that order is preserved aligning fieldNames and cpp_fieldNames new_fieldNames <- NCint$symbolTable$getSymbolNames() - do_interface <- NCint$symbolTable$getSymbols() |> - lapply(\(x) isTRUE(x$interface)) |> unlist() + if(!useIM || !use_include) + do_interface <- NCint$symbolTable$getSymbols() |> + lapply(\(x) isTRUE(x$interface)) |> unlist() + if(useIM) { + if(use_include) { + do_interface <- (new_fieldNames %in% interfaceInclude) + } else { + do_interface <- do_interface & !(new_fieldNames %in% interfaceExclude) + } + } new_fieldNames <- new_fieldNames[do_interface] new_fieldNames <- new_fieldNames[!(new_fieldNames %in% fieldNames)] fieldNames <- c(fieldNames, new_fieldNames) diff --git a/nCompiler/tests/testthat/nCompile_tests/test-interfaceMemberControl.R b/nCompiler/tests/testthat/nCompile_tests/test-interfaceMemberControl.R new file mode 100644 index 00000000..d55b36a9 --- /dev/null +++ b/nCompiler/tests/testthat/nCompile_tests/test-interfaceMemberControl.R @@ -0,0 +1,61 @@ +library(nCompiler) +library(testthat) + +test_that("compileInfo$interfaceInclude and interfaceExclude work", { + nc <- nClass( + Cpublic = list( + a = 'numericScalar', + b = 'numericScalar', + foo = nFunction( + function(){} + ), + foo2 = nFunction( + function() {} + ) + ), + compileInfo = list(interfaceInclude = c('a','foo')) + ) + cppDef <- nCompile(nc, control = list(return_cppDefs = TRUE)) + RcppPacket <- nCompiler:::cppDefs_2_RcppPacket(cppDef[[1]], "filename") + expect_true(grepl('\"a\"',RcppPacket$cppContent$body)|>sum() == 1) + expect_true(grepl('\"b\"',RcppPacket$cppContent$body)|>sum() == 0) + expect_true(grepl('\"foo\"',RcppPacket$cppContent$body)|>sum() == 1) + expect_true(grepl('\"foo2\"',RcppPacket$cppContent$body)|>sum() == 0) + + nc <- nClass( + Cpublic = list( + a = 'numericScalar', + b = 'numericScalar', + foo = nFunction( + function(){} + ), + foo2 = nFunction( + function() {} + ) + ), + compileInfo = list(interfaceExclude = c('b','foo2')) + ) + cppDef <- nCompile(nc, control = list(return_cppDefs = TRUE)) + RcppPacket <- nCompiler:::cppDefs_2_RcppPacket(cppDef[[1]], "filename") + expect_true(grepl('\"a\"',RcppPacket$cppContent$body)|>sum() == 1) + expect_true(grepl('\"b\"',RcppPacket$cppContent$body)|>sum() == 0) + expect_true(grepl('\"foo\"',RcppPacket$cppContent$body)|>sum() == 1) + expect_true(grepl('\"foo2\"',RcppPacket$cppContent$body)|>sum() == 0) + + nc <- nClass( + Cpublic = list( + a = 'numericScalar', + b = 'numericScalar', + foo = nFunction( + function(){} + ), + foo2 = nFunction( + function() {} + ) + ), + compileInfo = list(interfaceExclude = c('b','foo2'), + interfaceInclude = c('a', 'foo')) + ) + cat("Expecting error that interfaceExclude and interfaceInclude cannot both be non-null.\n") + expect_error(cppDef <- nCompile(nc, control = list(return_cppDefs = TRUE))) +})