test_that("HTML unescaping is properly performed", { replace_attr("", "img", "src", function(src) { expect_identical(src, "foo'\u27F5&BadEntity;bar.png") src }) # Tests that native encoding is parsed correctly as well times_called <- 0L replace_attr(enc2native(""), "img", "src", function(src) { expect_identical(Encoding(src), "UTF-8") expect_identical(src, "Á.png") times_called <<- times_called + 1L }) expect_identical(times_called, 2L) }) test_that("HTML escaping is properly performed", { output <- replace_attr("
", "div", "title", function(src) { "special chars '\"<>&" }) expect_identical(output, "
") }) test_that("Newlines between attributes are OK", { output <- replace_attr("", "h1", "class", function(class) { NULL }) expect_identical(output, "") }) test_that("URL encoding is correctly decoded", { output <- inline_images("url_encoding.html") expect_true(grepl("data:image/png", output)) cid_output <- cid_images("url_encoding.html") expect_identical( attr(cid_output$images$img1, "content_type", exact = TRUE), "image/png" ) }) # TODO: Test for proper handling of file:// URLs test_that("WARNING: duplicate attribs are not supported correctly", { output <- replace_attr("", "h1", "class", function(class) { NULL }) expect_identical(output, "") }) test_that("File URI parsing works correctly", { # Illegal inputs expect_error(file_uri_to_filepath("http://example.com")) expect_error(file_uri_to_filepath("logo.gif")) expect_error(file_uri_to_filepath("file:foobar")) expect_error(file_uri_to_filepath("")) expect_identical(file_uri_to_filepath("file:///foo/bar"), "/foo/bar") expect_identical(file_uri_to_filepath("FILE:///foo/bar"), "/foo/bar") expect_identical(file_uri_to_filepath("file:///foo/bar/"), "/foo/bar/") expect_error(file_uri_to_filepath("file://localhost/foo/bar")) expect_identical(file_uri_to_filepath("file://C:/foo/bar"), "C:/foo/bar") expect_identical(file_uri_to_filepath("file://C:/foo%20bar"), "C:/foo bar") # Escaping not allowed outside of the path expect_error(file_uri_to_filepath("file%3a//C:/foo%20bar")) # + is interpreted as " " in query strings, but not in URL paths expect_identical(file_uri_to_filepath("file://C:/foo+bar"), "C:/foo+bar") }) test_that("src resolution works correctly", { expect_equal(as.character(src_to_filepath("foo%20bar", "/baz")), "/baz/foo bar") expect_equal(as.character(src_to_filepath("/foo%20bar", "/baz")), "/foo bar") expect_equal(as.character(src_to_filepath("/foo%20bar", "/baz")), "/foo bar") expect_equal(as.character(src_to_filepath("/foo%20bar", ".")), "/foo bar") # Because of the potential for drive letters to be of # different cases, we transform the whole string to lower case expect_equal(tolower(as.character(src_to_filepath("foo%20bar", "."))), tolower(file.path(getwd(), "foo bar"))) expect_equal(tolower(as.character(src_to_filepath("foo", ""))), tolower(file.path(getwd(), "foo"))) expect_equal(as.character(src_to_filepath("../a/b", "/c/d")), "/c/a/b") expect_equal(as.character(src_to_filepath("C:\\foo\\bar", "/baz")), "C:/foo/bar") # Newer versions of fs capitalize drive letters expect_true(src_to_filepath("foo/bar", "c:\\baz") %in% c("c:/baz/foo/bar", "C:/baz/foo/bar")) expect_true(src_to_filepath("", "c:\\baz") %in% c("c:/baz", "C:/baz")) }) test_that("decode_hex works correctly including for Unicode chars", { expect_identical(html_unescape("Q"), "Q") expect_identical(html_unescape("Q"), "Q") expect_identical(html_unescape("♡"), "\u2661") expect_identical(html_unescape("♡"), "\u2661") expect_identical(html_unescape("􏿿"), "\U0010FFFF") expect_identical(html_unescape("􏿿"), "\U0010FFFF") # Error: Too many hex digits expect_error(html_unescape("�")) expect_error(html_unescape("�")) }) test_that("gfsub doesn't butcher line endings", { expect_identical( gfsub("a\nb\r\nc", "[\\w]", toupper), toupper("a\nb\r\nc") ) }) test_that("duplicate images are not attached multiple times", { img <- add_image(system.file(package = "blastula", "img/pexels-photo-267151.jpeg")) email <- compose_email(body = list(img, img)) expect_identical(length(email$images), 1L) }) test_that("HTML manipulation functions can handle large input", { big_value <- paste(collapse = "", rep_len("x", 5e7)) big_html <- paste0(" \u2600") result <- replace_attr( html = big_html, tag_name = "img", attr_name = "src", func = function(src) { "hello \u2601" } ) expect_identical(result, " \u2600") })