tests/testthat/test-render.R

# -- render.hypertext.tag ---------------------------------------------------

test_that("render produces correct HTML for simple element", {
  node <- tags$div("hello")
  expect_equal(render(node), "<div>hello</div>")
})

test_that("render produces correct HTML for element with attributes", {
  node <- tags$p(class = "lead", "text")
  expect_equal(render(node), '<p class="lead">text</p>')
})

test_that("render handles empty element", {
  node <- tags$div()
  expect_equal(render(node), "<div></div>")
})

test_that("render handles void elements as self-closing", {
  node <- tags$br()
  expect_equal(render(node), "<br />")
})

test_that("render handles void element with attributes", {
  node <- tags$input(type = "text", name = "user")
  expect_equal(render(node), '<input type="text" name="user" />')
})

test_that("render handles nested elements", {
  node <- tags$div(tags$p("inner"))
  expect_equal(render(node), "<div><p>inner</p></div>")
})

test_that("render handles deeply nested elements", {
  node <- tags$div(tags$ul(tags$li("item")))
  expect_equal(render(node), "<div><ul><li>item</li></ul></div>")
})

test_that("render handles multiple children", {
  node <- tags$div(tags$p("first"), tags$p("second"))
  expect_equal(render(node), "<div><p>first</p><p>second</p></div>")
})

test_that("render handles mixed text and tag children", {
  node <- tags$p("Hello ", tags$strong("world"), "!")
  expect_equal(render(node), "<p>Hello <strong>world</strong>!</p>")
})

test_that("render escapes text children", {
  node <- tags$p("<script>alert('xss')</script>")
  expect_equal(
    render(node),
    "<p>&lt;script&gt;alert(&#39;xss&#39;)&lt;/script&gt;</p>"
  )
})

test_that("render escapes attribute values", {
  node <- tags$div(title = 'say "hi"')
  expect_equal(render(node), '<div title="say &quot;hi&quot;"></div>')
})

test_that("render handles boolean attributes", {
  node <- tags$input(type = "checkbox", checked = TRUE)
  expect_equal(render(node), '<input type="checkbox" checked />')
})

test_that("render handles NA as boolean attribute", {
  node <- tags$input(disabled = NA)
  expect_equal(render(node), "<input disabled />")
})

test_that("render drops FALSE attributes", {
  node <- tags$input(type = "text", disabled = FALSE)
  expect_equal(render(node), '<input type="text" />')
})

test_that("render drops NULL attributes", {
  node <- tags$div(id = "x", class = NULL)
  expect_equal(render(node), '<div id="x"></div>')
})

test_that("render collapses multi-value class attribute", {
  node <- tags$div(class = c("a", "b", "c"))
  expect_equal(render(node), '<div class="a b c"></div>')
})

# -- render.default --------------------------------------------------------

test_that("render.default escapes text", {
  expect_equal(render("a<b"), "a&lt;b")
})

test_that("render.default coerces to character", {
  expect_equal(render(42), "42")
})

test_that("render.default handles empty string", {
  expect_equal(render(""), "")
})

# -- render.list -----------------------------------------------------------

test_that("render.list concatenates rendered elements", {
  nodes <- list(tags$p("a"), tags$p("b"))
  expect_equal(render(nodes), "<p>a</p><p>b</p>")
})

test_that("render.list handles mixed tags and text", {
  nodes <- list("hello ", tags$strong("world"))
  expect_equal(render(nodes), "hello <strong>world</strong>")
})

test_that("render.list handles empty list", {
  expect_equal(render(list()), "")
})

test_that("render.list handles single element", {
  nodes <- list(tags$div("one"))
  expect_equal(render(nodes), "<div>one</div>")
})

# -- render with file (file output) ----------------------------------------

test_that("render writes tag to a file path and returns invisibly", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  node <- tags$div("hello")
  result <- withVisible(render(node, file = tmp))

  expect_false(result$visible)
  expect_equal(result$value, "<div>hello</div>")
  expect_equal(readLines(tmp, warn = FALSE), "<div>hello</div>")
})

test_that("render writes void element to a file path", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  node <- tags$br()
  render(node, file = tmp)

  expect_equal(readLines(tmp, warn = FALSE), "<br />")
})

