later callback execution order bug

later_test.R

# This code uses later's C API to schedule callbacks as quickly as possible, and
# it tests if the callbacks execute in the same order that they are scheduled.
# In Docker on Mac, they sometimes do not.

docker run --rm -ti rocker/shiny /bin/bash
R
install.packages(c('cpp11', 'later', 'brio', 'callr', 'cli', 'decor', 'desc',
  'tibble', 'vctrs'))

library(cpp11)
library(later)
cpp_source(
  code = '
#include <cpp11.hpp>
using namespace cpp11;

#include <later_api.h>
#include <iostream>
#include <atomic>

[[cpp11::linking_to("later")]]

#define N_VALUES 1000000

int stored_values[N_VALUES] = {};
std::atomic<int> next_i {0};

void append_value(void* data) {
  int* value = reinterpret_cast<int*>(data);
  stored_values[next_i++] = *value;
  delete value;
}

void print_done_message(void* data) {
  std::cerr << "\\nDone\\n";
}

// This function calls later() to schedule append_value().
[[cpp11::register]]
void schedule_populate_stored_values() {
  next_i = 0;
  for (int i = 0; i < N_VALUES; i++) {
    int* value = new int(i+1);
    later::later(append_value, value, 0.0);
  }

  later::later(print_done_message, NULL, 0.0);
}

[[cpp11::register]]
integers get_stored_values() {
  writable::integers out(N_VALUES);
  for(int i = 0; i < N_VALUES; ++i) {
    out[i] = stored_values[i];
  }
  return out;
}

[[cpp11::register]]
void reset_stored_values() {
  for(int i = 0; i < N_VALUES; ++i) {
    stored_values[i] = 0;
  }
};
')


# This function tests to see if any callbacks are executed in the wrong
# order, and returns a data frame with information about the ones that
# have run in the wrong order.
test_for_mismatches <- function() {
  # Set values to zero.
  reset_stored_values()
  # Schedule the callbacks to populate the stored values.
  schedule_populate_stored_values()
  # Callbacks won't execute yet, so should all be zeros.
  stopifnot(all(get_stored_values() == 0))

  # Run the callbacks
  later::run_now()

  # At this point, the stored values should be an array of integers from 1 to
  # 1e6.

  # Check for any mismatches.
  x <- get_stored_values()
  mismatch_idx <- which(x != 1:1e6)

  # Return indices of mismatches, as well as the values at those indices.
  data.frame(
    idx   = mismatch_idx,
    value = x[mismatch_idx]
  )
}

# ==============================================================================

# Run it once. Note that the resulting data frame shows every entry where the
# value is not equal to the index.
# The `idx` column represents the order that a callback was executed.
# The `value` column represents the order that a callback was scheduled.
test_for_mismatches()
#> Done
#>         idx  value
#> 1    795335 796449
#> 2    795336 795335
#> 3    795337 795336
#> 4    795338 796450
#> ...
#> 2253 797587 796447
#> 2254 797588 797589
#> 2255 797589 796448


# ==============================================================================

# Run it 10 times and store the results in `res`
res <- list()
for (i in 1:10) {
  res[[length(res) + 1]] <- test_for_mismatches()
  message("iteration ", i, " done.")
}

# Inspect the results
str(res)
#> List of 10
#>  $ :'data.frame': 1992 obs. of  2 variables:
#>   ..$ idx  : int [1:1992] 610721 610722 610723 610724 610725 610726 610727 610728 610729 610730 ...
#>   ..$ value: int [1:1992] 611704 610721 611705 610722 611706 610723 610724 611707 611708 610725 ...
#>  $ :'data.frame': 2634 obs. of  2 variables:
#>   ..$ idx  : int [1:2634] 350202 350203 350204 350205 350206 350207 350208 350209 350210 350211 ...
#>   ..$ value: int [1:2634] 350922 350202 350203 350923 350204 350924 350205 350206 350925 350207 ...
#>  $ :'data.frame': 1243 obs. of  2 variables:
#>   ..$ idx  : int [1:1243] 510744 510745 510746 510747 510748 510749 510750 510751 510752 510753 ...
#>   ..$ value: int [1:1243] 511332 510744 511333 510745 511334 510746 511335 511336 511337 510747 ...
#>  $ :'data.frame': 2684 obs. of  2 variables:
#>   ..$ idx  : int [1:2684] 109765 109766 109767 109768 109769 109770 109771 109772 109773 109774 ...
#>   ..$ value: int [1:2684] 110394 109765 110395 109766 109767 109768 109769 109770 109771 109772 ...
#>  $ :'data.frame': 2662 obs. of  2 variables:
#>   ..$ idx  : int [1:2662] 282027 282028 282029 282030 282031 282032 282033 282034 282035 282036 ...
#>   ..$ value: int [1:2662] 282659 282027 282028 282660 282029 282661 282662 282663 282664 282665 ...
#>  $ :'data.frame': 1595 obs. of  2 variables:
#>   ..$ idx  : int [1:1595] 465680 465681 465682 465683 465684 465685 465686 465687 465688 465689 ...
#>   ..$ value: int [1:1595] 466436 466437 465680 465681 465682 465683 465684 465685 465686 465687 ...
#>  $ :'data.frame': 2099 obs. of  2 variables:
#>   ..$ idx  : int [1:2099] 91172 91173 91174 91175 91176 91177 91178 91179 91180 91181 ...
#>   ..$ value: int [1:2099] 91696 91697 91698 91699 91700 91701 91702 91172 91173 91703 ...
#>  $ :'data.frame': 2815 obs. of  2 variables:
#>   ..$ idx  : int [1:2815] 187879 187880 187881 187882 187883 187884 187885 187886 187887 187888 ...
#>   ..$ value: int [1:2815] 188528 187879 187880 187881 187882 187883 187884 187885 187886 187887 ...
#>  $ :'data.frame': 1640 obs. of  2 variables:
#>   ..$ idx  : int [1:1640] 480440 480441 480442 480443 480444 480445 480446 480447 480448 480449 ...
#>   ..$ value: int [1:1640] 481252 480440 480441 481253 480442 481254 481255 480443 480444 480445 ...
#>  $ :'data.frame': 3273 obs. of  2 variables:
#>   ..$ idx  : int [1:3273] 196817 196818 196819 196820 196821 196822 196823 196824 196825 196826 ...
#>   ..$ value: int [1:3273] 197645 196817 197646 197647 196818 196819 196820 196821 196822 197648 ...

head(res[[10]], 20)
#>       idx  value
#> 1  196817 197645
#> 2  196818 196817
#> 3  196819 197646
#> 4  196820 197647
#> 5  196821 196818
#> 6  196822 196819
#> 7  196823 196820
#> 8  196824 196821
#> 9  196825 196822
#> 10 196826 197648
#> 11 196827 196823
#> 12 196828 197649
#> 13 196829 197650
#> 14 196830 196824
#> 15 196831 196825
#> 16 196832 197651
#> 17 196833 196826
#> 18 196834 197652
#> 19 196835 197653
#> 20 196836 196827