diff --git a/NEWS.md b/NEWS.md index f7f04c50..2a2fde5d 100644 --- a/NEWS.md +++ b/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 diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R index cb37d14a..76a48258 100644 --- a/R/qenv-eval_code.R +++ b/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)]] diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R index 13609610..1af5630a 100644 --- a/R/qenv-get_code.R +++ b/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") } }) diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R index 4adea57d..0475927b 100644 --- a/R/utils-get_code_dependency.R +++ b/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 != "';'", ] diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R index 14a311a3..1d44db7b 100644 --- a/tests/testthat/test-qenv_within.R +++ b/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) +})