tests/testthat/test-rswipl.R

In rswipl: Embed 'SWI'-'Prolog'

test_that("queries can be formed", 
{
  q <- query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  clear()
  expect_true(q)
})

test_that("atoms are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  q <- submit()
  clear()

  expect_equal(q$X, quote(a))
})

test_that("strings are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  q <- submit()
  clear()

  expect_equal(q$X, "b")
})

test_that("integers are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  q <- submit()
  clear()

  expect_equal(q$X, 3L)
})

test_that("floating point numbers are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_equal(q$X, 4)
})

test_that("booleans are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_true(q$X)
})

test_that("variables are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  if(!is.null(q$X))
    return(expect_identical(q$X, expression(Y)))
  if(!is.null(q$Y))
    return(expect_identical(q$Y, expression(X)))

  fail()
})

test_that("missing values are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_true(is.na(q$X))
})

test_that("nans are properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_true(is.nan(q$X))
})

test_that("Inf is properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_equal(q$X, Inf)
})

test_that("NULL is properly translated",
{
  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_null(q$X)
})

test_that("formals are properly translated",
{
  f <- function(x) {y <- sin(x); y^2}

  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL, f)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_identical(formals(q$X), formals(f))
})

test_that("function bodies are properly translated",
{
  f <- function(x) {y <- sin(x); y^2}
  bf <- body(f)

  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL, f)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  bq <- body(q$X)
  expect_identical(sapply(FUN=as.character, bf), sapply(FUN=as.character, bq))
})

test_that("matrices are properly translated",
{
  m <- matrix(1:6, nrow=2)

  query(call("member", expression(X), list(quote(a), "b", 3L, 4, TRUE, expression(Y), NA, NaN, Inf, NULL, m)))
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  submit()
  q <- submit()
  clear()

  expect_identical(q$X, m)
})

# For the future (currently memory leaking)
#
# test_that("check_installation works",
# {
#   query(call("check_installation"))
#   q <- submit()
#   clear()
# 
#   # A few warnings will be displayed, that is fine.
#   expect_equal(q, list())
# })
#
# test_that("test_installation works",
# {
#   query(call("test_installation", 
#     list(call(arguments(list("-e", "rswipl:::swipl()", "-q", "--no-echo", "--args"))))
#   q <- submit()
#   clear()
#
#   expect_equal(q, list())
# })