[write_data] make formula encoding more general (#835)

JanMarvin · Oct 30, 2023 · 7769741 · 7769741
1 parent f19a5b5
commit 7769741
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 10 deletions.
diff --git a/R/write.R b/R/write.R
@@ -220,20 +220,29 @@ write_data2 <- function(
   dc <- openxlsx2_type(data)
 
   # convert factor to character
-  if (any(dc == openxlsx2_celltype[["factor"]])) {
-    is_factor <- dc == openxlsx2_celltype[["factor"]]
+  is_factor <- dc == openxlsx2_celltype[["factor"]]
+
+  if (any(is_factor)) {
     fcts <- names(dc[is_factor])
     data[fcts] <- lapply(data[fcts], to_string)
-    # dc <- openxlsx2_type(data)
   }
 
-  # since 1.2
-  is_fml <- dc == openxlsx2_celltype[["formula"]] | dc == openxlsx2_celltype[["array_formula"]] | dc == openxlsx2_celltype[["cm_formula"]] | dc == openxlsx2_celltype[["hyperlink"]]
+  # remove xml encoding and reapply it afterwards. until v0.3 encoding was not enforced.
+  # until 1.1 formula encoding was applied in write_formula() and missed formulas written
+  # as data frames with class formula
+  is_fml <- dc %in% c(
+    openxlsx2_celltype[["formula"]], openxlsx2_celltype[["array_formula"]],
+    openxlsx2_celltype[["cm_formula"]], openxlsx2_celltype[["hyperlink"]]
+  )
+
   if (any(is_fml)) {
     fmls <- names(dc[is_fml])
     data[fmls] <- lapply(
       data[fmls],
-      function(val) xml_value(xml_node_create("fml", val, escapes = TRUE), "fml")
+      function(val) {
+        val <- replaceXMLEntities(val)
+        vapply(val, function(x) xml_value(xml_node_create("fml", x, escapes = TRUE), "fml"), "")
+      }
     )
   }
 
@@ -1042,8 +1051,6 @@ write_formula <- function(
   standardize_case_names(...)
 
   assert_class(x, "character")
-  # remove xml encoding and reapply it afterwards. until v0.3 encoding was not enforced
-  x <- replaceXMLEntities(x)
   dfx <- data.frame("X" = x, stringsAsFactors = FALSE)
 
   formula <- "formula"

diff --git a/tests/testthat/test-formulas.R b/tests/testthat/test-formulas.R
@@ -70,9 +70,11 @@ test_that("setting ref works", {
 test_that("formual escaping works", {
 
   df_tmp <- data.frame(
-    f = paste0("'A&B'!A1")
+    f = "'A&B'!A1",
+    g = "'A&amp;B'!A1"
   )
   class(df_tmp$f) <- c(class(df_tmp$f), "formula")
+  class(df_tmp$g) <- c(class(df_tmp$g), "formula")
 
   wb <- wb_workbook()$
     add_worksheet("A&B")$
@@ -83,7 +85,7 @@ test_that("formual escaping works", {
 
   expect_warning(wb$add_formula(dims = "A4", x = "SUM('A&B'!A1)", cm = TRUE))
 
-  exp <- c("'A&amp;B'!A1", "'A&amp;B'!A1", "SUM('A&amp;B'!A1)", "SUM('A&amp;B'!A1)")
+  exp <- c("'A&amp;B'!A1", "'A&amp;B'!A1", "'A&amp;B'!A1", "SUM('A&amp;B'!A1)", "SUM('A&amp;B'!A1)")
   got <- wb$worksheets[[2]]$sheet_data$cc$f
   expect_equal(exp, got)