Improving test coverage for PEcAn.remote package

base/remote/DESCRIPTION

@@ -25,6 +25,7 @@ Imports:
 Suggests:
     doSNOW,
     getPass,
+    mockery,
     testthat,
     tools,
     withr

base/remote/tests/testthat/test.check_model_run.R

@@ -0,0 +1,10 @@
+test_that("`check_model_run()` gives correct output for the passed `out` value",{
+  # failure
+  expect_error(
+    check_model_run(c("ERROR IN MODEL RUN")), 
+    "Model run aborted with the following error:\nERROR IN MODEL RUN"
+  )
+
+  # success
+  expect_equal(check_model_run(c("SUCCESS")), TRUE)
+})

base/remote/tests/testthat/test.kill.tunnel.R

@@ -0,0 +1,20 @@
+test_that("`kill.tunnel()` able to read the correct files and log the correct messages to kill tunnel for exe and data", {
+  withr::with_dir(tempdir(), {
+    mockery::stub(kill.tunnel, 'tools::pskill', TRUE)
+    mockery::stub(kill.tunnel, 'dirname', getwd())
+
+    # Kill tunnel to executable
+    settings <- list(host = list(tunnel = getwd()))
+    file_path <- file.path(getwd(), "pid")
+    file.create(file_path)
+    writeLines("1234", file_path)
+    expect_output(kill.tunnel(settings), "Killing tunnel with PID 1234")
+
+    # Kill tunnel to data
+    settings <- list(host = list(data_tunnel = getwd()))
+    file_path <- file.path(getwd(), "pid")
+    file.create(file_path)
+    writeLines("3456", file_path)
+    expect_output(kill.tunnel(settings), "Killing tunnel with PID 3456")
+  })
+})

base/remote/tests/testthat/test.rabbitmq.R

@@ -0,0 +1,79 @@
+test_that("`rabbitmq_parse_uri()` able to parse the rabbitmq uri to smaller variables", {
+  uri <- "amqp://guest:guest@localhost:15672/myvhost"
+  result <- rabbitmq_parse_uri(uri)
+  expect_equal(result$url, "http://localhost:15672/")
+  expect_equal(result$vhost$path, c("myvhost"))
+  expect_equal(result$username, "guest")
+  expect_equal(result$password, "guest")
+})
+
+test_that("`rabbitmq_send_message()` able to return content if the status code is between 200 and 299", {
+  mockery::stub(rabbitmq_send_message, 'httr::GET', data.frame(status_code = 200))
+  mockery::stub(rabbitmq_send_message, 'httr::content', "test")
+  res <- rabbitmq_send_message(url = 'test/', auth = 'test', body = 'test', action = "GET")
+  expect_equal(res, "test")
+})
+
+test_that("`rabbitmq_send_message()` throws error where it should", {
+  PEcAn.logger::logger.setUseConsole(TRUE, FALSE)
+  on.exit(PEcAn.logger::logger.setUseConsole(TRUE, TRUE), add = TRUE)
+
+  # errors if the action specified is unknown
+  expect_output(
+    rabbitmq_send_message(url = 'test/', auth = 'test', body = 'test', action = "TEST"),
+    "uknown action TEST"
+  )
+
+  # errors if the status code is 401 (username/password may be incorrect)
+  mockery::stub(rabbitmq_send_message, 'httr::GET', data.frame(status_code = 401))
+  expect_output(
+    rabbitmq_send_message(url = 'test/', auth = 'test', body = 'test', action = "GET"),
+    "error sending message to rabbitmq"
+  )
+
+  # errors if the status code is outside of 200-299 and not 401
+  mockery::stub(rabbitmq_send_message, 'httr::GET', data.frame(status_code = 501))
+  mockery::stub(rabbitmq_send_message, 'httr::content', "test")
+  expect_output(
+    rabbitmq_send_message(url = 'test/', auth = 'test', body = 'test', action = "GET"),
+    "error sending message to rabbitmq \\[ 501 \\]"
+  )
+})
+
+test_that("`rabbitmq_create_queue()` able to take care of condition if the queue already exists or not while creating a queue", {
+  mocked_res <- mockery::mock(NA, 'test')
+  mockery::stub(rabbitmq_create_queue, 'rabbitmq_send_message', mocked_res)
+  res <- rabbitmq_create_queue(url = 'test', auth = 'test', vhost = 'test', queue = 'test')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(res, TRUE)
+  expect_equal(args[[1]][[4]], 'GET')
+  expect_equal(args[[2]][[4]], 'PUT')
+})
+
+test_that("`rabbitmq_post_message()` passes the right params to send message to rabbitmq", {
+  mocked_res <- mockery::mock('test')
+  mockery::stub(rabbitmq_post_message, 'rabbitmq_send_message', mocked_res)
+  mockery::stub(rabbitmq_post_message, 'rabbitmq_create_queue', TRUE)
+  res <- rabbitmq_post_message(uri = 'amqp://guest:guest@localhost:15672/myvhost', queue = 'test_queue', message = 'test_message')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(res, 'test')
+  expect_equal(args[[1]][[1]], 'http://localhost:15672/api/exchanges/myvhost//publish')
+  expect_equal(args[[1]][[3]]$properties$delivery_mode, 2)
+  expect_equal(args[[1]][[3]]$routing_key, 'test_queue')
+  expect_equal(args[[1]][[3]]$payload, jsonlite::toJSON('test_message', auto_unbox = TRUE))
+  expect_equal(args[[1]][[3]]$payload_encoding, 'string')
+  expect_equal(args[[1]][[4]], 'POST')
+})
+
+test_that("`rabbitmq_get_message()` passes the right params to send message to rabbitmq", {
+  mocked_res <- mockery::mock(NA)
+  mockery::stub(rabbitmq_get_message, 'rabbitmq_send_message', mocked_res)
+  mockery::stub(rabbitmq_get_message, 'rabbitmq_create_queue', TRUE)
+  res <- rabbitmq_get_message(uri = 'amqp://guest:guest@localhost:15672/myvhost', queue = 'test_queue')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], 'http://localhost:15672/api/queues/myvhost/test_queue/get')
+  expect_equal(args[[1]][[3]]$count, 1)
+  expect_equal(args[[1]][[3]]$ackmode, 'ack_requeue_false')
+  expect_equal(args[[1]][[3]]$encoding, 'auto')
+  expect_equal(args[[1]][[4]], 'POST')
+})

