Skip to content

Instantly share code, notes, and snippets.

@benfasoli
Created October 9, 2020 19:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save benfasoli/4140f8a6793e4531899f899db19bed64 to your computer and use it in GitHub Desktop.
Save benfasoli/4140f8a6793e4531899f899db19bed64 to your computer and use it in GitHub Desktop.
Test exit handling of forked processes managed by R's parallel library
#!/usr/bin/env Rscript
# Ben Fasoli | benfasoli@gmail.com
# Return number of R processes currently running for active user
get_process_count <- function(x = NA) {
as.integer(system('pgrep -U $USER R | wc -l', intern = T))
}
N_FORKS <- 2
N_ITERATIONS <- 50
INITIAL_PROCESS_COUNT <- get_process_count()
process_counts <- parallel::mclapply(1:N_ITERATIONS,
FUN = get_process_count,
mc.cores = N_FORKS,
mc.preschedule = FALSE)
child_process_counts <- unlist(process_counts) - INITIAL_PROCESS_COUNT
if (any(child_process_counts > N_FORKS)) {
failed_to_exit_count <- max(child_process_counts)
stop(ifelse(failed_to_exit_count == N_ITERATIONS, 'All', failed_to_exit_count),
' child processes failed to exit.')
}
print('Test passed.')
#!/bin/bash
function run_test {
echo
echo "Testing ${VERSION}..."
module load R/$VERSION
Rscript run_test.r
module unload R/$VERSION
}
VERSION=4.0.2 run_test
VERSION=3.6.1 run_test
VERSION=3.5.2 run_test
VERSION=3.4.2 run_test
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment