fix set_source to avoid leaking arrivals from the old source, closes #…

…322

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simmer
 Type: Package
 Title: Discrete-Event Simulation for R
-Version: 4.4.6.4
+Version: 4.4.6.5
 Authors@R: c(
     person("Iñaki", "Ucar", email="[email protected]",
       role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")),

NEWS.md

@@ -1,3 +1,7 @@
+# simmer devel
+
+- Fix `set_source()` to avoid leaking arrivals from the old source (#322).
+
 # simmer 4.4.6.4
 
 ## New features

inst/include/simmer/process/datasrc.h

@@ -1,4 +1,4 @@
-// Copyright (C) 2018-2023 Iñaki Ucar
+// Copyright (C) 2018-2024 Iñaki Ucar
 //
 // This file is part of simmer.
 //
@@ -59,7 +59,21 @@ namespace simmer {
       sim->schedule(delay, this, Source::priority);
     }
 
-    void set_source(const std::any& new_source) {
+  private:
+    RData source;
+    int batch;
+    std::string col_time;
+    VEC<std::string> col_attrs;
+    OPT<std::string> col_priority;
+    OPT<std::string> col_preemptible;
+    OPT<std::string> col_restart;
+    RNum time;
+    VEC<RNum> attrs;
+    RInt priority;
+    RInt preemptible;
+    RBool restart;
+
+    void set_source_impl(const std::any& new_source) {
       if (new_source.type() != typeid(RData))
         Rcpp::stop("data frame required");
       RData df = STDANYCAST<RData>(new_source);
@@ -86,20 +100,6 @@ namespace simmer {
       if (col_preemptible) preemptible = source[*col_preemptible];
       if (col_restart) restart = source[*col_restart];
     }
-
-  private:
-    RData source;
-    int batch;
-    std::string col_time;
-    VEC<std::string> col_attrs;
-    OPT<std::string> col_priority;
-    OPT<std::string> col_preemptible;
-    OPT<std::string> col_restart;
-    RNum time;
-    VEC<RNum> attrs;
-    RInt priority;
-    RInt preemptible;
-    RBool restart;
   };
 
 } // namespace simmer

inst/include/simmer/process/generator.h

@@ -1,5 +1,5 @@
 // Copyright (C) 2015-2016 Bart Smeets and Iñaki Ucar
-// Copyright (C) 2016-2023 Iñaki Ucar
+// Copyright (C) 2016-2024 Iñaki Ucar
 //
 // This file is part of simmer.
 //
@@ -39,12 +39,6 @@ namespace simmer {
       reset_fun();
     }
 
-    void set_source(const std::any& new_source) {
-      if (new_source.type() != typeid(RFn))
-        Rcpp::stop("function required");
-      source = STDANYCAST<RFn>(new_source);
-    }
-
     void run() {
       // get the delay for the next (n) arrival(s)
       RNum delays = source();
@@ -64,6 +58,12 @@ namespace simmer {
 
   private:
     RFn source;
+
+    void set_source_impl(const std::any& new_source) {
+      if (new_source.type() != typeid(RFn))
+        Rcpp::stop("function required");
+      source = STDANYCAST<RFn>(new_source);
+    }
   };
 
 } // namespace simmer

inst/include/simmer/process/source.h

@@ -1,4 +1,4 @@
-// Copyright (C) 2018-2023 Iñaki Ucar
+// Copyright (C) 2018-2024 Iñaki Ucar
 //
 // This file is part of simmer.
 //
@@ -85,7 +85,11 @@ namespace simmer {
 
     REnv get_trajectory() const { return trj; }
 
-    virtual void set_source(const std::any& new_source) = 0;
+    void set_source(const std::any& new_source) {
+      bool ready = deactivate();
+      set_source_impl(new_source);
+      if (ready) activate();
+    }
 
     void set_trajectory(const REnv& new_trj) {
       trj = new_trj;
@@ -127,6 +131,8 @@ namespace simmer {
   private:
     REnv trj;
     ArrSet ahead;
+
+    virtual void set_source_impl(const std::any& new_source) = 0;
   };
 
 } // namespace simmer

tests/testthat/test-trajectory-set-trajectory-source.R

@@ -1,4 +1,4 @@
-# Copyright (C) 2018-2023 Iñaki Ucar
+# Copyright (C) 2018-2024 Iñaki Ucar
 #
 # This file is part of simmer.
 #
@@ -35,19 +35,38 @@ test_that("we can set a new trajectory", {
 })
 
 test_that("we can set a new source", {
-  t <- trajectory() %>%
-    set_source("dummy_gen", function() 2) %>%
+  t_gen <- trajectory() %>%
+    set_source("dummy_gen", function() 2)
+
+  t_df <- trajectory() %>%
     set_source("dummy_df", data.frame(time=rep(2, 20)))
 
   env <- simmer(verbose = env_verbose) %>%
-    add_generator("dummy_gen", t, function() 1) %>%
-    add_dataframe("dummy_df", t, data.frame(time=rep(1, 20)), batch=1) %>%
+    add_generator("dummy_gen", t_gen, function() 1) %>%
+    add_dataframe("dummy_df", t_df, data.frame(time=rep(1, 20)), batch=1) %>%
     run(10)
   arr <- get_mon_arrivals(env)
 
   expect_equal(arr$start_time, rep(c(1, 3, 5, 7, 9), each=2))
 })
 
+test_that("setting a new source deactivates the old one first", {
+  traj1 <- trajectory() %>%
+    timeout(100)
+
+  traj2 <- trajectory() %>%
+    set_source("gen", function() -10)
+
+  env <- simmer(verbose = env_verbose) %>%
+    add_generator("gen", traj1, function() 1) %>%
+    add_generator("stopper", traj2, at(1.5))  %>%
+    run(600)
+  arr <- get_mon_arrivals(env)
+
+  expect_equal(arr$start_time, c(1.5, 1))
+  expect_equal(arr$end_time, c(1.5, 101))
+})
+
 test_that("other activities cannot modify the behaviour", {
   t1 <- trajectory() %>%
     timeout(1)