changes supporting or noticed due to work on nimbleModel

nCompiler/R/NC.R

@@ -180,6 +180,24 @@ nClass <- function(classname,
       stop("In nFunction 'initialize', use 'compileInfo = list(constructor=TRUE)'.")
   }
 
+  if('initialize' %in% names(Rpublic) && is.function(Rpublic[['initialize']])) {
+    init_body_text <- deparse(body(Rpublic[['initialize']]))
+    has_super_init    <- any(grepl("super\\$initialize",  init_body_text))
+    has_init_cpublic  <- any(grepl("initialize_Cpublic", init_body_text))
+    if(!has_super_init && !has_init_cpublic)
+      warning(
+        "The Rpublic 'initialize' function does not call 'super$initialize()' or ",
+        "'initialize_Cpublic()'. Without one of these, the Cpublic component will not ",
+        "be properly set up, and compiled nClass objects returned from nFunctions will ",
+        "not be connected to their C++ data. ",
+        "Add '...' to the 'initialize' signature and call 'super$initialize(...)' ",
+        "(recommended) so that the `CppObj` argument is forwarded when returning an nClass ",
+        "from a compiled nFunction. Alternatively use 'initialize_Cpublic()' followed by ",
+        "'if(isCompiled()) initializeCpp()' for manual control.",
+        call. = FALSE
+      )
+  }
+
   inheritQ <- substitute(inherit)
   inherit_provided <- !is.null(inheritQ)
 

nCompiler/R/NC_LoadedObjectEnv.R