base/remote/tests/testthat/test.remote.copy.from.R

@@ -0,0 +1,12 @@
+test_that("`remote.copy.from()` constructs the correct system command to be executed for doing the copy", {
+  mocked_res <- mockery::mock(0)
+  mockery::stub(remote.copy.from, 'system2', mocked_res)
+  mockery::stub(remote.copy.from, 'file.exists', TRUE)
+  remote.copy.from(host = data.frame(name = 'pecan', tunnel = 'test_tunnel'), src = 'tmp/', dst = 'tmp/', delete = TRUE)
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], 'rsync')
+  expect_equal(
+    args[[1]][[2]], 
+    shQuote(c("-az", "-q", "--delete", "-e", "ssh -o ControlPath=\"test_tunnel\"", "pecan:tmp/", "tmp/"))
+  )
+})

base/remote/tests/testthat/test.start_qsub.R

@@ -0,0 +1,11 @@
+test_that("`start_qsub()` able to correctly make the command to be executed remotely to start qsub runs", {
+  mocked_res <- mockery::mock(0)
+  mockery::stub(start_qsub, 'remote.execute.cmd', mocked_res)
+  res <- start_qsub(1, "qsub -N @NAME@ -o @STDOUT@ -e @STDERR@", "test_rundir", "pecan", "test_host_rundir", "test_host_outdir", "test_stdout_log", "test_stderr_log", "test_job_script")
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], 'pecan')
+  expect_equal(args[[1]][[2]], c('qsub', '-N', 'PEcAn-1', '-o', 'test_host_outdir/1/test_stdout_log', '-e', 'test_host_outdir/1/test_stderr_log'))
+  expect_equal(args[[1]][[3]][[1]], 'test_host_rundir/1/test_job_script')
+  expect_equal(args[[1]]$stderr, TRUE)
+  expect_equal(res, 0)
+})

base/remote/tests/testthat/test.start_rabbitmq.R

@@ -0,0 +1,13 @@
+test_that("`start_rabbitmq()` able to correctly read the environment varibles and send desired values to rabbitmq_post_message", {
+  withr::with_envvar(c("RABBITMQ_PREFIX" = "prefix", "RABBITMQ_PORT" = "3000"),{
+    mocked_res <- mockery::mock(TRUE)
+    mockery::stub(start_rabbitmq, 'rabbitmq_post_message', mocked_res)
+    res <- start_rabbitmq('test_folder', 'test_uri', 'test_queue')
+    args <- mockery::mock_args(mocked_res)
+    expect_equal(args[[1]][[1]], 'test_uri')
+    expect_equal(args[[1]][[2]], 'test_queue')
+    expect_equal(args[[1]][[3]], list(folder = 'test_folder'))
+    expect_equal(args[[1]][[4]], 'prefix')
+    expect_equal(args[[1]][[5]], '3000')
+  })
+})

base/remote/tests/testthat/test.start_serial.R

@@ -0,0 +1,9 @@
+test_that("`start_serial()` able to pass desired parameters to execute command remotely to start model execution in serial mode",{
+  mocked_res <- mockery::mock(TRUE)
+  mockery::stub(start_serial, 'remote.execute.cmd', mocked_res)
+  res <- start_serial('test_run', 'pecan', 'test_rundir', 'test_host_rundir', 'test_job_script')
+  args <- mockery::mock_args(mocked_res)
+  expect_equal(args[[1]][[1]], 'pecan')
+  expect_equal(args[[1]][[2]], 'test_host_rundir/test_run/test_job_script')
+  expect_equal(res, TRUE)
+})