tests/testthat/test-flow-right.R

In dotCall64: Enhanced Foreign Function Interface Supporting Long Vectors

context("test-flow-right")

## test right side of flow chart
## consider the 'r' variable
intent <- c("r", "w")
tg <- expand.grid(signature = c("int", "double", "int64"),
            type = c("int", "double"),
            referenced = c("ref", "notRef"),
            stringsAsFactors = FALSE)

for(i in 1:nrow(tg)){
test_that(paste0("right-", paste0(tg[i,], collapse = "-")), {
    signature <- tg[i, "signature"]
    type <- tg[i, "type"]
    referenced <- if(tg[i, "referenced"] == "ref") TRUE else FALSE
    info <- paste0("signature:", signature,
                   ", type:", type, ", i:", i)

    a <- switch(type,
                int = 5L,
                double = 7.6,
                int64 = 2^32)

    if(referenced){
       b <- switch(type,
                   int = 1L,
                   double = 1.0,
                   int64 = 1.0)
    } else
       b <- switch(type,
                    int = integer_dc(1),
                    double = numeric_dc(1),
                    int64 = numeric_dc(1))
      
    expr <- expression(
          .C64(paste0("TEST_times2_", signature),
               c(signature, signature),
               a = a,
               r = b,
               INTENT = intent,
               PACKAGE = "dotCall64",
               VERBOSE = 1))

    dc <- suppressWarnings(eval(expr))
    a_out <- if(signature %in% c("int", "int64")) as.integer(a) else a
    r_out <- 2L * a_out
    ## currently returned objects are of type "signature"
    r_out <- if(signature == "int") as.integer(r_out) else as.double(r_out)
    dc_e <- list(a = NULL, r =  r_out)
    expect_equal(dc, dc_e,
                 info = info)
    expect_equal(typeof(dc$r), typeof(dc_e$r),
                 info = info)

    ## test for corrupted R objects
    expect_identical(a, switch(type,
                               int = 5L,
                               double = 7.6,
                               int64 = 2^32),
                     label = "[corrupt R object]",
                     info = info)
 
    if(referenced)
      expect_identical(b, switch(type,
                                 int = 1L,
                                 double = 1.0,
                                 int64 = 1.0),
                      label = "[corrupt R object]",
                      info = info)


    ## test warnings
    if(referenced){
      expect_warning(eval(expr),
                     "[dotCall64|referenced R object]",
                     label = "[dotCall64|referenced R object]",
                     info = info)
    } else {
      ## expect_that(eval(expr),
      ##             not(gives_warning("[dotCall64|referenced R object]")),
      ##             label = "[dotCall64|referenced R object]",
      ##             info = info)
    }


    if(signature != type && !(signature == "int64" && type == "double")) {
       expect_warning(eval(expr), "[dotCall64|wrong R object type]",
                      info = info,
                      label = "[dotCall64|wrong R object type]")
   } else {
       ## expect_that(eval(expr),
       ##             not(gives_warning("[dotCall64|wrong R object type]")),
       ##             info = info)
   }
})
}