@@ -31,7 +31,7 @@ to_full_interface <- function(LOE) {
     stop("LOE should be a loadedObjectEnv")
   CnCenv <- get_CnCenv(LOE)
   if(exists('.R6interface', CnCenv)) {
-    fullAns <- CnCenv$.R6interface$new(LOE)
+    fullAns <- CnCenv$.R6interface$new(CppObj = LOE)
     return(fullAns)
   }
   LOE # default to non-full
@@ -51,7 +51,7 @@ new.loadedObjectEnv_full <- function(extptr = NULL, parentEnv = NULL) {
   if(!is.null(parentEnv)) { # This doesn't really do anything
     if(exists('.R6interface', parentEnv) &&
        parentEnv$return_mode == "full") {
-        fullAns <- parentEnv$.R6interface$new(ans)
+        fullAns <- parentEnv$.R6interface$new(CppObj = ans)
         return(fullAns)
     }
   }

nCompiler/R/compile_generateCpp.R

@@ -174,7 +174,7 @@ inGenCppEnv(
 inGenCppEnv(
   Assign <- function(code, symTab) {
     orig_name <- code$name
-    code$name <- ' = '
+    code$name <- '='
     res <- MidOperator(code, symTab)
     code$name <- orig_name
     res

nCompiler/R/nCppVec.R

@@ -259,12 +259,33 @@ nList_nClass <- function(type, env = parent.frame()) {
         C_fun = function(i = 'SEXP', value = {{RtypeObj}}) {
           cppLiteral('return doubleBracket_set_(i, value)')
         }
+      )),
+    set_all_values = nFunction(
+      name = "set_all_values",
+      # R-level (uncompiled): handle plain list, uncompiled nList, or compiled
+      # nList (all via duck-typing on as_list).
+      function(Robj = 'SEXP') {
+        if(is.list(Robj)) {
+          Rcontents <<- Robj
+        } else if(is.environment(Robj) &&
+                  exists("as_list", envir = Robj, inherits = FALSE)) {
+          Rcontents <<- Robj$as_list()
+        } else {
+          stop("Uncompiled nList set_all_values requires a list or an nList object.")
+        }
+      },
+      compileInfo = list(
+        # Delegates to set_all_values_() in nList_<Element>, which handles all
+        # four input types without needing explicit namespace qualification.
+        C_fun = function(Robj = 'SEXP') {
+          cppLiteral('set_all_values_(Robj);')
+        }
       ))
     )
   ans <- substitute(
     nClass(
       classname = CLASSNAME,
-      inherit = nListBase_nClass,
+      inherit = nCompiler::nListBase_nClass,
       Cpublic = c(
         list(
           x = TYPE),

nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/SEXP_2_EigenTensor.h

@@ -30,6 +30,11 @@ struct SEXP_2_EigenTensor {
   static EigenTensorType copy(SEXP &Sinput,
                               const IndexArray &indexArray) {
     EigenTensorType xCopy;
+    if(Sinput==R_NilValue) {
+      // Return an empty tensor with the correct shape and scalar type.
+      std::cout<<"  [Warning]: NULL was provided where a numeric, integer or logical object was expected.\n"<<std::endl;
+      return xCopy;
+    }
     typedef typename std::is_same<Scalar, int>::type i_match_type;
     typedef typename std::is_same<Scalar, double>::type d_match_type;
     switch( TYPEOF(Sinput) ) {
@@ -59,7 +64,7 @@ struct SEXP_2_EigenTensor {
                                             );
       break;
     default:
-      std::cout<<"Bad type\n"<<std::endl;
+      std::cout<<"  [Warning]: Invalid R object was provided where a numeric, integer or logical object was expected.\n"<<std::endl;
     }
     return xCopy; // compiler should use copy elision
   }

nCompiler/inst/include/nCompiler/nC_inter/post_Rcpp/generic_class_interface_Rcpp_steps.h

@@ -145,6 +145,7 @@ class genericInterfaceC : virtual public genericInterfaceBaseC {
   // so we iterate through the list and check names against name2access.
   void set_all_values_impl_list(const Rcpp::List Robj) {
     // Cache names once to avoid repeatedly constructing the names vector
+    if(!Robj.length()) return;
     Rcpp::Nullable<Rcpp::CharacterVector> nmsN = Robj.names();
     if(nmsN.isNull()) {
       Rcpp::stop("Setting multiple values of an nClass from a list requires that the list have names.\n");

nCompiler/inst/include/nCompiler/predef/nList_/nList_.h

@@ -331,6 +331,94 @@ class nList_ : public nListBase_nClass {
     //     return res;
     // }
 
+    // CRTP-level implementation called by the generated nList class's
+    // set_all_values Cpublic method (which is the actual virtual override).
+    // Handles all ways an R object may represent a positionally-indexed nList:
+    //   1. plain R list  — compiled or uncompiled elements; handled by set_from_list
+    //   2. compiled nList (LOE/R6 environment with extptr) — copy contents_ directly
+    //   3. uncompiled nList (R6 environment without extptr) — call as_list() then set_from_list
+    void set_all_values_(SEXP Robj) {
+      // Case 1: plain R list — compiled or uncompiled elements positionally
+      if(Rcpp::is<Rcpp::List>(Robj)) {
+        set_from_list(Rcpp::as<Rcpp::List>(Robj));
+        return;
+      }
+      if(Rcpp::is<Rcpp::Environment>(Robj)) {
+        // Case 2: compiled nList — LOE environment containing an extptr
+        Rcpp::RObject Rextptr = get_extptr_from_SEXP(Robj);
+        SEXP Sextptr = Rextptr;
+        if(Sextptr != R_NilValue) {
+          genericInterfaceBaseC* src_base =
+            static_cast<genericInterfaceBaseC*>(
+              static_cast<shared_ptr_holder_base*>(
+                R_ExternalPtrAddr(Sextptr))->get_ptr());
+          nList_<Element>* src = dynamic_cast<nList_<Element>*>(src_base);
+          if(src) {
+            contents_ = src->contents_;
+            return;
+          }
+          Rcpp::stop(
+            "set_all_values on nList: extptr found but object is not an nList.");
+        }
+        // Case 3: uncompiled nList R6 environment — call as_list() to convert
+        Rcpp::Environment Renv(Robj);
+        if(Renv.exists("as_list")) {
+          Rcpp::Function as_list_fn(Renv["as_list"]);
+          SEXP Slist = as_list_fn();
+          if(Rcpp::is<Rcpp::List>(Slist)) {
+            set_from_list(Rcpp::as<Rcpp::List>(Slist));
+            return;
+          }
+        }
+        Rcpp::stop(
+          "set_all_values on nList: environment is neither a compiled nList "
+          "(no extptr) nor a recognised uncompiled nList (no as_list method).");
+      }
+      Rcpp::stop(
+        "set_all_values on nList requires a list, a compiled nList, "
+        "or an uncompiled nList object.");
+    }
+
+    // Populate contents_ positionally from an R list.
+    // Each element is converted to Element:
+    //   - shared_ptr<T>: tries the compiled extptr path first; falls back to
+    //     default-constructing a T and calling set_all_values() on it
+    //     (handles uncompiled objects, plain R lists, and nested nLists).
+    //   - primitive / Eigen tensor: Rcpp::as<Element>().
+    void set_from_list(const Rcpp::List& Robj) {
+      int n = Robj.length();
+      contents_.resize(n);
+      for(int i = 0; i < n; ++i) {
+        SEXP Selem = Robj[i];
+        if constexpr(is_shared_ptr<Element>::value) {
+          Rcpp::RObject Rextptr = get_extptr_from_SEXP(Selem);
+          SEXP Sextptr = Rextptr;
+          if(Sextptr != R_NilValue) {
+            // Compiled object: extract via shared_ptr Exporter
+            contents_[i] = Element(
+              typename Rcpp::traits::input_parameter<Element>::type(Sextptr));
+          } else {
+            // Not compiled (plain R list, uncompiled nClass, nested nList):
+            // create element if absent, then populate recursively
+            if(!contents_[i]) {
+              if constexpr(std::is_default_constructible_v<
+                             typename Element::element_type>) {
+                contents_[i] =
+                  std::make_shared<typename Element::element_type>();
+              } else {
+                Rcpp::stop(
+                  "nList set_from_list: element nClass type has no "
+                  "default constructor.");
+              }
+            }
+            contents_[i]->set_all_values(Selem);
+          }
+        } else {
+          contents_[i] = Rcpp::as<Element>(Selem);
+        }
+      }
+    }
+
     Rcpp::List as_list_() {
       Rcpp::List res(contents_.size());
       for(size_t i = 0; i < contents_.size(); ++i) {

nCompiler/tests/testthat/nClass_tests/test-nClass_constructor.R

@@ -182,6 +182,70 @@ test_that("manual initialize with hand-coded Cpublic initialization works", {
 })
 
 
+test_that("warning issued when Rpublic initialize lacks super$initialize or initialize_Cpublic", {
+  # Should warn: no super$initialize or initialize_Cpublic
+  expect_warning(
+    nClass(
+      classname = "warn_test",
+      Rpublic = list(
+        initialize = function() {
+          self$Ra <- 1
+        },
+        Ra = 0
+      ),
+      Cpublic = list(
+        Ca = 'numericScalar'
+      )
+    ),
+    "super\\$initialize"
+  )
+
+  # Should NOT warn: has super$initialize
+  expect_no_warning(
+    nClass(
+      classname = "no_warn_super",
+      Rpublic = list(
+        initialize = function(...) {
+          super$initialize(...)
+          self$Ra <- 1
+        },
+        Ra = 0
+      ),
+      Cpublic = list(
+        Ca = 'numericScalar'
+      )
+    )
+  )
+
+  # Should NOT warn: has initialize_Cpublic (manual-control pattern)
+  expect_no_warning(
+    nClass(
+      classname = "no_warn_init_cpublic",
+      Rpublic = list(
+        initialize = function() {
+          initialize_Cpublic()
+          if(isCompiled()) initializeCpp()
+          self$Ra <- 1
+        },
+        Ra = 0
+      ),
+      Cpublic = list(
+        Ca = 'numericScalar'
+      ),
+      compileInfo = list(omit_automatic_Cpp_construction = TRUE)
+    )
+  )
+
+  # Should NOT warn: no Rpublic initialize at all
+  expect_no_warning(
+    nClass(
+      classname = "no_warn_no_init",
+      Rpublic = list(Ra = 0),
+      Cpublic = list(Ca = 'numericScalar')
+    )
+  )
+})
+
 test_that("manual initialize OMITTED with hand-coded C++ initialization compiles but is correctly broken", {
   nc <- nClass(
     classname = "methods_test",
@@ -242,3 +306,44 @@ test_that("manual initialize OMITTED with hand-coded C++ initialization compiles
 
   rm(Cobj); gc()
 })
+
+test_that("nClass returned from nFunction connects to correct C++ object when initialize has args before ...", {
+  # This tests the fix where $new(CppObj = LOE) uses a named argument so that
+  # CppObj ends up in ... rather than binding to a positional parameter.
+  # Without the named CppObj, the LOE would bind to Ra_init and be dropped.
+  nc <- nClass(
+    classname = "return_test",
+    Rpublic = list(
+      Ra = 0,
+      initialize = function(Ra_init = 0, ...) {
+        super$initialize(...)   # CppObj = LOE flows through ... when returning from nFunction
+        self$Ra <- Ra_init
+      }
+    ),
+    Cpublic = list(
+      Ca = 'numericScalar'
+    )
+  )
+
+  nf <- nFunction(
+    function() {
+      obj <- nc$new()
+      obj$Ca <- 42
+      return(obj)
+    },
+    returnType = 'nc'
+  )
+
+  Cnc <- nCompile(nc, nf)
+  # Normal user-facing construction: Ra_init is used, Ca should be default (0)
+  user_obj <- Cnc$nc$new(Ra_init = 7)
+  expect_equal(user_obj$Ra, 7)
+  expect_equal(user_obj$Ca, 0)
+
+  # Object returned from compiled nFunction: must be connected to the C++ object
+  # that had Ca set to 42, NOT a freshly default-initialized one.
+  returned_obj <- Cnc$nf()
+  expect_equal(returned_obj$Ca, 42)
+
+  rm(user_obj, returned_obj); gc()
+})