Fix [<- formatting bug

NEWS.md

@@ -7,7 +7,8 @@
 ### Bug Fixes
  * Fixed issue with `split_cols_by_multivar()` when having more than one value. Now `as_result_df(make_ard = TRUE)` adds a predefined split name for each of the `multivar` splits.
  * Fixed bug happening when format functions were changing the number of printed values. Now `as_result_df(make_ard = TRUE)` uses the cell values for `stat_strings` for these exceptions.
-
+ * Fixed bug in `[<-` causing information to be stripped from other cells if a new `rcell` is set within a table row.
+
 ## rtables 0.6.11
 
 ### New Features

R/tt_pos_and_access.R

@@ -50,7 +50,7 @@ recursive_replace <- function(tab, path, value) { ## incontent = FALSE, rows = N
     ##         newkid[rows, cols] = value
     ##     }
     ## }
-    return(newkid)
+    newkid
   } else if (path[[1]] == "@content") {
     ctb <- content_table(tab)
     ctb <- recursive_replace(ctb,
@@ -467,7 +467,7 @@ setMethod(
 #' tbl[, -1]
 #'
 #' # Values can be reassigned
-#' tbl[2, 1] <- rcell(999)
+#' tbl[4, 2] <- rcell(999, format = "xx.x")
 #' tbl[2, ] <- list(rrow("FFF", 888, 666, 777))
 #' tbl[6, ] <- list(-111, -222, -333)
 #' tbl
@@ -579,9 +579,15 @@ setMethod(
                 curkid <- nxtval
                 value <- value[-1]
               } else {
-                rvs <- row_values(curkid)
-                rvs[j] <- value[seq_along(j)]
-                row_values(curkid) <- rvs
+                if (is(nxtval, "CellValue")) {
+                  rcs <- row_cells(curkid)
+                  rcs[j] <- value[seq_along(j)]
+                  row_cells(curkid) <- rcs
+                } else {
+                  rvs <- row_values(curkid)
+                  rvs[j] <- value[seq_along(j)]
+                  row_values(curkid) <- rvs
+                }
                 value <- value[-(seq_along(j))]
               }
               kids[[pos]] <- curkid

rtables.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 4d2c3c80-3618-40eb-b805-a291cb9acbf6
 
 RestoreWorkspace: Default
 SaveWorkspace: Default

tests/testthat/test-subset-access.R

@@ -376,8 +376,30 @@ test_that("setters work ok", {
     cell_values(tbl4)[["U.AGE.mean"]],
     list(5, 7, 8)
   )
-})
 
+  tbl5 <- tbl
+  tbl5[4, 1] <- rcell(999, format = "xx.xx")
+  tbl5[5, 2] <- list(c(3, 0.25))
+  tbl5[5, 3] <- rcell(NA, format_na_str = "<NA>")
+  tbl5[6, ] <- list(-111, -222, -333)
+  matform5 <- matrix_form(tbl5)
+  expect_identical(
+    c("mean", "999.00", "32.1", "34.2794117647059"),
+    mf_strings(matform5)[5, ]
+  )
+  expect_identical(
+    c("U", "0 (0.0%)", "3 (25.0%)", "<NA>"),
+    mf_strings(matform5)[6, ]
+  )
+  expect_identical(
+    c("mean", "-111", "-222", "-333"),
+    mf_strings(matform5)[7, ]
+  )
+  expect_identical(
+    c("", "xx.xx", "xx", "xx"),
+    mf_formats(matform5)[5, ]
+  )
+})
 
 test_that("cell_values and value_at work on row objects", {
   tbl <- basic_table() %>%