Ensure UTF-8 encoding when parsing

NEWS.md

@@ -1,5 +1,9 @@
 # teal.code 0.7.1.9000
 
+### Bug fixes
+
+* Fixed a problem parsing Chinese characters due to the encoding (#284)
+
 # teal.code 0.7.1
 
 ### Bug fixes

R/qenv-eval_code.R

@@ -47,7 +47,7 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
   code <- paste(split_code(code), collapse = "\n")
 
   object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(object@.xData))
-  parsed_code <- parse(text = code, keep.source = TRUE)
+  parsed_code <- parse(text = code, keep.source = TRUE, encoding = "UTF-8")
 
   old <- evaluate::inject_funs(
     library = function(...) {
@@ -72,7 +72,10 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
   for (this in out) {
     if (inherits(this, "source")) {
       this_code <- gsub("\n$", "", this$src)
-      attr(this_code, "dependency") <- extract_dependency(parse(text = this_code, keep.source = TRUE))
+      attr(this_code, "dependency") <- extract_dependency(parse(
+        text = this_code,
+        keep.source = TRUE, encoding = "UTF-8"
+      ))
       new_code <- c(new_code, stats::setNames(list(this_code), sample.int(.Machine$integer.max, size = 1)))
     } else {
       last_code <- new_code[[length(new_code)]]

R/qenv-get_code.R

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

R/utils-get_code_dependency.R

@@ -407,7 +407,7 @@ extract_dependency <- function(parsed_code) {
     queue <- as.list(parsed_code[[1]][expr_ix])
     new_list <- parsed_code[[1]]
     new_list[expr_ix] <- NULL
-    list(parse(text = as.expression(new_list), keep.source = TRUE))
+    list(parse(text = as.expression(new_list), keep.source = TRUE, encoding = "UTF-8"))
   }
 
   while (length(queue) > 0) {
@@ -416,7 +416,8 @@ extract_dependency <- function(parsed_code) {
     if (identical(current[[1L]], as.name("{"))) {
       queue <- append(queue, as.list(current)[-1L])
     } else {
-      parsed_code_list[[length(parsed_code_list) + 1]] <- parse(text = as.expression(current), keep.source = TRUE)
+      parsed_code <- parse(text = as.expression(current), keep.source = TRUE, encoding = "UTF-8")
+      parsed_code_list[[length(parsed_code_list) + 1]] <- parsed_code
     }
   }
 
@@ -556,7 +557,7 @@ normalize_pd <- function(pd) {
 #' @keywords internal
 #' @noRd
 get_call_breaks <- function(code) {
-  parsed_code <- parse(text = code, keep.source = TRUE)
+  parsed_code <- parse(text = code, keep.source = TRUE, encoding = "UTF-8")
   pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
   pd <- pd[pd$token != "';'", ]

tests/testthat/test-qenv_within.R

@@ -154,3 +154,15 @@ testthat::test_that("Code executed with integer shorthand (1L) is the same as or
   q <- within(qenv(), a <- 1L)
   testthat::expect_identical(get_code(q), "a <- 1L")
 })
+
+
+testthat::test_that("Chinese characters are handled properly (issue 284)", {
+  q <- within(qenv(), {
+    "无进展生存期 (月)"
+    "总生存期 (月)"
+    "缓解持续时间 (月)"
+    "确认的缓解持续时间 (月)"
+  })
+
+  expect_equal(lengths(strsplit(get_code(q), split = "\n", fixed = TRUE)), 4L)
+})