test_that("render writes nested HTML to a file path", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  page <- tags$html(
    tags$head(tags$title("Test")),
    tags$body(tags$h1("Hello"))
  )
  render(page, file = tmp)

  expect_equal(
    readLines(tmp, warn = FALSE),
    "<html><head><title>Test</title></head><body><h1>Hello</h1></body></html>"
  )
})

test_that("render.default writes text to a file path", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  result <- withVisible(render("a<b", file = tmp))

  expect_false(result$visible)
  expect_equal(result$value, "a&lt;b")
  expect_equal(readLines(tmp, warn = FALSE), "a&lt;b")
})

test_that("render.list writes concatenated HTML to a file path", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  nodes <- list(tags$p("a"), tags$p("b"))
  result <- withVisible(render(nodes, file = tmp))

  expect_false(result$visible)
  expect_equal(result$value, "<p>a</p><p>b</p>")
  expect_equal(readLines(tmp, warn = FALSE), "<p>a</p><p>b</p>")
})

test_that("render writes to a connection object", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  con <- file(tmp, open = "w")
  on.exit(close(con), add = TRUE)

  node <- tags$div(class = "test", "content")
  render(node, file = con)

  # flush so readLines sees the output
  flush(con)
  expect_equal(readLines(tmp, warn = FALSE), '<div class="test">content</div>')
})

test_that("render with file = '' returns visibly (default behaviour)", {
  node <- tags$div("hello")
  result <- withVisible(render(node, file = ""))

  expect_true(result$visible)
  expect_equal(result$value, "<div>hello</div>")
})

test_that("render overwrites existing file content", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render(tags$p("first"), file = tmp)
  render(tags$p("second"), file = tmp)

  expect_equal(readLines(tmp, warn = FALSE), "<p>second</p>")
})

# -- render with write_mode ------------------------------------------------

test_that("render overwrites file when write_mode = 'overwrite' explicitly", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render(tags$p("first"), file = tmp)
  render(tags$p("second"), file = tmp, write_mode = "overwrite")

  expect_equal(readLines(tmp, warn = FALSE), "<p>second</p>")
})

test_that("render.hypertext.tag appends to file when write_mode = 'append'", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render(tags$p("first"), file = tmp)
  render(tags$p("second"), file = tmp, write_mode = "append")

  expect_equal(
    readLines(tmp, warn = FALSE),
    "<p>first</p><p>second</p>"
  )
})

test_that("render.default appends to file when write_mode = 'append'", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render("hello", file = tmp)
  render(" world", file = tmp, write_mode = "append")

  expect_equal(readLines(tmp, warn = FALSE), "hello world")
})

test_that("render.list appends to file when write_mode = 'append'", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render(list(tags$p("a")), file = tmp)
  render(list(tags$p("b")), file = tmp, write_mode = "append")

  expect_equal(readLines(tmp, warn = FALSE), "<p>a</p><p>b</p>")
})

test_that("render appends across multiple calls with write_mode = 'append'", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  render(tags$h1("Title"), file = tmp)
  render(tags$p("para 1"), file = tmp, write_mode = "append")
  render(tags$p("para 2"), file = tmp, write_mode = "append")

  expect_equal(
    readLines(tmp, warn = FALSE),
    "<h1>Title</h1><p>para 1</p><p>para 2</p>"
  )
})

test_that("render errors on invalid write_mode value", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  expect_error(
    render(tags$p("x"), file = tmp, write_mode = "bogus"),
    "arg"
  )
})

test_that("render appends to connection object with write_mode = 'append'", {
  tmp <- tempfile(fileext = ".html")
  on.exit(unlink(tmp), add = TRUE)

  con <- file(tmp, open = "w")
  on.exit(close(con), add = TRUE)

  render(tags$p("first"), file = con)
  render(tags$p("second"), file = con, write_mode = "append")

  flush(con)
  expect_equal(
    readLines(tmp, warn = FALSE),
    "<p>first</p><p>second</p>"
  )
})

test_that("write_mode is ignored when file = '' (returns visibly)", {
  node <- tags$div("hello")
  result <- withVisible(render(node, file = "", write_mode = "append"))

  expect_true(result$visible)
  expect_equal(result$value, "<div>hello</div>")
})

Try the hypertext package in your browser

Any scripts or data that you put into this service are public.

hypertext documentation built on April 18, 2026, 1:06 a.m.