MichaelChirico

# Script to test a patched version of r-devel against a selection of CRAN packages
#   Useful for detecting possible breaking changes by examining how changes affect actual packages
#   Does not require a local CRAN mirror -- idea is to only test a small fraction of CRAN -->
#     relatively small I/O cost of downloading the packages on the fly.

# This script is used for the patch here:
#   https://github.com/r-devel/r-svn/pull/177
#   https://bugs.r-project.org/show_bug.cgi?id=18782
#   https://bugs.r-project.org/show_bug.cgi?id=17672
PACKAGES_TO_TEST = c(

MichaelChirico

setwd(tempdir())
pmatchRe = "partial( argument)? match"

write_strict_profile = function(path = ".Rprofile") {
  writeLines(con=path, c(
    "options(warnPartialMatchArgs=TRUE, warnPartialMatchAttr=TRUE, warnPartialMatchDollar=TRUE)",
    sprintf("globalCallingHandlers(warning=function(c) if (grepl('%s', conditionMessage(c))) stop(c) else warning(c))", pmatchRe)
  ))
}
clone_cran_mirror = \(pkg) system2("git", c("clone", "-q", sprintf("https://github.com/cran/%s.git", pkg)))

MichaelChirico

medicare_tax = function(medi_income, filing_status="joint") {
  addl_floor = switch(filing_status, joint=250000, mfs=125000, single=200000)
  .0145*medi_income + pmax(0, .009*(medi_income-addl_floor))
}

social_security_tax = function(income) .062 * pmin(income, 160200)

tax_with_deductible_brackets = function(income, deductible, bracket_rates, bracket_mins) {
  sum(pmax(0, diff(bracket_rates) * (income - deductible - bracket_mins)))
}

MichaelChirico

def select_left(file):
  with open(file) as f:
    contents=f.read()

  lines = contents.split('\n')

  n_conflicts = sum([l.startswith('<<<<') for l in lines])

  keep=True
  outfile=[]

MichaelChirico

library(jsonlite)
library(data.table)
library(lintr)

read_page <- function(page) {
  tmp <- tempfile()
  on.exit(unlink(tmp))
  system2("curl",
    c("--location", "--request",
      "GET", sprintf("'https://api.github.com/search/code?q=readChar+org:cran+language:R+-path:.Rd&per_page=100&page=%d'", page),

MichaelChirico

library(jsonlite)
library(data.table)

headers <- shQuote(c(
  "-H", "Accept: application/vnd.github+json",
  "-H", sprintf("Authorization: Bearer %s", Sys.getenv("GITHUB_PAT")),
  "-H", "X-GitHub-Api-Version: 2022-11-28"
))

url_fmt <- "https://api.github.com/repos/r-lib/lintr/actions/runs?per_page=%d&page=%d"

MichaelChirico

library(microbenchmark)
N = 1e4
v = sample(letters, N, TRUE)

microbenchmark(times = 200L, grep("a", v), which(grepl("a", v)), grep("[a-m]", v), which(grepl("[a-m]", v)), grep("[a-z]", v), which(grepl("[a-z]", v)))
# Unit: microseconds
#                      expr     min       lq     mean   median       uq      max neval  cld
#              grep("a", v) 630.561 640.4110 670.5257 655.4915 680.6115  866.132   200  b  
#      which(grepl("a", v)) 598.802 609.5220 637.0542 621.0965 652.9120  839.231   200 a   
#          grep("[a-m]", v) 692.601 708.4215 735.6788 721.3065 744.6365 1207.722   200    d

MichaelChirico

  allowed_functions <- c(
    # Normal calls
    "return", "stop", "warning", "message", "stopifnot", "q", "quit",
    "invokeRestart", "tryInvokeRestart",

    # Normal calls from non-default libraries
    "LOG", "abort",

    # tests in the RUnit framework are functions ending with a call to one
    #   of the below. would rather users just use a different framework

MichaelChirico

test_that("explicit_return_linter works in simple function", {
  lines <- c(
    "foo <- function(bar) {",
    "  return(bar)",
    "}"
  )
  expect_lint(lines, NULL, explicit_return_linter())
})

test_that("explicit_return_linter works for using stop() instead of returning", {

MichaelChirico

library(data.table)
library(rvest)
library(xml2)

brackets = "https://taxfoundation.org/data/all/federal/2022-tax-brackets/" |>
  read_html() |>
  xml_find_all("//table[contains(caption/text(), '2022 Federal Income')]") |>
  html_table()

brackets = as.data.table(brackets[[1L]])[-.N]