codegraph/__tests__/fixtures/kernel-parity/torture.R

# Kernel↔wasm R parity torture fixture — every hook branch, extractCall shape,
# and known-gap behavior from docs/design/r-kernel-port-checklist.md. Parses
# CLEAN (no ERROR/MISSING) — deferral shapes live in the test file, and the
# CRLF variant is derived in-memory by kernel-r-parity.test.ts.

#' Roxygen title for top_fn (dropped — R nodes never carry docstrings)
#' @param a first
top_fn <- function(a, b = 2, ...) {
  a + b
}

# plain comment run above eq_fn (also dropped)
# second line
eq_fn = function(x) x * 2

lam <- \(x) x + 1

gfun <<- function() 0

(function(x) x * 3) -> trpl

function(y) y - 1 -> ghost

MAX_RETRIES <- 3L
A.CONST = 2.5
lower_var <- "hello"
dotted.var <- 1
x2 <<- 4
9 -> right_var
10 ->> RIGHT.CONST
chain_a <- chain_b <- 5

nester <- function(x) {
  inner <- function(y) {
    innermost <- function(z) z + 1
    innermost(y)
  }
  CAPS_LOCAL <- 99
  z <- inner(x)
  log_it(z)
  z
}

if (TRUE) f_in_if <- function() 1
{
  hidden_var <- 42
  braced_fn <- function() 2
}

top_call(nested_call(1))
x %>% p_one() %>% p_two()
z |> p_three()
res <- data %>% p_four()

# --- imports -----------------------------------------------------------------
library(dplyr)
require(stats)
requireNamespace("jsonlite")
loadNamespace("tools")
source("helpers.R")
source(file.path("R", "dyn.R"))
library()
suppressPackageStartupMessages(library(quietpkg))
base::library(magrittr)
library(help = docpkg)
requireNamespace(quietly = TRUE, package = "namedpkg")
library("")
pkg::fn_q(1)
pkg:::fn_h(2)
use_it <- function() {
  library(inside_fn)
  fn_q(3)
}

# --- classes -----------------------------------------------------------------
setClass("Patient", representation(name = "character"), contains = "Person")

setGeneric("describe", function(obj) standardGeneric("describe"))

setMethod("describe", "Patient", function(obj) {
  fmt(obj)
})

Account <- setRefClass("Account",
  fields = list(balance = "numeric"),
  contains = "BaseAccount",
  methods = list(
    deposit = function(x) {
      balance <<- balance + x
      audit(x)
    },
    withdraw = function(x) balance <<- balance - x
  ))

Stack <- R6Class("Stack",
  inherit = AbstractCollection,
  public = list(
    items = NULL,
    push = function(x) {
      self$items <- c(self$items, x)
      invisible(self)
    }
  ),
  private = list(
    validate_it = function() TRUE
  ),
  active = list(
    size = function() length(private$items)
  ))

GeomX <- ggproto("GeomX", Geom,
  extra_param = "no",
  draw_panel = function(data, panel) {
    render_geom(data)
  }
)

methods::setClass("QualClass", contains = "QBase")
R6::R6Class("QualR6", public = list(qm = function() do_q()))
Gen <- R6Class(GenName, public = list(gm = function() 1))
BadGG <- ggproto(NULL, Geom, draw_key = function(x) render_key(x))
NoInherit <- R6Class("NoInherit", inherit = pkg::Parent)
factory <- function() {
  Local <- setRefClass("LocalCls", methods = list(lm = function() lcall()))
  Local
}
Empty <- R6Class("Empty", public = list())
Pos <- setRefClass("PosCls", methods = list(function() 1))
s3.method <- print.myclass <- NULL
print.data.frame2 <- function(x, ...) {
  format_it(x)
}
env$attached <- function(x) side_call(x)
"strname" <- function() 1
setMethod("show", signature("Cls"), function(object) cat_it(object))
setGeneric("area")
setValidity("Cls", function(object) TRUE)
Late <- R6Class("Late",
  public = list(pm = function() p_call()),
  inherit = LateBase)

# --- call zoo & lhs shapes ---------------------------------------------------
"strassign" <- 6
x[1] <- 7
attr(x, "who") <- 8
names(x) <- c("a")
obj$field <- 9
obj@slot <- 10
assign("via_assign", 11)
delayedAssign("lazy_one", compute_it())
makeActiveBinding("active_one", function() 1, environment())
obj$meth(3)
lst$a$b(4)
o@s$m(5)
Negate(`%in%`)(6)
"strfn"(7)
(handler)(8)
lst[[1]](9)
`weird name` <- 12
`%+%` <- function(a, b) paste(a, b)
result <- if (cond) f_yes() else f_no()
for (i in seq_len(10)) body_call(i)
while (keep_going()) step_once()
repeat break
local({
  local_hidden <- 13
  local_fn <- function() 14
})
try(risky_call())
Recall(1)
UseMethod("generic_dispatch")
do.call("dyn_target", list(1))
do.call(real_target, list(2))
match.fun("fun_by_name")(3)
stopifnot(is_ok(x))
on.exit(cleanup_fn())
invisible(NULL)

# --- return-as-named-node, duplicates, right-assign in a body ----------------
f <- function(x) {
  if (x > 0) return(g(x))
  h(x)
}
ret_val <- return
setMethod("area", "Sq", area_impl)
require(pkg2, quietly = TRUE)
dupline <- function() 1; dupline <- function() 2
dup_var <- 1; dup_var <- 2
runner <- function() {
  fetch() -> got
  got
}
dt[, b := compute_b(a)]

# --- parse-clean battery shapes (must NOT defer) -----------------------------
rs <- r"(no \escape here)"
rs2 <- r"#(one "quoted" bit)#"
plot(1, )
sliced <- x[1, ]
piped <- x |> f_ph(y = _)

# --- UTF-16 columns ----------------------------------------------------------
msg <- "héllo 🎉"
emoji_caller <- function() after_emoji("🎉🎉", target_fn())