###################################
### Unit Test Utility Functions ###
###################################
# The following functions are simply used to facilitate
# the unit tests implemented by this package. For example, the user
# may install this package with the correct drivers but not have any
# valid GPU devices or a valid GPU may not support double precision.
# These functions will allow some tests to be skipped so that all
# relevant functions can be evaluated.
# check if any GPUs can be found
#' @title Skip test for GPUs
#' @description Function to skip testthat tests
#' if no valid GPU's are detected
#' @export
has_gpu_skip <- function() {
gpuCheck <- try(detectGPUs(), silent=TRUE)
if(class(gpuCheck)[1] == "try-error"){
testthat::skip("No GPUs available")
}else{
if (gpuCheck == 0) {
testthat::skip("No GPUs available")
}
}
}
# check if multiple GPUs can be found
#' @title Skip test in less than 2 GPUs
#' @description Function to skip testthat tests
#' if less than 2 valid GPU's are detected
#' @export
has_multiple_gpu_skip <- function() {
gpuCheck <- try(detectGPUs(), silent=TRUE)
if(class(gpuCheck)[1] == "try-error"){
testthat::skip("No GPUs available")
}else{
if (gpuCheck < 2) {
testthat::skip("Only one GPU available")
}
}
}
# check if any CPUs can be found
#' @title Skip test for CPUs
#' @description Function to skip testthat tests
#' if no valid CPU's are detected
#' @export
has_cpu_skip <- function() {
cpuCheck <- try(detectCPUs(), silent=TRUE)
if(class(cpuCheck)[1] == "try-error"){
testthat::skip("No CPUs available")
}else{
if (cpuCheck == 0) {
testthat::skip("No CPUs available")
}
}
}
# check if GPU supports double precision
#' @title Skip test for GPU double precision
#' @description Function to skip testthat tests
#' if the detected GPU doesn't support double precision
#' @export
has_double_skip <- function() {
deviceCheck <- try(deviceHasDouble(), silent=TRUE)
if(class(deviceCheck)[1] == "try-error"){
testthat::skip("Default device doesn't have double precision")
}else{
if (!deviceCheck) {
testthat::skip("Default device doesn't support double precision")
}
}
}
# check if multiple GPUs supports double precision
#' @title Skip test for multiple GPUs with double precision
#' @description Function to skip testthat tests
#' if their aren't multiple detected GPU with double precision
#' @export
has_multiple_double_skip <- function() {
contexts <- listContexts()
gpus_with_double = 0
for(i in seq(nrow(contexts))){
gpuCheck <- try(
deviceHasDouble(contexts$platform_index[i] + 1L,
contexts$device_index[i] + 1L)
, silent=TRUE)
if(class(gpuCheck)[1] == "try-error"){
next
}else{
if (!gpuCheck) {
# This device doesn't support double precision
}else{
gpus_with_double = gpus_with_double + 1
}
}
}
if(gpus_with_double < 2){
testthat::skip("Less than 2 GPUs with double precision")
}
}
#' @title Set Context for Specific Device Type
#' @description This function find the first context
#' that contains a device of the specified type.
#' @param type A character vector specifying device type
#' @return An integer indicating previous context index
#' @importFrom utils head
#' @export
set_device_context <- function(type){
current_context <- currentContext()
if(deviceType() != type){
contexts <- listContexts()
cpus <- contexts[contexts$device_type == type,"context"]
if(length(cpus) == 0){
testthat::skip("No CPUs available")
}else{
}
setContext(head(cpus, 1))
}
return(current_context)
}
#' @title POCL Version Check
#' @description Versions of POCL up to 0.15-pre have a bug
#' which results in values being returned when NA values
#' should be (e.g. fractional powers of negative values)
#' @export
pocl_check <- function(){
p <- platformInfo()
if(p$platformName == "Portable Computing Language"){
v <- p$platformVersion
v_split <- unlist(strsplit(v, "pocl"))
v_sub <- v_split[length(v_split)]
version <- as.numeric(regmatches(v_sub, regexpr("[0-9]\\d*(\\.\\d+)?", v_sub)))
if(version <= 0.15){
testthat::skip("pocl version too old")
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.