tests/testthat/test-flow-center.R

In dotCall64: Enhanced Foreign Function Interface Supporting Long Vectors

context("test-flow-center")

test_that("double-double", {
  a <- 3.3
  dc <- .C64("TEST_prod_double", c("double", "double"),
             a = a, b = 2,
             PACKAGE = "dotCall64",
             VERBOSE = 1)
  dc_e <- list(a = 6.6, b = 2)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3.3, label = "[modified R object]")

  expr <- expression(.C64("TEST_prod_double",
                          c("double", "double"),
                          a = a, b = 2,
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 1;\ncast.in 0; cast.back 0;")
})


test_that("double-double-modifiedRead", {
  a <- 3.3
  dc <- .C64("TEST_prod_double", c("double", "double"),
             a = a, b = 2, INTENT = c("r", "rw"),
             PACKAGE = "dotCall64", VERBOSE = 1)
  dc_e <- list(a = NULL, b = 2)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 6.6, label = "[modified R object]")

  expr <- expression(.C64("TEST_prod_double",
                          c("double", "double"),
                          a = a, b = 2,
                          INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 1;\ncast.in 0; cast.back 0;")
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 0;\ncast.in 0; cast.back 0;")
})


test_that("int-int", {
  a <- 3L
  dc <- .C64("TEST_prod_int", c("int", "int"),
             a = a, b = 2L,
             PACKAGE = "dotCall64", VERBOSE = 1)
  dc_e <- list(a = 6L, b = 2L)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3L, label = "[modified R object]")

  expr <- expression(.C64("TEST_prod_int",
                          c("int", "int"),
                          a = a, b = 2L,
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 1;\ncast.in 0; cast.back 0")
})


test_that("int-int-modifiedRead", {
  a <- 3L 
  dc <- .C64("TEST_prod_int", c("int", "int"),
             a = a, b = 2L, INTENT = c("r", "rw"),
             PACKAGE = "dotCall64", VERBOSE = 1)
  dc_e <- list(a = NULL, b = 2L)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 6L, label = "[modified R object]")

  expr <- expression(.C64("TEST_prod_int",
                          c("int", "int"),
                          a = a, b = 2L,
                          INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 0;\ncast.in 0; cast.back 0")
  expect_warning(eval(expr),
                 "alloc 0; coerce 0; dup 1;\ncast.in 0; cast.back 0")
})


test_that("int-double-rw", {
  a <- 3
  expr <- expression(.C64("TEST_prod_int", c("int", "int"),
                          a = a, b = 2,
                          PACKAGE = "dotCall64", VERBOSE = 1))
  dc <- suppressWarnings(eval(expr))
  dc_e <- list(a = 6L, b = 2L)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3, label = "[modified R object]")
  expect_warning(eval(expr), "[dotCall64|wrong R object type]",
                 label = "[dotCall64|wrong R object type]")

  expr <- expression(.C64("TEST_prod_int",
                          c("int", "int"),
                          a = a, b = 2,
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 1; dup 0;\ncast.in 0; cast.back 0")
})


test_that("int-double-r", {
  a <- 3
  expr <- expression(.C64("TEST_prod_int", c("int", "int"),
                          a = a, b = 2, INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64", VERBOSE = 1))
  dc <- suppressWarnings(eval(expr))
  dc_e <- list(a = NULL, b = 2L)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3, label = "[modified R object]")
  expect_warning(eval(expr), "[dotCall64|wrong R object type]",
                 label = "[dotCall64|wrong R object type]")

  expr <- expression(.C64("TEST_prod_int",
                          c("int", "int"),
                          a = a, b = 2,
                          INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 1; dup 0;\ncast.in 0; cast.back 0")
})


test_that("double-int-rw", {
  a <- 3L
  expr <- expression(.C64("TEST_prod_double", c("double", "double"),
                          a = a, b = 2L,
                          PACKAGE = "dotCall64", VERBOSE = 1))
  dc <- suppressWarnings(eval(expr))
  dc_e <- list(a = 6, b = 2)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3L, label = "[modified R object]")
  expect_warning(eval(expr), "[dotCall64|wrong R object type]",
                 label = "[dotCall64|wrong R object type]")

  expr <- expression(.C64("TEST_prod_double",
                          c("double", "double"),
                          a = a, b = 2L,
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 1; dup 0;\ncast.in 0; cast.back 0")
})


test_that("double-int-r", {
  a <- 3L
  expr <- expression(.C64("TEST_prod_double", c("double", "double"),
                          a = a, b = 2L, INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64", VERBOSE = 1))
  dc <- suppressWarnings(eval(expr))
  dc_e <- list(a = NULL, b = 2)
  expect_equal(lapply(dc, typeof), lapply(dc_e, typeof))      
  expect_equal(dc, dc_e)
  expect_identical(a, 3L, label = "[modified R object]")
  expect_warning(eval(expr), "[dotCall64|wrong R object type]",
                 label = "[dotCall64|wrong R object type]")

  expr <- expression(.C64("TEST_prod_double",
                          c("double", "double"),
                          a = a, b = 2L,
                          INTENT = c("r", "rw"),
                          PACKAGE = "dotCall64",
                          VERBOSE = 2))
  expect_warning(eval(expr),
                 "alloc 0; coerce 1; dup 0;\ncast.in 0; cast.back 0")
})