From 3ded9495ce1abec6e2f8baa5e90bb66949b27873 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Wed, 23 Nov 2022 15:43:39 -0500 Subject: [PATCH 1/6] Add some of the Rconcordance functions from R 4.3.0 to support RmdConcord package. --- DESCRIPTION | 6 +- NAMESPACE | 5 + R/Rconcordance.R | 222 +++++++++++++++++++++++++++++++ R/import.R | 1 + README.md | 7 + man/as.Rconcordance.Rd | 12 ++ man/as.Rconcordance.default.Rd | 12 ++ man/as.character.Rconcordance.Rd | 12 ++ man/matchConcordance.Rd | 12 ++ man/print.Rconcordance.Rd | 12 ++ tests/test_Rconcordance.R | 17 +++ 11 files changed, 316 insertions(+), 2 deletions(-) create mode 100644 R/Rconcordance.R create mode 100644 man/as.Rconcordance.Rd create mode 100644 man/as.Rconcordance.default.Rd create mode 100644 man/as.character.Rconcordance.Rd create mode 100644 man/matchConcordance.Rd create mode 100644 man/print.Rconcordance.Rd create mode 100644 tests/test_Rconcordance.R diff --git a/DESCRIPTION b/DESCRIPTION index 4685072..45fab3c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,12 @@ Package: backports Type: Package Title: Reimplementations of Functions Introduced Since R-3.0.0 -Version: 1.4.1-9000 +Version: 1.4.1-9001 Authors@R: c( person("Michel", "Lang", NULL, "michellang@gmail.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0001-9754-0393")), + person("Duncan", "Murdoch", NULL, "murdoch.duncan@gmail.com", + role = c("aut")), person("R Core Team", role = "aut")) Maintainer: Michel Lang Description: @@ -22,4 +24,4 @@ ByteCompile: yes Depends: R (>= 3.0.0) Encoding: UTF-8 -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.2 diff --git a/NAMESPACE b/NAMESPACE index 2adc9a8..953b377 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,6 +40,11 @@ if (getRversion() < "4.0.0") export(suppressWarnings) if (getRversion() < "4.0.1") export(paste) if (getRversion() < "4.0.1") export(paste0) if (getRversion() < "4.1.0") export(...names) +if (getRversion() < "4.3.0") S3method("as.Rconcordance", "default") +if (getRversion() < "4.3.0") S3method("as.character", "Rconcordance") +if (getRversion() < "4.3.0") S3method("print", "Rconcordance") +if (getRversion() < "4.3.0") export(as.Rconcordance) +if (getRversion() < "4.3.0") export(matchConcordance) importFrom(utils,getFromNamespace) importFrom(utils,head) useDynLib(backports,dotsElt) diff --git a/R/Rconcordance.R b/R/Rconcordance.R new file mode 100644 index 0000000..9f869b7 --- /dev/null +++ b/R/Rconcordance.R @@ -0,0 +1,222 @@ +# These functions are taken from the R sources. + +# The original copyright notice was as follows: + +## Copyright (C) 1995-2016 The R Core Team +## Copyright (C) 2022 Duncan Murdoch +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## A copy of the GNU General Public License is available at +## https://www.R-project.org/Licenses/ + +#' @title Backport of print.Rconcordance for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::print.Rconcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") S3method("print", "Rconcordance") +print.Rconcordance <- function(x, ...) { + df <- data.frame(srcFile = x$srcFile, srcLine = x$srcLine) + rownames(df) <- seq_len(nrow(df)) + x$offset + print(df) + invisible(x) +} + +# This function converts concordance objects to string representations +# of them. + +## The string has three or four parts, separated by colons: +## 1. The output .tex filename +## 2. The input .Rnw filename +## 3. Optionally, the starting line number of the output coded as "ofs nn", +## where nn is the offset to the first output line. This is omitted if nn is 0. +## 4. The input line numbers corresponding to each output line. +## This are compressed using the following simple scheme: +## The first line number, followed by +## a run-length encoded diff of the rest of the line numbers. + + +#' @title Backport of as.character.Rconcordance for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::as.character.Rconcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") S3method("as.character", "Rconcordance") + +as.character.Rconcordance <- function(x, + targetfile = "", + ...) { + concordance <- x + offset <- concordance$offset + src <- concordance$srcLine + + result <- character() + + srcfile <- rep_len(concordance$srcFile, length(src)) + + while (length(src)) { + first <- src[1] + if (length(unique(srcfile)) > 1) + n <- which(srcfile != srcfile[1])[1] - 1 + else + n <- length(srcfile) + + vals <- with(rle(diff(src[seq_len(n)])), as.numeric(rbind(lengths, values))) + result <- c(result, paste0("concordance:", + targetfile, ":", + srcfile[1], ":", + if (offset) paste0("ofs ", offset, ":"), + concordance$srcLine[1], " ", + paste(vals, collapse = " ") + )) + offset <- offset + n + drop <- seq_len(n) + src <- src[-drop] + srcfile <- srcfile[-drop] + } + result +} + +#' @title Backport of as.Rconcordance for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::as.Rconcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") export(as.Rconcordance) + +as.Rconcordance <- function(x, ...) { + UseMethod("as.Rconcordance") +} + +#' @title Backport of as.Rconcordance.default for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::as.Rconcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") S3method("as.Rconcordance", "default") + +as.Rconcordance.default <- function(x, ...) { + # clean comments etc. + s <- sub("^.*(concordance){1}?", "concordance", sub("[^[:digit:]]*$", "", x)) + s <- grep("^concordance:", s, value = TRUE) + if (!length(s)) + return(NULL) + result <- stringToConcordance(s[1]) + for (line in s[-1]) + result <- addConcordance(result, line) + result +} + +# This takes one concordance string and produces a single concordance +# object + +stringToConcordance <- function(s) { + split <- strsplit(s, ":")[[1]] + targetfile <- split[2] + srcFile <- split[3] + if (length(split) == 4) { + ofs <- 0 + vi <- 4 + } else { + ofs <- as.integer(sub("^ofs ([0-9]+)", "\\1", split[4])) + vi <- 5 + } + values <- as.integer(strsplit(split[vi], " ")[[1]]) + firstline <- values[1] + rledata <- matrix(values[-1], nrow = 2) + rle <- structure(list(lengths=rledata[1,], values=rledata[2,]), class="rle") + diffs <- inverse.rle(rle) + srcLines <- c(firstline, firstline + cumsum(diffs)) + structure(list(offset = ofs, srcFile = srcFile, srcLine = srcLines), + class = "Rconcordance") +} + +# This modifies an existing concordance object to incorporate +# one new concordance string + +addConcordance <- function(conc, s) { + prev <- stringToConcordance(s) + if (!is.null(prev)) { + conc$srcFile <- rep_len(conc$srcFile, length(conc$srcLine)) + i <- seq_along(prev$srcLine) + conc$srcFile[prev$offset + i] <- prev$srcFile + conc$srcLine[prev$offset + i] <- prev$srcLine + } + conc +} + +# This modifies an existing concordance by following links specified +# in a previous one. + +followConcordance <- function(conc, prevConcordance) { + if (!is.null(prevConcordance)) { + curLines <- conc$srcLine + curFile <- rep_len(conc$srcFile, length(curLines)) + curOfs <- conc$offset + + prevLines <- prevConcordance$srcLine + prevFile <- rep_len(prevConcordance$srcFile, length(prevLines)) + prevOfs <- prevConcordance$offset + + if (prevOfs) { + prevLines <- c(rep(NA_integer_, prevOfs), prevLines) + prevFile <- c(rep(NA_character_, prevOfs), prevFile) + prevOfs <- 0 + } + n0 <- max(curLines) + n1 <- length(prevLines) + if (n1 < n0) { + prevLines <- c(prevLines, rep(NA_integer_, n0 - n1)) + prevFile <- c(prevFile, rep(NA_character_, n0 - n1)) + } + new <- is.na(prevLines[curLines]) + + conc$srcFile <- ifelse(new, curFile, + prevFile[curLines]) + conc$srcLine <- ifelse(new, curLines, + prevLines[curLines]) + } + conc +} + +#' @title Backport of matchConcordance for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::matchConcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") export(matchConcordance) + +matchConcordance <- function(linenum, concordance) { + if (!all(c("offset", "srcLine", "srcFile") %in% names(concordance))) + stop("concordance is not valid") + linenum <- as.numeric(linenum) + srcLines <- concordance$srcLine + srcFile <- rep_len(concordance$srcFile, length(srcLines)) + offset <- concordance$offset + + result <- matrix(character(), length(linenum), 2, + dimnames = list(NULL, + c("srcFile", "srcLine"))) + for (i in seq_along(linenum)) { + if (linenum[i] <= concordance$offset) + result[i,] <- c("", "") + else + result[i,] <- c(srcFile[linenum[i] - offset], + with(concordance, srcLine[linenum[i] - offset])) + } + result +} diff --git a/R/import.R b/R/import.R index 3145341..90006c6 100644 --- a/R/import.R +++ b/R/import.R @@ -62,6 +62,7 @@ get_backports = function(v = getRversion()) { } FUNS = list( + "4.3.0" = c("as.Rconcordance", "matchConcordance"), "4.1.0" = c("...names"), "4.0.1" = c("paste", "paste0"), "4.0.0" = c("R_user_dir", "deparse1", "list2DF", "suppressWarnings", "suppressMessages", "stopifnot"), diff --git a/README.md b/README.md index 26a2246..b38035d 100644 --- a/README.md +++ b/README.md @@ -113,3 +113,10 @@ for including `backports` in the `Imports:` section of your `DESCRIPTION` file i ## Backports for R versions prior to 4.1.0 * `base::...names()` + +## Backports for R versions prior to 4.3.0 +* `tools:::print.Rconcordance` +* `tools:::as.character.Rconcordance` +* `tools::as.Rconcordance` +* `tools:::as.Rconcordance.default` +* `tools::matchConcordance` diff --git a/man/as.Rconcordance.Rd b/man/as.Rconcordance.Rd new file mode 100644 index 0000000..e9d8f8c --- /dev/null +++ b/man/as.Rconcordance.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{as.Rconcordance} +\alias{as.Rconcordance} +\title{Backport of as.Rconcordance for R < 4.3.0} +\usage{ +as.Rconcordance(x, ...) +} +\description{ +See the original description in \code{tools::as.Rconcordance}. +} +\keyword{internal} diff --git a/man/as.Rconcordance.default.Rd b/man/as.Rconcordance.default.Rd new file mode 100644 index 0000000..2322662 --- /dev/null +++ b/man/as.Rconcordance.default.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{as.Rconcordance.default} +\alias{as.Rconcordance.default} +\title{Backport of as.Rconcordance.default for R < 4.3.0} +\usage{ +\method{as.Rconcordance}{default}(x, ...) +} +\description{ +See the original description in \code{tools::as.Rconcordance}. +} +\keyword{internal} diff --git a/man/as.character.Rconcordance.Rd b/man/as.character.Rconcordance.Rd new file mode 100644 index 0000000..8a10985 --- /dev/null +++ b/man/as.character.Rconcordance.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{as.character.Rconcordance} +\alias{as.character.Rconcordance} +\title{Backport of as.character.Rconcordance for R < 4.3.0} +\usage{ +\method{as.character}{Rconcordance}(x, targetfile = "", ...) +} +\description{ +See the original description in \code{tools::as.character.Rconcordance}. +} +\keyword{internal} diff --git a/man/matchConcordance.Rd b/man/matchConcordance.Rd new file mode 100644 index 0000000..6d72df1 --- /dev/null +++ b/man/matchConcordance.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{matchConcordance} +\alias{matchConcordance} +\title{Backport of matchConcordance for R < 4.3.0} +\usage{ +matchConcordance(linenum, concordance) +} +\description{ +See the original description in \code{tools::matchConcordance}. +} +\keyword{internal} diff --git a/man/print.Rconcordance.Rd b/man/print.Rconcordance.Rd new file mode 100644 index 0000000..298c2eb --- /dev/null +++ b/man/print.Rconcordance.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{print.Rconcordance} +\alias{print.Rconcordance} +\title{Backport of print.Rconcordance for R < 4.3.0} +\usage{ +\method{print}{Rconcordance}(x, ...) +} +\description{ +See the original description in \code{tools::print.Rconcordance}. +} +\keyword{internal} diff --git a/tests/test_Rconcordance.R b/tests/test_Rconcordance.R new file mode 100644 index 0000000..be23627 --- /dev/null +++ b/tests/test_Rconcordance.R @@ -0,0 +1,17 @@ +source("helper/helper.R") + +if (exists("as.Rconcordance", envir = asNamespace("tools"))) { + f <- get("as.Rconcordance", envir = asNamespace("tools")) + expect_same <- makeCompareFun(f, backports:::as.Rconcordance) + + expect_same("") +} + +if (exists("matchConcordance", envir = asNamespace("tools"))) { + f = get("matchConcordance", envir = asNamespace("tools")) + expect_same = makeCompareFun(f, backports:::matchConcordance) + + conc <- as.Rconcordance("") + + expect_same(20, conc) +} From f9a5258ff975f50db66121f739fd230abb10ad75 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sun, 5 Mar 2023 14:08:54 -0500 Subject: [PATCH 2/6] Update Roxygen output --- DESCRIPTION | 2 +- man/backports-package.Rd | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 45fab3c..547ab1e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,4 +24,4 @@ ByteCompile: yes Depends: R (>= 3.0.0) Encoding: UTF-8 -RoxygenNote: 7.2.2 +RoxygenNote: 7.2.3 diff --git a/man/backports-package.Rd b/man/backports-package.Rd index ac21214..c74b323 100644 --- a/man/backports-package.Rd +++ b/man/backports-package.Rd @@ -21,6 +21,7 @@ Useful links: Authors: \itemize{ + \item Duncan Murdoch \email{murdoch.duncan@gmail.com} \item R Core Team } From b0cb6f12dde2d2b54bf53e37cc57d3ed85240143 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sun, 5 Mar 2023 14:34:07 -0500 Subject: [PATCH 3/6] Fix test to work in R-devel --- tests/test_Rconcordance.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/test_Rconcordance.R b/tests/test_Rconcordance.R index be23627..08c7c36 100644 --- a/tests/test_Rconcordance.R +++ b/tests/test_Rconcordance.R @@ -1,17 +1,17 @@ source("helper/helper.R") -if (exists("as.Rconcordance", envir = asNamespace("tools"))) { +if (exists("as.Rconcordance", envir = asNamespace("tools"), inherits = FALSE)) { f <- get("as.Rconcordance", envir = asNamespace("tools")) - expect_same <- makeCompareFun(f, backports:::as.Rconcordance) + expect_same <- makeCompareFun(f, backports:::as.Rconcordance.default) expect_same("") } -if (exists("matchConcordance", envir = asNamespace("tools"))) { +if (exists("matchConcordance", envir = asNamespace("tools"), inherits = FALSE)) { f = get("matchConcordance", envir = asNamespace("tools")) expect_same = makeCompareFun(f, backports:::matchConcordance) - conc <- as.Rconcordance("") + conc <- tools::as.Rconcordance("") expect_same(20, conc) } From 4b85d90a3ad11a5ee4e61d1c113991526b4d1cc2 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Mon, 20 Mar 2023 09:02:45 -0400 Subject: [PATCH 4/6] R-devel has updated R concordance functions to handle Windows paths, and to export followConcordance. --- R/Rconcordance.R | 62 ++++++++++++++++++++++++++++++++++------ man/followConcordance.Rd | 12 ++++++++ 2 files changed, 65 insertions(+), 9 deletions(-) create mode 100644 man/followConcordance.Rd diff --git a/R/Rconcordance.R b/R/Rconcordance.R index 9f869b7..9cf5156 100644 --- a/R/Rconcordance.R +++ b/R/Rconcordance.R @@ -120,11 +120,50 @@ as.Rconcordance.default <- function(x, ...) { result } +# Windows paths may include colons in the filenames +# if drive letters are used. This looks for drive letters that +# have been split from the rest of the path and reattaches +# them. + +fixWindowsConcordancePaths <- function(split) { + if (length(split) <= 4) + return(split) + # We are looking for a drive letter which should have been at the start + # of the 2nd or 3rd entry, but will be in an entry by itself + + driveletter <- grep("^[a-zA-Z]$", split[2:4]) + 1 + ofs <- grep("^ofs [[:digit:]]+$", split[4:length(split)]) + 3 + + # The drive letter can't precede the offset record + driveletter <- setdiff(driveletter, ofs - 1) + + if (!length(driveletter)) + return(split) + + if (!length(ofs) # no ofs record but length is 5 or more + || length(split) >= 6) { + if (2 %in% driveletter) { + split <- c(split[1], + paste(split[2], split[3], sep=":"), + split[4:length(split)]) + driveletter <- driveletter - 1 + } + if (3 %in% driveletter) { + split <- c(split[1:2], + paste(split[3], split[4], sep=":"), + split[5:length(split)]) + } + } + split +} + # This takes one concordance string and produces a single concordance # object stringToConcordance <- function(s) { split <- strsplit(s, ":")[[1]] + if (.Platform$OS.type == "windows") + split <- fixWindowsConcordancePaths(split) targetfile <- split[2] srcFile <- split[3] if (length(split) == 4) { @@ -158,14 +197,19 @@ addConcordance <- function(conc, s) { conc } -# This modifies an existing concordance by following links specified -# in a previous one. +#' @title Backport of followConcordance for R < 4.3.0 +#' +#' @description +#' See the original description in \code{tools::followConcordance}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.3.0") S3method("print", "Rconcordance") -followConcordance <- function(conc, prevConcordance) { +followConcordance <- function(concordance, prevConcordance) { if (!is.null(prevConcordance)) { - curLines <- conc$srcLine - curFile <- rep_len(conc$srcFile, length(curLines)) - curOfs <- conc$offset + curLines <- concordance$srcLine + curFile <- rep_len(concordance$srcFile, length(curLines)) + curOfs <- concordance$offset prevLines <- prevConcordance$srcLine prevFile <- rep_len(prevConcordance$srcFile, length(prevLines)) @@ -184,12 +228,12 @@ followConcordance <- function(conc, prevConcordance) { } new <- is.na(prevLines[curLines]) - conc$srcFile <- ifelse(new, curFile, + concordance$srcFile <- ifelse(new, curFile, prevFile[curLines]) - conc$srcLine <- ifelse(new, curLines, + concordance$srcLine <- ifelse(new, curLines, prevLines[curLines]) } - conc + concordance } #' @title Backport of matchConcordance for R < 4.3.0 diff --git a/man/followConcordance.Rd b/man/followConcordance.Rd new file mode 100644 index 0000000..55793c5 --- /dev/null +++ b/man/followConcordance.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Rconcordance.R +\name{followConcordance} +\alias{followConcordance} +\title{Backport of followConcordance for R < 4.3.0} +\usage{ +followConcordance(concordance, prevConcordance) +} +\description{ +See the original description in \code{tools::followConcordance}. +} +\keyword{internal} From ddf6bd65c1d173f93f49b87073ed6d2186a890ad Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Mon, 20 Mar 2023 09:20:18 -0400 Subject: [PATCH 5/6] R-devel has made changes to concordance code --- .github/workflows/rcmdcheck.yml | 21 ++++++++++++++++- NAMESPACE | 1 + R/Rconcordance.R | 2 +- R/import.R | 10 ++++---- R/libPaths.R | 41 +++++++++++++++++++++++++++++++++ R/zzz.R | 1 + README.md | 1 + man/libPaths.Rd | 21 +++++++++++++++++ tests/test_dotlibPaths.R | 18 +++++++++++++++ 9 files changed, 109 insertions(+), 7 deletions(-) create mode 100644 R/libPaths.R create mode 100644 man/libPaths.Rd create mode 100644 tests/test_dotlibPaths.R diff --git a/.github/workflows/rcmdcheck.yml b/.github/workflows/rcmdcheck.yml index 7b60002..b7cc6d2 100644 --- a/.github/workflows/rcmdcheck.yml +++ b/.github/workflows/rcmdcheck.yml @@ -25,6 +25,10 @@ jobs: - {os: ubuntu-latest, r: '3.5'} - {os: ubuntu-latest, r: '3.4'} - {os: ubuntu-latest, r: '3.3'} + - {os: ubuntu-latest, r: '3.2'} +# The remotes package is not available before 3.2 +# - {os: ubuntu-latest, r: '3.1'} +# - {os: ubuntu-latest, r: '3.0'} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true @@ -40,13 +44,28 @@ jobs: with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} - use-public-rspm: true + use-public-rspm: matrix.config.r > '3.3' + - name: Install in old versions + if: matrix.config.r <= '3.3' + run: | + install.packages("remotes") + remotes::install_local(".", dependencies = TRUE) + shell: Rscript {0} + - uses: r-lib/actions/setup-r-dependencies@v2 + if: matrix.config.r > '3.3' with: extra-packages: any::rcmdcheck needs: check + - name: Check in old versions + if: matrix.config.r <= '3.3' + run: | + R CMD build . + R CMD check --no-manual *.tar.gz + - uses: r-lib/actions/check-r-package@v2 + if: matrix.config.r > '3.3' with: upload-snapshots: true diff --git a/NAMESPACE b/NAMESPACE index 953b377..2572a7a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ if (getRversion() < "4.3.0") S3method("as.character", "Rconcordance") if (getRversion() < "4.3.0") S3method("print", "Rconcordance") if (getRversion() < "4.3.0") export(as.Rconcordance) if (getRversion() < "4.3.0") export(matchConcordance) +if (getRversion() < "4.1.0") export(.libPaths) importFrom(utils,getFromNamespace) importFrom(utils,head) useDynLib(backports,dotsElt) diff --git a/R/Rconcordance.R b/R/Rconcordance.R index 9cf5156..f0be0da 100644 --- a/R/Rconcordance.R +++ b/R/Rconcordance.R @@ -203,7 +203,7 @@ addConcordance <- function(conc, s) { #' See the original description in \code{tools::followConcordance}. #' #' @keywords internal -#' @rawNamespace if (getRversion() < "4.3.0") S3method("print", "Rconcordance") +#' @rawNamespace if (getRversion() < "4.3.0") export(followConcordance)) followConcordance <- function(concordance, prevConcordance) { if (!is.null(prevConcordance)) { diff --git a/R/import.R b/R/import.R index 90006c6..2cd7666 100644 --- a/R/import.R +++ b/R/import.R @@ -63,14 +63,14 @@ get_backports = function(v = getRversion()) { FUNS = list( "4.3.0" = c("as.Rconcordance", "matchConcordance"), - "4.1.0" = c("...names"), + "4.1.0" = c("...names", ".libPaths"), "4.0.1" = c("paste", "paste0"), "4.0.0" = c("R_user_dir", "deparse1", "list2DF", "suppressWarnings", "suppressMessages", "stopifnot"), - "3.6.0" = c("warningCondition", "errorCondition", "vignetteInfo", "dQuote", "sQuote", "removeSource", "asplit"), + "3.6.0" = c("warningCondition", "errorCondition", "vignetteInfo", "dQuote", "sQuote", "removeSource", "asplit", "str2lang", "str2expression"), "3.5.0" = c("...length", "...elt", "isFALSE", "isTRUE"), - "3.4.0" = c("hasName"), - "3.3.0" = c("startsWith", "endsWith", "strrep", "trimws", "capture.output"), - "3.2.0" = c("anyNA", "dir.exists", "file.size", "file.mode", "file.mtime", "lengths", "file.info", "URLencode", "isNamespaceLoaded"), + "3.4.0" = c("hasName", ".valid.factor"), + "3.3.0" = c("startsWith", "endsWith", "strrep", "capture.output"), + "3.2.0" = c("anyNA", "dir.exists", "file.size", "file.mode", "file.mtime", "lengths", "file.info", "URLencode", "isNamespaceLoaded", "trimws"), "3.1.0" = character(), "3.0.0" = character(), "0.0.0" = character() diff --git a/R/libPaths.R b/R/libPaths.R new file mode 100644 index 0000000..99c80ba --- /dev/null +++ b/R/libPaths.R @@ -0,0 +1,41 @@ +#' @title Backport of .libPaths for R < 4.1.0 +#' @rdname libPaths +#' +#' @description +#' See the original description in \code{base::.libPaths}. +#' +#' @keywords internal +#' @rawNamespace if (getRversion() < "4.1.0") export(.libPaths) +#' @examples +#' save <- .libPaths() +#' save +#' # ignore the site library +#' .libPaths("test", include.site = FALSE) +#' +#' # restore the original +#' .libPaths(save) + +.libPaths <- local({ + .lib.loc <- character() # This won't be used; see below + function(new, include.site = TRUE) { + if(!missing(new)) { + ## paths don't really need to be unique, but searching + ## large library trees repeatedly would be inefficient. + ## Use normalizePath for display + new <- Sys.glob(path.expand(new)) + paths <- c(new, if(include.site) .Library.site, .Library) + paths <- paths[dir.exists(paths)] + .lib.loc <<- unique(normalizePath(paths, "/")) + } + else + .lib.loc +}}) + +# Run this in .onLoad: + +# environment(.libPaths) <- environment(base::.libPaths) + +# This will make our function see and modify the base +# function's copy of .lib.loc. This relies on the +# implementation in base, which has been the +# same since R 1.6.0 or earlier. diff --git a/R/zzz.R b/R/zzz.R index 5bec0dc..de7a5e7 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,4 +3,5 @@ .onUnload = function (libpath) { library.dynam.unload("backports", libpath) + environment(.libPaths) <- environment(base::.libPaths) } diff --git a/README.md b/README.md index b38035d..a7ee2c6 100644 --- a/README.md +++ b/README.md @@ -113,6 +113,7 @@ for including `backports` in the `Imports:` section of your `DESCRIPTION` file i ## Backports for R versions prior to 4.1.0 * `base::...names()` +* `base::.libPaths()` ## Backports for R versions prior to 4.3.0 * `tools:::print.Rconcordance` diff --git a/man/libPaths.Rd b/man/libPaths.Rd new file mode 100644 index 0000000..04eccf9 --- /dev/null +++ b/man/libPaths.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/libPaths.R +\name{.libPaths} +\alias{.libPaths} +\title{Backport of .libPaths for R < 4.1.0} +\usage{ +.libPaths(new, include.site = TRUE) +} +\description{ +See the original description in \code{base::.libPaths}. +} +\examples{ +save <- .libPaths() +save +# ignore the site library +.libPaths("test", include.site = FALSE) + +# restore the original +.libPaths(save) +} +\keyword{internal} diff --git a/tests/test_dotlibPaths.R b/tests/test_dotlibPaths.R new file mode 100644 index 0000000..de5557d --- /dev/null +++ b/tests/test_dotlibPaths.R @@ -0,0 +1,18 @@ +source("helper/helper.R") + +f = get(".libPaths", envir = baseenv()) +expect_same = makeCompareFun(f, backports:::.libPaths) + +save <- .libPaths() + +f <- tempfile() +expect_same(f) +dir.create(f) +expect_same(f) +if (getRversion() >= "4.1.0") { + expect_same(f, include.site = FALSE) +} else { + .libPaths(f, include.site = FALSE) + expect_same() +} +.libPaths(save, include.site = length(.Library.site) && .Library.site %in% save) From f5e241d7c4c83eb59338966b2d050f8b950d88d2 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Mon, 20 Mar 2023 09:22:30 -0400 Subject: [PATCH 6/6] Fix NAMESPACE --- NAMESPACE | 3 ++- R/Rconcordance.R | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2572a7a..8efd154 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,12 +40,13 @@ if (getRversion() < "4.0.0") export(suppressWarnings) if (getRversion() < "4.0.1") export(paste) if (getRversion() < "4.0.1") export(paste0) if (getRversion() < "4.1.0") export(...names) +if (getRversion() < "4.1.0") export(.libPaths) if (getRversion() < "4.3.0") S3method("as.Rconcordance", "default") if (getRversion() < "4.3.0") S3method("as.character", "Rconcordance") if (getRversion() < "4.3.0") S3method("print", "Rconcordance") if (getRversion() < "4.3.0") export(as.Rconcordance) +if (getRversion() < "4.3.0") export(followConcordance) if (getRversion() < "4.3.0") export(matchConcordance) -if (getRversion() < "4.1.0") export(.libPaths) importFrom(utils,getFromNamespace) importFrom(utils,head) useDynLib(backports,dotsElt) diff --git a/R/Rconcordance.R b/R/Rconcordance.R index f0be0da..79a564f 100644 --- a/R/Rconcordance.R +++ b/R/Rconcordance.R @@ -203,7 +203,7 @@ addConcordance <- function(conc, s) { #' See the original description in \code{tools::followConcordance}. #' #' @keywords internal -#' @rawNamespace if (getRversion() < "4.3.0") export(followConcordance)) +#' @rawNamespace if (getRversion() < "4.3.0") export(followConcordance) followConcordance <- function(concordance, prevConcordance) { if (!is.null(prevConcordance)) {