flextable/0000755000176200001440000000000014707517032012226 5ustar liggesusersflextable/tests/0000755000176200001440000000000014707510711013365 5ustar liggesusersflextable/tests/testthat/0000755000176200001440000000000014707517032015230 5ustar liggesusersflextable/tests/testthat/test-dimensions.R0000644000176200001440000000721614615445141020505 0ustar liggesuserstest_that("dimensions are valid", { dummy_df <- data.frame(my_col = rep(letters[1:3], each = 2), stringsAsFactors = FALSE) ft <- flextable(dummy_df) dims <- dim(ft) expect_length(dims$widths, 1) expect_length(dims$heights, 7) ft <- add_header(ft, my_col = "second row header") dims <- dim(ft) expect_length(dims$widths, 1) expect_length(dims$heights, 8) ft <- height_all(ft, height = .15, part = "all") dims <- dim(ft) expect_true(all(is.finite(dims$widths))) expect_true(all(is.finite(dims$heights))) typology <- data.frame( col_keys = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species"), what = c("Sepal", "Sepal", "Petal", "Petal", "Species"), measure = c("Length", "Width", "Length", "Width", "Species"), stringsAsFactors = FALSE ) ft <- flextable(head(iris)) ft <- set_header_df(ft, mapping = typology, key = "col_keys") dims <- dim(ft) expect_length(dims$widths, 5) expect_length(dims$heights, 8) }) test_that("autofit and dim_pretty usage", { typology <- data.frame( col_keys = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species"), what = c("Sepal", "Sepal", "Petal", "Petal", "Species"), measure = c("Length", "Width", "Length", "Width", "Species"), stringsAsFactors = FALSE ) ft <- flextable(head(iris)) ft <- set_header_df(ft, mapping = typology, key = "col_keys") ft <- autofit(ft, add_w = 0.0, add_h = 0.0) dims <- dim(ft) expect_true(all(is.finite(dims$widths))) expect_true(all(is.finite(dims$heights))) dims <- dim_pretty(ft) expect_true(all(is.finite(dims$widths))) expect_true(all(is.finite(dims$heights))) }) test_that("height usage", { dummy_df <- data.frame( my_col1 = rep(letters[1:3], each = 2), my_col2 = rep(letters[4:6], each = 2), stringsAsFactors = FALSE ) ft <- flextable(dummy_df) dims <- dim_pretty(ft) expect_silent({ ft <- height_all(ft, height = .25, part = "all") }) expect_error({ ft <- height(ft, height = dims$heights[-1], part = "all") }) expect_error({ ft <- height(ft, height = 1:3, part = "body") }) }) test_that("width usage", { dummy_df <- data.frame( my_col1 = rep(letters[1:3], each = 2), my_col2 = rep(letters[4:6], each = 2), stringsAsFactors = FALSE ) ft <- flextable(dummy_df) expect_silent(width(ft, j = "my_col1", width = 1)) expect_silent(width(ft, j = 1:2, width = .7)) expect_error(width(ft, j = 1:2, width = rep(.7, 3))) }) test_that("autofit with horizontal spans", { dat <- data.frame( `Header should span 2 cols` = c("Whoooo", "Whaaaat", "Whyyyyy"), dummy_title = c("Whoooo", "Whaaaat", "Whyyyyy"), check.names = FALSE ) ft <- flextable(dat) ft <- merge_at( x = ft, i = 1, j = 1:2, part = "header" ) dims_divided <- dim_pretty(ft, hspans = "divided") dims_included <- dim_pretty(ft, hspans = "included") expect_gt(dims_included$widths[1], dims_divided$widths[1]) dims_none <- dim_pretty(ft, hspans = "none") dims_included_no_header <- dim_pretty(ft, hspans = "included", part = "body") expect_equal(dims_none$widths, dims_included_no_header$widths) }) test_that("HTML table width when autofit layout", { x <- data.frame( x = c( "[-0.36, -0.01]", "[0, 0]", "000, 000", "0000 0000" ) ) ft <- flextable(x) ft <- set_table_properties( x = ft, layout = "autofit" ) str <- flextable:::gen_raw_html(ft) expect_false(grepl("table-layout:auto;width:", str, fixed = TRUE)) ft <- set_table_properties( x = ft, layout = "autofit", width = .1 ) str <- flextable:::gen_raw_html(x = ft) expect_true(grepl("table-layout:auto;width:", str, fixed = TRUE)) }) flextable/tests/testthat/test-padding.R0000644000176200001440000000155214615445170017742 0ustar liggesuserstest_that("padding overwrite all paddings", { ft <- flextable(data.frame(a = c("", ""), stringsAsFactors = FALSE)) ft <- padding(ft, padding = 5) new_paddings <- c( ft$body$styles$pars$padding.bottom$data[, ], ft$body$styles$pars$padding.top$data[, ], ft$body$styles$pars$padding.left$data[, ], ft$body$styles$pars$padding.right$data[, ] ) new_paddings <- unique(new_paddings) expect_equal(new_paddings, 5) }) test_that("padding overwrite all paddings but not missing", { ft <- flextable(iris) ft <- padding(ft, padding = 5, padding.top = 20) new_paddings <- c( ft$body$styles$pars$padding.bottom$data[, ], ft$body$styles$pars$padding.top$data[, ], ft$body$styles$pars$padding.left$data[, ], ft$body$styles$pars$padding.right$data[, ] ) new_paddings <- unique(new_paddings) expect_equal(new_paddings, c(5, 20)) }) flextable/tests/testthat/test-text.R0000644000176200001440000002125414707433005017315 0ustar liggesusersft1 <- flextable(data.frame(a = "1 < 3", stringsAsFactors = FALSE)) get_xml_doc <- function(tab, main_folder = "docx_folder") { docx_file <- tempfile(fileext = ".docx") doc <- read_docx() doc <- body_add_flextable(doc, value = tab) print(doc, target = docx_file) main_folder <- file.path(getwd(), main_folder) unlink(main_folder, recursive = TRUE, force = TRUE) unpack_folder(file = docx_file, folder = main_folder) doc_file <- file.path(main_folder, "/word/document.xml") read_xml(doc_file) } get_xml_ppt <- function(tab, main_folder = "pptx_folder") { pptx_file <- tempfile(fileext = ".pptx") doc <- read_pptx() doc <- add_slide(doc, layout = "Title and Content", master = "Office Theme") doc <- ph_with(doc, tab, location = ph_location_type(type = "body")) print(doc, target = pptx_file) main_folder <- file.path(getwd(), main_folder) unlink(main_folder, recursive = TRUE, force = TRUE) unpack_folder(file = pptx_file, folder = main_folder) doc_file <- file.path(main_folder, "/ppt/slides/slide1.xml") read_xml(doc_file) } test_that("docx - string are html encoded", { main_folder <- "docx_folder" doc <- get_xml_doc(tab = ft1, main_folder = main_folder) text_ <- xml_text(xml_find_first(doc, "w:body/w:tbl[1]/w:tr[2]/w:tc/w:p/w:r/w:t")) expect_equal(text_, c("1 < 3")) unlink(main_folder, recursive = TRUE, force = TRUE) }) test_that("pptx - string are html encoded", { main_folder <- "pptx_folder" doc <- get_xml_ppt(tab = ft1, main_folder = main_folder) text_ <- xml_text(xml_find_first(doc, "//a:tbl/a:tr[2]/a:tc/a:txBody/a:p/a:r/a:t")) expect_equal(text_, c("1 < 3")) unlink(main_folder, recursive = TRUE, force = TRUE) }) test_that("html - string are html encoded", { str_ <- flextable:::gen_raw_html(ft1) str_ <- gsub("", "", str_) str_ <- gsub("", "", str_) str_ <- gsub("