tests/testthat/test_GenericTracker.R

context("Test that GenericTracker works as expected")

test_database <- "unittest_mllogr"
test_collection <- "test_generic_tracker"

test_that("Initialization works well", {
  expect_error(
    test_tracker <<- GenericTracker$new( #nolint
      database = test_database,
      collection = test_collection,
      fields = list(
        field("field1", validate = is.numeric),
        field("field2", is_compulsary = TRUE),
        field("field3"),
        field(
          "field4",
          validate = is.character,
          is_compulsary = TRUE
        )
        )
      ),
    NA)
})

test_that("merge_input_fields works", {
   test_tracker$fields[[1]][["value"]] <- 1
   test_tracker$fields[[2]][["value"]] <- 2
   private_tracker <- get_private(test_tracker)
   expect_warning(
     private_tracker$merge_input_fields(list(field1 = 2))
   )
   expect_warning(
     private_tracker$merge_input_fields(list(field1 = 2, field2 = 2))
   )
   expect_warning(
     private_tracker$merge_input_fields(list(field1 = 1)),
     NA
   )
   expect_equal(
     suppressWarnings(
       private_tracker$merge_input_fields(list(field1 = 2))[[1]][["value"]]),
     2
   )
   test_tracker$fields[[1]][["value"]] <- 1
   test_tracker$fields[[2]][["value"]] <- 2
   expect_equal(
     purrr::map(
       private_tracker$merge_input_fields(list(field3 = 3)),
       "value"
       ),
     list(field1 = 1, field2 = 2, field3 = 3, field4 = NULL)
     )
   expect_equal(
     purrr::map(
       private_tracker$merge_input_fields(list()),
       "value"
       ),
     list(field1 = 1, field2 = 2, field3 = NULL, field4 = NULL)
     )
   })

test_that("check_all_compulsary_fields works.", {
   private_tracker <- get_private(test_tracker)
   expect_error(
     private_tracker$check_all_compulsary_fields()
   )
   test_tracker$fields[[4]][["value"]] <- "abc"
   private_tracker <- get_private(test_tracker)
   expect_error(
     private_tracker$check_all_compulsary_fields(),
     NA
   )
   expect_error(
     private_tracker$check_all_compulsary_fields(c("field1", "field3"))
   )
   })

test_that("set works as expected", {
  test_tracker <- GenericTracker$new( #nolint
      database = test_database,
      collection = test_collection,
      fields = list(
        field("field1", validate = is.numeric),
        field("field2", is_compulsary = TRUE),
        field("field3"),
        field(
          "field4",
          validate = is.character,
          is_compulsary = TRUE
        )
        )
      )
  expect_error(test_tracker$set(1, 2))
  expect_error(test_tracker$set(wrong_field = 4))
  expect_error(test_tracker$set(field1 = "wrong_format"))
  expect_warning(test_tracker <- test_tracker$set(field1 = 3), NA)
  expect_equal(
    purrr::map(test_tracker$fields, "value")[1],
    list(field1 = 3)
  )
  # Overwriting a field
  expect_warning(test_tracker$set(field1 = 4))
  expect_equal(
    purrr::map(test_tracker$fields, "value")[1],
    list(field1 = 4)
  )
  expect_error(test_tracker$set(field2 = 2, field4 = "a"), NA)
  expect_equal(
    purrr::map(test_tracker$fields, "value"),
    list(field1 = 4, field2 = 2, field3 = NULL, field4 = "a")
  )
  })

dbconnection <- mongolite::mongo(
  db = test_tracker$database,
  collection = test_tracker$collection
  )
test_that("log works as expected", {
   dbconnection$remove("{}")
   test_tracker$fields[[1]][["value"]] <- 1
   test_tracker$fields[[2]][["value"]] <- 2
   test_tracker$fields[[4]][["value"]] <- "a"
   test_tracker$log()
   test_log <- dbconnection$find("{}")
   expect_equal(
     test_log,
     structure(list(
         field1 = list(1),
         field2 = list(2),
         field4 = list("a")
         ), class = "data.frame", row.names = 1L)
     )

   dbconnection$remove("{}")
   suppressWarnings(
    test_tracker$log(field3 = 3, field4 = "b")
   )
   test_log <- dbconnection$find("{}")
   expect_equal(
     test_log,
     structure(list(
         field1 = list(1),
         field2 = list(2),
         field3 = list(3),
         field4 = list("b")
         ), class = "data.frame", row.names = 1L)
     )

   dbconnection$remove("{}")
   test_tracker$fields[[4]][["value"]] <- NULL
   # compulsary field missing
   expect_error(test_tracker$log())
  })

test_that("Late evaluation and timestamps work", {
  test_logger <- GenericTracker$new( #nolint
    test_database,
    test_collection,
    fields = list(
      field_timestamp()
      )
    )
  ref_time <- Sys.time()
  dbconnection$remove("{}")
  test_logger$log()
  test_log <- dbconnection$find("{}")
  expect_gt(test_log[[1]], ref_time)
  })
signaux-faibles/MLlogr documentation built on June 27, 2019, 1:20 p.m.