Merge branch 'fix_datatable_operators@main' of https://github.com/insightsengineering/teal.code into fix_datatable_operators@main

Author: m7pr

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal.code
 Title: Code Storage and Execution Class for 'teal' Applications
-Version: 0.5.0.9017
-Date: 2024-11-14
+Version: 0.5.0.9018
+Date: 2024-11-15
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre")),
     person("Aleksander", "Chlebowski", , "[email protected]", role = "aut"),

NEWS.md

@@ -1,4 +1,4 @@
-# teal.code 0.5.0.9017
+# teal.code 0.5.0.9018
 
 ### Enhancements
 

R/qenv-eval_code.R

@@ -40,7 +40,6 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     return(object)
   }
   code_split <- split_code(paste(code, collapse = "\n"))
-
   for (i in seq_along(code_split)) {
     current_code <- code_split[[i]]
     current_call <- parse(text = current_code, keep.source = TRUE)

R/qenv-get_code.R

@@ -141,7 +141,7 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   if (deparse) {
-    gsub(";\n", ";", paste(gsub("\n$", "", unlist(code)), collapse = "\n"))
+    paste(unlist(code), collapse = "\n")
   } else {
     parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }

R/utils-get_code_dependency.R

@@ -484,16 +484,15 @@ split_code <- function(code) {
 
   idx_start <- c(
     0, # first call starts in the beginning of src
-    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"] + 2
+    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"] + 1
   )
   idx_end <- c(
-    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"] + 1,
+    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"],
     nchar(code) # last call end in the end of src
   )
   new_code <- substring(code, idx_start, idx_end)
 
-  # we need to remove leading semicolons from the calls and move them to the previous call
-  #  this is a reasult of a wrong split, which ends on the end of call and not on the ;
-  #  semicolon is treated by R parser as a separate call.
-  gsub("^([[:space:]])*;(.+)$", "\\1\\2", new_code, perl = TRUE)
+  # line split happens before call terminator (it could be `;` or `\n`) and the terminator goes to the next line
+  # we need to move remove leading and add \n instead when combining calls
+  c(new_code[1], gsub("^[\t ]*(\n|;)", "", new_code[-1]))
 }

tests/testthat/test-qenv_eval_code.R

@@ -161,20 +161,13 @@ testthat::test_that("comments at the end of src are added to the previous call e
 testthat::test_that("comments from the same line are associated with it's call", {
   code <- c("x <- 5", " y <- 4 # comment", "z <- 5")
   q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    as.character(q@code)[2],
-    paste0(code[2], "\n")
-  )
+  testthat::expect_identical(as.character(q@code)[2], code[2])
 })
 
 testthat::test_that("alone comments at the end of the source are considered as continuation of the last call", {
-  # todo: should be associated to the last call or be separted?
-  code <- c("x <- 5\ny <- 10\n# comment")
+  code <- c("x <- 5\n", "y <- 10\n# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
-  testthat::expect_identical(
-    as.character(q@code)[2],
-    "y <- 10\n# comment"
-  )
+  testthat::expect_identical(as.character(q@code)[2], code[2])
 })
 
 testthat::test_that("comments passed alone to eval_code that contain @linksto tag have detected dependency", {

tests/testthat/test-qenv_extract.R

@@ -81,13 +81,13 @@ testthat::test_that("`[.` extracts the code only needed to recreate objects pass
   q <- eval_code(q, code)
   object_names <- c("x", "a")
   qs <- q[object_names]
-  testthat::expect_identical(get_code(qs), c("x<-1\na<-1;"))
+  testthat::expect_identical(get_code(qs), c("x<-1\na<-1"))
 })
 
 testthat::test_that("`[.` comments are preserved in the code and associated with the following call", {
   q <- qenv()
   code <- c("x<-1 #comment", "a<-1;b<-2")
   q <- eval_code(q, code)
   qs <- q[c("x", "a")]
-  testthat::expect_identical(get_code(qs), c("x<-1 #comment\na<-1;"))
+  testthat::expect_identical(get_code(qs), c("x<-1 #comment\na<-1"))
 })

tests/testthat/test-qenv_get_code.R

@@ -47,7 +47,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   )
 })
 
-testthat::test_that("get_code returns code with comments and empty spaces", {
+testthat::test_that("get_code formatted returns code asis but replaces `;` with `\n`", {
   code <- "
     # header comment after white space
 
@@ -58,7 +58,7 @@ testthat::test_that("get_code returns code with comments and empty spaces", {
     # closing comment
     "
   q <- eval_code(qenv(), code)
-  testthat::expect_equal(get_code(q), code)
+  testthat::expect_equal(get_code(q), gsub(";", "\n", code))
 })
 
 # names parameter -------------------------------------------------------------------------------------------------
@@ -240,14 +240,12 @@ testthat::describe("get_code for specific names", {
     testthat::expect_length(get_code(q1, deparse = FALSE), 1)
   })
 
-  testthat::it("does not break if code is separated by ;", {
-    code <- c(
-      "a <- 1;a <- a + 1"
-    )
+  testthat::it("detects calls associated with object if calls are separated by ;", {
+    code <- c("a <- 1;b <- 2;a <- a + 1")
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
       get_code(q, names = "a"),
-      code
+      "a <- 1\na <- a + 1"
     )
   })
 

tests/testthat/test-qenv_get_messages.R

@@ -49,7 +49,7 @@ testthat::test_that("get_messages accepts a qenv object with a single eval_code
         "~~~ Messages ~~~\n",
         "> This is a message 1!",
         "when running code:",
-        "message(\"This is a message 1!\")\n\n",
+        "message(\"This is a message 1!\")\n",
         "> This is a message 2!",
         "when running code:",
         "message(\"This is a message 2!\")\n",

tests/testthat/test-qenv_get_warnings.R

@@ -49,7 +49,7 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
         "~~~ Warnings ~~~\n",
         "> This is a warning 1!",
         "when running code:",
-        "warning(\"This is a warning 1!\")\n\n",
+        "warning(\"This is a warning 1!\")\n",
         "> This is a warning 2!",
         "when running code:",
         "warning(\"This is a warning 2!\")\n",