Lengthen fence characters when needed (fix #1621)

NEWS.md

@@ -38,6 +38,8 @@
 
 - In `knitr::combine_words()`, when `words` is length 2 and `and = ""`, `sep` will now be used (thanks, @eitsupi, #2044).
 
+- For R Markdown documents, if the chunk output contains N backticks, the `output` hook will use N + 1 backticks to wrap the output, so that the N verbatim backticks can be correctly preserved (thanks, @atusy, #2047).
+
 # CHANGES IN knitr VERSION 1.34
 
 ## NEW FEATURES

R/hooks-md.R

@@ -152,19 +152,23 @@ render_markdown = function(strict = FALSE, fence_char = '`') {
 #' @export
 hooks_markdown = function(strict = FALSE, fence_char = '`') {
   fence = paste(rep(fence_char, 3), collapse = '')
+  update_fence = function(x) {
+    r = paste0('\n', fence_char, '{3,}')
+    if (grepl(r, x)) {
+      l = attr(gregexpr(r, x)[[1]], 'match.length')
+      l = max(l)
+      if (l >= 4) fence = paste(rep(fence_char, l), collapse = '')
+    }
+    fence
+  }
   # four spaces lead to <pre></pre>
   hook.t = function(x, options, attr = NULL, class = NULL) {
     # this code-block duplicated from hook.t()
     if (strict) {
       paste('\n', indent_block(x), '', sep = '\n')
     } else {
       x = one_string(c('', x))
-      r = paste0('\n', fence_char, '{3,}')
-      if (grepl(r, x)) {
-        l = attr(gregexpr(r, x)[[1]], 'match.length')
-        l = max(l)
-        if (l >= 4) fence = paste(rep(fence_char, l), collapse = '')
-      }
+      fence = update_fence(x)
       paste0('\n\n', fence, block_attr(attr, class), x, fence, '\n\n')
     }
   }
@@ -179,6 +183,7 @@ hooks_markdown = function(strict = FALSE, fence_char = '`') {
     if (language == 'node') language = 'javascript'
     if (!options$highlight) language = 'text'
     attrs = block_attr(options$attr.source, options$class.source, language)
+    fence = update_fence(one_string(c('', x)))
     paste0('\n\n', fence, attrs, '\n', x, fence, '\n\n')
   }
   list(

R/parser.R

@@ -13,7 +13,7 @@ split_file = function(lines, set.preamble = TRUE, patterns = knit_patterns$get()
   }
 
   blks = grepl(chunk.begin, lines)
-  txts = filter_chunk_end(blks, grepl(chunk.end, lines))
+  txts = filter_chunk_end(blks, grepl(chunk.end, lines), lines, patterns)
   # tmp marks the starting lines of a code/text chunk by TRUE
   tmp = blks | head(c(TRUE, txts), -1)
 
@@ -505,17 +505,22 @@ parse_chunk = function(x, rc = knit_patterns$get('ref.chunk')) {
 }
 
 # filter chunk.end lines that don't actually end a chunk
-filter_chunk_end = function(chunk.begin, chunk.end) {
+filter_chunk_end = function(chunk.begin, chunk.end, lines = NA, patterns = list()) {
   in.chunk = FALSE
-  fun = function(is.begin, is.end) {
-    if (in.chunk && is.end) {
+  is.md = identical(patterns, all_patterns[['md']])
+  pattern.end = NA
+  fun = function(is.begin, is.end, line) {
+    if (in.chunk && is.end && (is.na(pattern.end) || grepl(pattern.end, line))) {
       in.chunk <<- FALSE
       return(TRUE)
     }
-    if (!in.chunk && is.begin) in.chunk <<- TRUE
+    if (!in.chunk && is.begin) {
+      in.chunk <<- TRUE
+      if (is.md) pattern.end <<- sub('(^[\t >]*```+).*', '\\1\\\\s*$', line)
+    }
     FALSE
   }
-  mapply(fun, chunk.begin, chunk.end)
+  mapply(fun, chunk.begin, chunk.end, lines)
 }
 
 #' Get all chunk labels in a document

tests/testit/test-hooks-md.R

@@ -29,6 +29,11 @@ assert('include_graphics() includes custom images correctly', {
 hook_src = knit_hooks$get("source")
 options_ = list(engine = "r", prompt = FALSE, highlight = TRUE)
 
+assert('Lengh of fences are satisfied', {
+  (hook_src("", options_) %==% "\n\n```r\n\n```\n\n")
+  (hook_src("```", options_) %==% "\n\n````r\n```\n````\n\n")
+})
+
 assert('Attributes for source can be specified class.source and attr.source', {
   (hook_src("1", c(options_, class.source = "a b")) %==% "\n\n```{.r .a .b}\n1\n```\n\n")
   (hook_src("1", c(options_, attr.source = ".a .b")) %==% "\n\n```{.r .a .b}\n1\n```\n\n")