Test exit handling of forked processes managed by R's parallel library

run_test.r

#!/usr/bin/env Rscript
# Ben Fasoli | [email protected]

# 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.')

test.sh

#!/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