Add unit tests

Author: keller-mark

R/widget.R

@@ -247,13 +247,13 @@ AnyHtmlWidget <- R6::R6Class("AnyHtmlWidget",
     },
     #' @description
     #' Render the widget.
-    render = function() {
+    render = function(return_widget = FALSE) {
       if(private$.mode == "static") {
-        invoke_static(self)
+        invoke_static(self, return_widget = return_widget)
       } else if(private$.mode == "gadget") {
-        invoke_gadget(self)
+        invoke_gadget(self, return_widget = return_widget)
       } else if(private$.mode == "dynamic") {
-        invoke_dynamic(self)
+        invoke_dynamic(self, return_widget = return_widget)
       } else {
         stop("render is meant for use with static, gadget, and dynamic modes")
       }
@@ -262,18 +262,21 @@ AnyHtmlWidget <- R6::R6Class("AnyHtmlWidget",
 )
 
 #' @keywords internal
-invoke_static <- function(w) {
+invoke_static <- function(w, return_widget = FALSE) {
   w <- the_anyhtmlwidget(
     esm = w$.get_esm(),
     values = w$.get_values(),
     width = w$.get_width(),
     height = w$.get_height()
   )
+  if(return_widget) {
+    return(w)
+  }
   print(w)
 }
 
 #' @keywords internal
-invoke_dynamic <- function(w) {
+invoke_dynamic <- function(w, return_widget = FALSE) {
   w$.start_server()
   w <- the_anyhtmlwidget(
     esm = w$.get_esm(),
@@ -283,11 +286,14 @@ invoke_dynamic <- function(w) {
     port = w$.get_port(),
     host = w$.get_host()
   )
+  if(return_widget) {
+    return(w)
+  }
   print(w)
 }
 
 #' @keywords internal
-invoke_gadget <- function(w) {
+invoke_gadget <- function(w, return_widget = FALSE) {
   ui <- shiny::tagList(
     anyhtmlwidget_output(output_id = "my_widget", width = '100%', height = '100%')
   )
@@ -322,6 +328,10 @@ invoke_gadget <- function(w) {
     })
   }
 
+  if(return_widget) {
+    return(list(ui = ui, server = server))
+  }
+
   shiny::runGadget(ui, server)
 }
 

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(anyhtmlwidget)
+
+test_check("anyhtmlwidget")

tests/testthat/test-widget.R

@@ -0,0 +1,122 @@
+library(anyhtmlwidget)
+
+esm <- "
+function render({ el, model }) {
+  el.style.border = '4px solid red';
+  let count = () => model.get('count');
+  let btn = document.createElement('button');
+  btn.innerHTML = `count is ${count()}`;
+  btn.addEventListener('click', () => {
+    model.set('count', count() + 1);
+    model.save_changes();
+  });
+  model.on('change:count', () => {
+    btn.innerHTML = `count is ${count()}`;
+  });
+  el.appendChild(btn);
+}
+export default { render };
+"
+
+test_that("counter widget can be instantiated", {
+  w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "static",
+    .height='400px',
+    count = 1
+  )
+
+  expect_equal(w$count, 1)
+
+  # Check that getters work
+  expect_equal(w$.get_value("count"), 1)
+  expect_equal(w$.get_esm(), esm)
+  expect_equal(w$.get_values(), list(
+    count = 1
+  ))
+  expect_equal(w$.get_width(), "100%")
+  expect_equal(w$.get_height(), '400px')
+  expect_equal(w$.get_mode(), "static")
+  expect_equal(w$.get_host(), "0.0.0.0")
+  expect_true(is.numeric(w$.get_port()))
+
+  # Check that setters work
+  w$.set_value("count", 3, emit_change = FALSE)
+  expect_equal(w$.get_value("count"), 3)
+
+  # Check that onChange handler works.
+  # Create an empty list to track calls to the handler.
+  change_list <<- list()
+  handle_change <- function(key, new_val) {
+    # Append to the list of { key, val }
+    # pairs of tracked changes
+    change_list <<- append(change_list,
+      list(list(key = key, val = new_val))
+    )
+  }
+  w$.on_change(handle_change)
+
+  w$.set_value("count", 5, emit_change = FALSE)
+  expect_equal(w$.get_value("count"), 5)
+  expect_equal(length(change_list), 0)
+
+  w$.set_value("count", 6, emit_change = TRUE)
+  expect_equal(w$.get_value("count"), 6)
+  expect_equal(length(change_list), 1)
+  expect_equal(change_list[[1]], list(key = "count", val = 6))
+
+  w$.set_value("count", 7, emit_change = TRUE)
+  expect_equal(w$.get_value("count"), 7)
+  expect_equal(length(change_list), 2)
+  expect_equal(change_list[[1]], list(key = "count", val = 6))
+  expect_equal(change_list[[2]], list(key = "count", val = 7))
+})
+
+test_that("invalid mode parameter value results in error", {
+  expect_error(AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "INVALID",
+    .height='400px',
+    count = 1
+  ), "Invalid widget mode.")
+})
+
+test_that("render return value reflects mode", {
+  static_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "static",
+    .height='400px',
+    count = 1
+  )
+
+  render_val <- static_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("anyhtmlwidget", "htmlwidget"))
+
+  dynamic_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "dynamic",
+    .height='400px',
+    count = 1
+  )
+  render_val <- dynamic_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("anyhtmlwidget", "htmlwidget"))
+  
+  shiny_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "shiny",
+    .height='400px',
+    count = 1
+  )
+  expect_error(shiny_w$render(return_widget = TRUE), "render is meant for use with static, gadget, and dynamic modes")
+
+  gadget_w <- AnyHtmlWidget$new(
+    .esm = esm,
+    .mode = "gadget",
+    .height='400px',
+    count = 1
+  )
+  render_val <- gadget_w$render(return_widget = TRUE)
+  expect_equal(class(render_val), c("list"))
+  expect_equal(names(render_val), c("ui", "server"))
+
+})