backports/0000755000176200001440000000000013162277252012251 5ustar liggesusersbackports/tests/0000755000176200001440000000000013145407723013412 5ustar liggesusersbackports/tests/test_anyNA.R0000644000176200001440000000061113006164103015564 0ustar liggesuserssource("helper/helper.R") if (exists("anyNA", envir = baseenv())) { f = get("anyNA", envir = baseenv()) expect_same = makeCompareFun(f, backports:::anyNA) expect_same(1) expect_same(NA) expect_same(iris) if (getRversion() >= "3.2.0") { expect_same(list(1, 2, list(3, 4, list(NA))), recursive = FALSE) expect_same(list(1, 2, list(3, 4, list(NA))), recursive = TRUE) } } backports/tests/helper/0000755000176200001440000000000013145260645014671 5ustar liggesusersbackports/tests/helper/helper.R0000644000176200001440000000147313145260645016300 0ustar liggesuserslibrary(backports) expect_identical = function(x, y) { stopifnot(identical(x, y)) } expect_true = function(x) { stopifnot(isTRUE(x)) } expect_error = function(x, pattern = NULL) { ok = try(eval.parent(substitute(x)), silent = TRUE) if (!inherits(ok, "try-error")) stop(deparse(substitute(x)), " did not throw an error") if (!is.null(pattern) && !grepl(pattern, as.character(ok))) stop(sprintf("Expected error message matching '%s', got '%s'", pattern, backports:::trimws(as.character(ok)))) } makeCompareFun = function(f1, f2, ...) { f1 = match.fun(f1) f2 = match.fun(f2) function(...) { r1 = try(f1(...), silent = TRUE) r2 = try(f2(...), silent = TRUE) if (inherits(r1, "try-error")) { stopifnot(inherits(r2, "try-error")) } else { expect_identical(r1, r2) } } } backports/tests/test_isFALSE.R0000644000176200001440000000026513145407723015765 0ustar liggesuserssource("helper/helper.R") f = backports:::isFALSE expect_identical(f(FALSE), TRUE) expect_identical(f(TRUE), FALSE) expect_identical(f(1), FALSE) expect_identical(f(iris), FALSE) backports/tests/test_startsWith.R0000644000176200001440000000412313006164103016734 0ustar liggesuserssource("helper/helper.R") if (exists("startsWith", envir = baseenv())) { f = get("startsWith", envir = baseenv()) expect_same = makeCompareFun(f, backports:::startsWith) expect_same("a", "a") expect_same(NA, "a") expect_same("a", NA) expect_same("a", "") expect_same("", "a") expect_same("", "") expect_same(c("a", NA, "b"), "b") expect_same("b", c("a", NA, "b")) expect_same(letters, c("m", NA, "")) } if (exists("endsWith", envir = baseenv())) { f = get("endsWith", envir = baseenv()) expect_same = makeCompareFun(f, backports:::endsWith) expect_same("a", "a") expect_same(NA, "a") expect_same("a", NA) expect_same("a", "") expect_same("", "a") expect_same("", "") expect_same(c("a", NA, "b"), "b") expect_same("b", c("a", NA, "b")) expect_same(letters, c("m", NA, "")) } # adapted from R's unit tests t1 = c("Foobar", "bla bla", "something", "another", "blu", "brown", "blau blüht der Enzian") t2 = c("some text", "any text") t3 = c("Martin", "Zürich", "Mächler") expect_true(all(backports:::startsWith(t1, ""))) expect_true(all(backports:::endsWith(t1, ""))) expect_true(all(backports:::endsWith(t2, ""))) expect_true(all(backports:::startsWith(t2, ""))) expect_true(all(backports:::endsWith(t3, ""))) expect_true(all(backports:::startsWith(t3, ""))) expect_true(all(backports:::endsWith(t2, "text"))) expect_true(all(backports:::endsWith(t2, " text"))) expect_identical(backports:::startsWith(t1, "b" ), c(FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, TRUE)) expect_identical(backports:::startsWith(t1, "bl"), c(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, TRUE)) expect_identical(backports:::startsWith(t1, "bla"),c(FALSE, TRUE, FALSE, FALSE,FALSE, FALSE, TRUE)) expect_identical(backports:::endsWith(t1, "n"), c(FALSE,FALSE, FALSE, FALSE,FALSE, TRUE, TRUE)) expect_identical(backports:::endsWith(t1, "an"), c(FALSE,FALSE, FALSE, FALSE,FALSE, FALSE, TRUE)) expect_identical(backports:::startsWith(t3, "M" ), c( TRUE, FALSE, TRUE)) expect_identical(backports:::startsWith(t3, "Ma"), c( TRUE, FALSE, FALSE)) expect_identical(backports:::startsWith(t3, "Mä"), c(FALSE, FALSE, TRUE)) backports/tests/test_get0.R0000644000176200001440000000151213107637173015434 0ustar liggesuserssource("helper/helper.R") if (exists("get0", envir = baseenv())) { f = get("get0", envir = baseenv()) expect_same = makeCompareFun(f, backports:::get0) foo = 1 ee = new.env() ee$bar = 1 ee$foobar = function(x) x^2 expect_same(character(0), ifnotfound = 1) expect_same(NA_character_, ifnotfound = 1) expect_same(factor("a"), ifnotfound = 1) expect_same("bar") expect_same("bar", ifnotfound = 42) expect_same("foo") expect_same("foo", ifnotfound = 42) expect_same(c("foo", "bar", "iris"), ifnotfound = 42) expect_same(c("bar", "foo", "iris"), ifnotfound = 42) expect_same(c("iris", "foo", "bar"), ifnotfound = 42) expect_same("bar", envir = ee) expect_same("bar", envir = ee, mode = "function") expect_same("bar", envir = ee, mode = "function") expect_same("foobar", envir = ee, mode = "function") } backports/tests/test_file.size.R0000644000176200001440000000036513006164103016454 0ustar liggesuserssource("helper/helper.R") if (exists("file.size", envir = baseenv())) { f = get("file.size", envir = baseenv()) expect_same = makeCompareFun(f, backports:::file.size) expect_same(R.home()) expect_same(file.path(R.home(), "COPYING")) } backports/tests/test_file.mtime.R0000644000176200001440000000037013006164103016611 0ustar liggesuserssource("helper/helper.R") if (exists("file.mtime", envir = baseenv())) { f = get("file.mtime", envir = baseenv()) expect_same = makeCompareFun(f, backports:::file.mtime) expect_same(R.home()) expect_same(file.path(R.home(), "COPYING")) } backports/tests/test_strrep.R0000644000176200001440000000201013006164103016070 0ustar liggesuserssource("helper/helper.R") if (exists("strrep", envir = baseenv())) { f = get("strrep", envir = baseenv()) expect_same = makeCompareFun(f, backports:::strrep) expect_same(NULL, 0) expect_same(NULL, 1) expect_same(NULL, 2) expect_same(NULL, 1:2) expect_same(character(0), 0) expect_same(character(0), 1) expect_same(character(0), 2) expect_same(character(0), 1:2) expect_same("", 0) expect_same("", 1) expect_same("", 2) expect_same("", 1:2) expect_same("a", 0) expect_same("a", 1) expect_same("a", 2) expect_same("a", 1:2) expect_same(NA, 0) expect_same(NA, 1) expect_same(NA, 1:2) expect_same(NA_character_, 0) expect_same(NA_character_, 1) expect_same(NA_character_, 2) expect_same(NA_character_, 1:2) expect_same(letters[1:2], 0) expect_same(letters[1:2], 1) expect_same(letters[1:2], 2) expect_same(letters[2:2], 1:2) expect_same(TRUE, 0) expect_same(TRUE, 1) expect_same(TRUE, 2) expect_same(TRUE, 1:2) expect_same("a", NA) expect_same("a", c(1, NA, 2)) } backports/tests/test_hasName.R0000644000176200001440000000047313006164103016140 0ustar liggesuserssource("helper/helper.R") if (exists("hasName", envir = getNamespace("utils"))) { f = get("hasName", envir = getNamespace("utils")) expect_same = makeCompareFun(f, backports:::hasName) x = list(1, a = 12, bbb = 99) expect_same(x, "a") expect_same(x, "c") expect_same(x, "bbb") expect_same(x, "b") } backports/tests/test_file.mode.R0000644000176200001440000000036513006164103016426 0ustar liggesuserssource("helper/helper.R") if (exists("file.mode", envir = baseenv())) { f = get("file.mode", envir = baseenv()) expect_same = makeCompareFun(f, backports:::file.mode) expect_same(R.home()) expect_same(file.path(R.home(), "COPYING")) } backports/tests/test_dotsElt.R0000644000176200001440000000101213145260731016200 0ustar liggesuserssource("helper/helper.R") wb = function(n, ...) backports:::...elt(n) if (exists("...elt", envir = baseenv())) { f = get("...elt", envir = baseenv()) wf = function(n, ...) f(n) expect_same = makeCompareFun(wf, wb) expect_same(1, 1, 2, 3) expect_same(2, 1, 2, 3) expect_same(3, 1, 2, 3) } expect_identical(wb(1, "a", "b", "c"), "a") expect_identical(wb(2, "a", "b", "c"), "b") expect_identical(wb(3, "a", "b", "c"), "c") expect_error(wb(0, "a"), "non-positive") expect_error(wb(2, "a"), "does not contain") backports/tests/test_trimws.R0000644000176200001440000000064513006164103016112 0ustar liggesuserssource("helper/helper.R") if (exists("trimws", envir = baseenv())) { f = get("trimws", envir = baseenv()) expect_same = makeCompareFun(f, backports:::trimws) expect_same("") expect_same(NA) expect_same(NA_character_) expect_same(sprintf(" %s ", letters)) expect_same(" x ") expect_same(" x ", which = "both") expect_same(" x ", which = "left") expect_same(" x ", which = "right") expect_same(1) } backports/tests/test_dir.exists.R0000644000176200001440000000043613006164103016657 0ustar liggesuserssource("helper/helper.R") if (exists("dir.exists", envir = baseenv())) { f = get("dir.exists", envir = baseenv()) expect_same = makeCompareFun(f, backports:::dir.exists) expect_same(tempdir()) expect_same(tempfile()) expect_same(rep.int(tempdir(), 2)) expect_same(TRUE) } backports/tests/test_lengths.R0000644000176200001440000000047113145257002016233 0ustar liggesuserssource("helper/helper.R") if (exists("lengths", envir = baseenv())) { f = get("lengths", envir = baseenv()) expect_same = makeCompareFun(f, backports:::lengths) expect_same(1:3) expect_same(setNames(1:3, letters[1:3])) expect_same(setNames(1:3, letters[1:3]), use.names = FALSE) expect_same(iris) } backports/tests/test_dotsLength.R0000644000176200001440000000101613145261127016701 0ustar liggesuserssource("helper/helper.R") wb = function(...) backports:::...length() if (exists("...length", envir = baseenv())) { f = get("...length", envir = baseenv()) wf = function(...) f() expect_same = makeCompareFun(wf, wb) expect_same(1) expect_same(1, 2) expect_same() } expect_identical(wb(1, "a", "b", "c"), 4L) expect_identical(wb(2, "a", "b"), 3L) expect_identical(wb(1), 1L) expect_identical(wb(), 0L) f = function(n) backports:::...length() expect_error(f(), "current call") expect_error(f(1), "current call") backports/tests/test_file.info.R0000644000176200001440000000056413006164103016436 0ustar liggesuserssource("helper/helper.R") x = tempdir() res1 = backports:::file.info(x, extra_cols = TRUE) res2 = backports:::file.info(x, extra_cols = FALSE) stopifnot(is.data.frame(res1), nrow(res1) == 1L, ncol(res1) >= 7L) stopifnot(is.data.frame(res2), nrow(res2) == 1L, ncol(res2) == 6L) expect_identical(res1, base::file.info(x)) expect_identical(res1[, 1:6, drop = FALSE], res2) backports/src/0000755000176200001440000000000013162262415013033 5ustar liggesusersbackports/src/dotsElt.c0000644000176200001440000000077513162262415014626 0ustar liggesusers#include #include SEXP dotsElt(SEXP env_, SEXP i_) { SEXP ddd = findVar(R_DotsSymbol, env_); int i = INTEGER(i_)[0]; R_len_t n = length(ddd); if (ddd == R_UnboundValue) error("incorrect context: the current call has no '...' to look in"); if (i <= 0) error("indexing '...' with non-positive index %d", i); if (i > n) error("the ... list does not contain %d elements", i); ddd = nthcdr(ddd, i - 1); return eval(CAR(ddd), env_); } backports/src/dotsLength.c0000644000176200001440000000044313162262415015313 0ustar liggesusers#include #include SEXP dotsLength(SEXP env_) { SEXP ddd = findVar(R_DotsSymbol, env_); if (ddd == R_UnboundValue) error("incorrect context: the current call has no '...' to look in"); return ScalarInteger(TYPEOF(ddd) == DOTSXP ? length(ddd) : 0); } backports/src/init.c0000644000176200001440000000074213162262415014145 0ustar liggesusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP dotsElt(SEXP, SEXP); extern SEXP dotsLength(SEXP); static const R_CallMethodDef CallEntries[] = { {"dotsElt", (DL_FUNC) &dotsElt, 2}, {"dotsLength", (DL_FUNC) &dotsLength, 1}, {NULL, NULL, 0} }; void R_init_backports(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } backports/NAMESPACE0000644000176200001440000000156713162257215013476 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(import) if (getRversion() < "3.2.0") export(anyNA) if (getRversion() < "3.2.0") export(dir.exists) if (getRversion() < "3.2.0") export(file.info) if (getRversion() < "3.2.0") export(file.mode) if (getRversion() < "3.2.0") export(file.mtime) if (getRversion() < "3.2.0") export(file.size) if (getRversion() < "3.2.0") export(get0) if (getRversion() < "3.2.0") export(lengths) if (getRversion() < "3.2.0") export(trimws) if (getRversion() < "3.3.0") export(endsWith) if (getRversion() < "3.3.0") export(startsWith) if (getRversion() < "3.3.0") export(strrep) if (getRversion() < "3.4.0") export(hasName) if (getRversion() < "3.5.0") export(...elt) if (getRversion() < "3.5.0") export(...length) if (getRversion() < "3.5.0") export(isFALSE) importFrom(utils,getFromNamespace) useDynLib(backports,dotsElt) useDynLib(backports,dotsLength) backports/NEWS.md0000644000176200001440000000171213162257235013347 0ustar liggesusers# backports 1.1.1 * Added `...length()` and `...elt()` for R versions prior to 3.5.0. * Added `isFALSE()` for R versions prior to 3.5.0. # backports 1.1.0 * New import mechanism to import packages during load-time with the function `import()`. This is now the recommended way to use backports non-interactively. Simply importing backports in the NAMESPACE still works, but is comparably error-prone if the same library is used by multiple R installations. # backports 1.0.5 * Added `get0()` for R versions prior to 3.2.0. * Added examples. # backports 1.0.4 * Added `hasName()` for R versions prior to 3.4.0. * Added `file.info()` with backport for argument `extra_cols`. # backports 1.0.3 * Removed stringi dependency. # backports 1.0.2 * Fixed `file.size()`, `file.mtime()` and `file.mode()` for R-3.1.x. # backports 1.0.1 * Added `file.size()`, `file.mtime()` and `file.mode()` for R versions prior to 3.2.0. # backports 1.0.0 * Initial version. backports/R/0000755000176200001440000000000013162257215012447 5ustar liggesusersbackports/R/file.mtime.R0000644000176200001440000000025013006164103014606 0ustar liggesusers#' @rdname file.size #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(file.mtime) file.mtime = function(...) { base::file.info(...)$mtime } backports/R/strrep.R0000644000176200001440000000141013006164103014073 0ustar liggesusers#' @title Backport of strrep for R < 3.3.0 #' @rdname strrep #' #' @description #' See the original description in \code{base::strrep}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.3.0") export(strrep) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_strrep = getFromNamespace("strrep", "backports") #' #' bp_strrep("-", 10) strrep = function(x, times) { x = as.character(x) if (length(x) == 0L) return(x) unlist(.mapply(function(x, times) { if (is.na(x) || is.na(times)) return(NA_character_) if (times <= 0L) return("") paste0(replicate(times, x), collapse = "") }, list(x = x, times = times), MoreArgs = list()), use.names = FALSE) } backports/R/dotsElt.R0000644000176200001440000000110413162257215014204 0ustar liggesusers#' @title Backport of ...elt for R < 3.4.2 #' @rdname dotsElt #' #' @description #' See the original description in \code{base::...elt}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.5.0") export(...elt) #' @useDynLib backports dotsElt #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_...elt = getFromNamespace("...elt", "backports") #' #' foo = function(n, ...) bp_...elt(n) #' foo(n = 2, "a", "b", "c") ...elt = function(n) { .Call(dotsElt, parent.frame(), as.integer(n)) } backports/R/anyNA.R0000644000176200001440000000113113006164103013562 0ustar liggesusers#' @title Backport of anyNA for R versions < 3.2.0. #' #' @description #' See the original description in \code{base::anyNA}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(anyNA) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_anyNA = getFromNamespace("anyNA", "backports") #' #' bp_anyNA(letters) anyNA = function(x, recursive = FALSE) { if (isTRUE(recursive) && (is.list(x) || is.pairlist(x))) return(any(rapply(x, anyNA, how = "unlist", recursive = FALSE))) any(is.na(x)) } backports/R/file.size.R0000644000176200001440000000133213006164103014447 0ustar liggesusers#' @title Backports of wrappers around \code{file.info} for R < 3.2.0 #' @rdname file.size #' #' @description #' See the original description in \code{base::file.size}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(file.size) #' @examples #' # get functions from namespace instead of possibly getting #' # implementations shipped with recent R versions: #' bp_file.size = getFromNamespace("file.size", "backports") #' bp_file.mode = getFromNamespace("file.size", "backports") #' bp_file.mtime = getFromNamespace("file.size", "backports") #' #' fn = file.path(R.home(), "COPYING") #' bp_file.size(fn) #' bp_file.mode(fn) #' bp_file.size(fn) file.size = function(...) { base::file.info(...)$size } backports/R/dotsLength.R0000644000176200001440000000110113162257215014676 0ustar liggesusers#' @title Backport of ...length for R < 3.4.2 #' @rdname dotsLength #' #' @description #' See the original description in \code{base::...length}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.5.0") export(...length) #' @useDynLib backports dotsLength #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_...length = getFromNamespace("...length", "backports") #' #' foo = function(...) bp_...length() #' foo(1, 2, 3) ...length = function() { .Call(dotsLength, parent.frame()) } backports/R/file.mode.R0000644000176200001440000000024513006164103014423 0ustar liggesusers#' @rdname file.size #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(file.mode) file.mode = function(...) { base::file.info(...)$mode } backports/R/file.info.R0000644000176200001440000000125313006164103014432 0ustar liggesusers#' @title Backport of \code{file.info} for R < 3.2.0 #' #' @description #' Argument \code{extra_cols} has been backported. #' See the original description in \code{base::file.info}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(file.info) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_file.info = getFromNamespace("file.info", "backports") #' #' bp_file.info(file.path(R.home(), "COPYING"), extra_cols = FALSE) file.info = function (..., extra_cols = TRUE) { if (isTRUE(extra_cols)) base::file.info(...) else base::file.info(...)[, 1:6, drop = FALSE] } backports/R/isFALSE.R0000644000176200001440000000102513162257215013756 0ustar liggesusers#' @title Backport of isFALSE for R < 3.4.2 #' @rdname isFALSE #' #' @description #' See the original description in \code{base::isFALSE}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.5.0") export(isFALSE) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_isFALSE = getFromNamespace("isFALSE", "backports") #' #' bp_isFALSE(FALSE) #' bp_isFALSE(iris) isFALSE = function(x) { is.logical(x) && length(x) == 1L && !is.na(x) && !x } backports/R/lengths.R0000644000176200001440000000105013145252612014227 0ustar liggesusers#' @title Backport of lengths for R < 3.2.0 #' @rdname lengths #' #' @description #' See the original description in \code{base::lengths}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(lengths) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_lengths = getFromNamespace("lengths", "backports") #' #' bp_lengths(list(1:3, 2)) lengths = function(x, use.names = TRUE) { vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names) } backports/R/import.R0000644000176200001440000000325113160026445014102 0ustar liggesusers#' @title Import backported functions into your package #' #' @description #' Imports objects from \pkg{backports} into the namespace of other packages #' by assigning it during load-time. #' See examples for a code snippet to copy to your package. #' #' @param pkgname [\code{character(1)}]\cr #' Name of the package where the backported function should be assigned. #' @param obj [\code{character}]\cr #' Name of objects to assign, as character vector. #' If \code{NULL}, all backports which are not provided by R itself are assigned. #' @export #' @seealso \code{\link[base]{.onLoad}} #' @examples #' \dontrun{ #' # This imports all functions implemented in backports while the package is loaded #' .onLoad <- function(libname, pkgname) { #' backports::import(pkgname) #' } #' #' # This only imports the function "trimws" #' .onLoad <- function(libname, pkgname) { #' backports::import(pkgname, "trimws") #' } #' } import = function(pkgname, obj = NULL) { if (getRversion() < "3.5.0") { pkg = getNamespace(pkgname) backports = getNamespace("backports") assignIfNotExists = function(x, where) { if (!exists(x, envir = where)) assign(x, get(x, envir = backports), envir = pkg) } if (!is.null(obj)) { BASE = intersect(BASE, obj) UTILS = intersect(UTILS, obj) } lapply(BASE, assignIfNotExists, where = baseenv()) lapply(UTILS, assignIfNotExists, where = getNamespace("utils")) } invisible(TRUE) } # constants used in import() BASE = c("anyNA", "dir.exists", "endsWith", "file.info", "file.mode", "file.mtime", "file.size", "get0", "lengths", "startsWith", "strrep", "trimws", "...length", "...elt", "isFALSE") UTILS = "hasName" backports/R/endsWith.R0000644000176200001440000000122413006164103014344 0ustar liggesusers#' @title Backport of endsWith for R < 3.3.0 #' @rdname endsWith #' #' @description #' See the original description in \code{base::endsWith}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.3.0") export(endsWith) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_endsWith = getFromNamespace("endsWith", "backports") #' #' bp_endsWith(c("aabb", "bbcc"), "bb") endsWith = function(x, suffix) { if (!is.character(x) || !is.character(suffix)) stop("non-character object(s)") n = nchar(x) suppressWarnings(substr(x, n - nchar(suffix) + 1L, n) == suffix) } backports/R/trimws.R0000644000176200001440000000145113145252612014115 0ustar liggesusers#' @title Backport of trimws for R < 3.3.0 #' @rdname trimws #' #' @description #' See the original description in \code{base::trimws}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(trimws) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_trimws = getFromNamespace("trimws", "backports") #' bp_trimws(c(" a ", "b ", " c")) #' #' bp_trimws(c(" a ", "b ", " c"), which = "left") trimws = function(x, which = c("both", "left", "right")) { which = match.arg(which) mysub = function(re, x) sub(re, "", x, perl = TRUE) if (which == "left") return(mysub("^[ \t\r\n]+", x)) if (which == "right") return(mysub("[ \t\r\n]+$", x)) mysub("[ \t\r\n]+$", mysub("^[ \t\r\n]+", x)) } backports/R/hasName.R0000644000176200001440000000103413006164103014132 0ustar liggesusers#' @title Backport of hasName for R < 3.4.0 #' @rdname hasName #' #' @description #' See the original description in \code{utils::hasName}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.4.0") export(hasName) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_hasName = getFromNamespace("hasName", "backports") #' #' bp_hasName(list(a = 1, b = 2), c("a", "b", "c")) hasName = function(x, name) { match(name, names(x), nomatch = 0L) > 0L } backports/R/dir.exists.R0000644000176200001440000000101013006164103014644 0ustar liggesusers#' @title Backport of dir.exists for R < 3.2.0 #' #' @description #' See the original description in \code{base::dir.exists}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(dir.exists) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_dir.exists = getFromNamespace("dir.exists", "backports") #' #' bp_dir.exists(tempdir()) dir.exists = function(paths) { x = base::file.info(paths)$isdir !is.na(x) & x } backports/R/startsWith.R0000644000176200001440000000121513006164103014733 0ustar liggesusers#' @title Backport of startsWith for R < 3.3.0 #' @rdname startsWith #' #' @description #' See the original description in \code{base::startsWith}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.3.0") export(startsWith) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_startsWith = getFromNamespace("startsWith", "backports") #' #' bp_startsWith(c("aabb", "bbcc"), "bb") startsWith = function(x, prefix) { if (!is.character(x) || !is.character(prefix)) stop("non-character object(s)") suppressWarnings(substr(x, 1L, nchar(prefix)) == prefix) } backports/R/zzz.R0000644000176200001440000000017413145410252013422 0ustar liggesusers#' @importFrom utils getFromNamespace NULL .onUnload = function (libpath) { library.dynam.unload("backports", libpath) } backports/R/get0.R0000644000176200001440000000135713107637173013443 0ustar liggesusers#' @title Backport of get0 for R < 3.2.0 #' @rdname get0 #' #' @description #' See the original description in \code{base::get0}. #' #' @keywords internal #' @rawNamespace if (getRversion() < "3.2.0") export(get0) #' @examples #' # get function from namespace instead of possibly getting #' # implementation shipped with recent R versions: #' bp_get0 = getFromNamespace("get0", "backports") #' #' bp_get0("a") #' bp_get0("a", ifnotfound = 0) #' #' foo = 12 #' bp_get0("foo") get0 = function(x, envir = pos.to.env(-1L), mode = "any", inherits = TRUE, ifnotfound = NULL) { if (!is.character(x) || length(x) == 0L) stop("Invalid first argument") mget(x[1L], envir = envir, mode = mode, inherits = inherits, ifnotfound = list(ifnotfound))[[1L]] } backports/MD50000644000176200001440000000527013162277252012565 0ustar liggesusers7d9a173e3adbd7615209e2744c767ead *DESCRIPTION 9524e543ce2757aa366531491adc46a8 *NAMESPACE 94fd66585d28825ed4a8ba839d9bb13b *NEWS.md 41879b295859b9f3dd0efc69737d4a12 *R/anyNA.R e1fb60c17ea8a6677c3a80637f88c830 *R/dir.exists.R da64e21c278b5017993dcc2321552c8f *R/dotsElt.R 481b7311ab8961c4fef48b8ec6cd5eb0 *R/dotsLength.R 8d6708837ab0c9222d582576160dcdeb *R/endsWith.R daf73a06568906502efabcfa63cc3f45 *R/file.info.R f03ad94562dfb233f213366ceb192900 *R/file.mode.R 9733ea86cf7e4e2ad39c226b68ab73ff *R/file.mtime.R fd795349608133c5b9b4850c8bce7115 *R/file.size.R 14e2f4982a54c0309a4fa7ca4309c286 *R/get0.R b8bd9db45b49fe62e5101de2d80ac4ef *R/hasName.R 62cd751df30011956bbb8e0e9c97c58d *R/import.R 71f82c7d4d76ea1bcf50c4882f2922a0 *R/isFALSE.R ee095da4109d7e289d11248e13ac9428 *R/lengths.R 1d59834fa8a4c2572b8a047376837618 *R/startsWith.R a4f40e3e2747b16bfe0cc6e80766e0f7 *R/strrep.R 2281b9271b328f1ce44735f433c57a1b *R/trimws.R b6bb3ebe20a41ed2dedea35f4809081e *R/zzz.R 5c3ef8d8d05cd9f2b6d63210b5924faa *man/anyNA.Rd a96f841e5bb26d875daafdec0ca3a12e *man/dir.exists.Rd 4b811bda283420d6bda01b250112119b *man/dotsElt.Rd 54f762138570780eaacbd437e19c6ff4 *man/dotsLength.Rd fff4aab715b29f9a293e46eedbba73fc *man/endsWith.Rd 4ad72c0183de86f7435b66fdd617dbf2 *man/file.info.Rd f0364a969e7687778d4b2e2a651612a0 *man/file.size.Rd d3cbd22979c771d5d8458b741f850439 *man/get0.Rd f6d4b60d090845baa1d66917e6c649ae *man/hasName.Rd 790787c2b04b8ee3674206e03db38412 *man/import.Rd 0ef694f3021e07f821b76875888c6702 *man/isFALSE.Rd 3193f8a1b410c99da87cdfd2306e4741 *man/lengths.Rd 0a5e953c05afce33ff2f200ce43cb536 *man/startsWith.Rd 71dccde721e5e07b058ea9988d2aa758 *man/strrep.Rd 44c533774b88159cbd550b9d842d65a2 *man/trimws.Rd d59274bb19ef27e3774e9d1bed9fb93e *src/dotsElt.c dea82a2ee366ce1253864931672df2cd *src/dotsLength.c c068b1377f387aa3ba2ab026af9cb94d *src/init.c 6004fbeeebd766931659360c64fd238c *tests/helper/helper.R 1b97afed1a49ba2f7e7588661dd78481 *tests/test_anyNA.R d012f4fc8d451334726a1609bb6d0584 *tests/test_dir.exists.R ff243305cbfd7c6c20dcf75a8b2f9b2c *tests/test_dotsElt.R 18ccf5227a80053f5b65dea32dff8562 *tests/test_dotsLength.R d20ca8e00de706dfca77fc4e7e079a30 *tests/test_file.info.R 8863972af374c21d56ea2625f357d1c1 *tests/test_file.mode.R 80309a60390999f8c875299d5343311a *tests/test_file.mtime.R 608d8ef6d47fde8c311efeb92600e7c5 *tests/test_file.size.R 8bbb0281ed2c45c26a8b1fe8829a8426 *tests/test_get0.R 224c4b67349277afb9ab178127d03470 *tests/test_hasName.R 59979fcc9294d65ac56ec1f5af289421 *tests/test_isFALSE.R 01ea7785d2d97d7364427f69ee028e43 *tests/test_lengths.R f5a7d4c6f5a89cd18a06029135ad1e57 *tests/test_startsWith.R f7bb3f7fe9fcfd990f6090c5fce29870 *tests/test_strrep.R 7ff35bbbb455c565d8ebcac87a015d22 *tests/test_trimws.R backports/DESCRIPTION0000644000176200001440000000162613162277252013764 0ustar liggesusersPackage: backports Type: Package Title: Reimplementations of Functions Introduced Since R-3.0.0 Version: 1.1.1 Author: Michel Lang Maintainer: Michel Lang Description: Implementations of functions which have been introduced in R since version 3.0.0. The backports are conditionally exported which results in R resolving the function names to the version shipped with R (if available) and uses the implemented backports as fallback. This way package developers can make use of the new functions without worrying about the minimum required R version. URL: https://github.com/mllg/backports BugReports: https://github.com/mllg/backports/issues License: GPL-2 NeedsCompilation: yes ByteCompile: yes Depends: R (>= 3.0.0) Imports: utils RoxygenNote: 6.0.1 Packaged: 2017-09-25 20:20:29 UTC; michel Repository: CRAN Date/Publication: 2017-09-25 22:09:46 UTC backports/man/0000755000176200001440000000000013145410203013006 5ustar liggesusersbackports/man/dir.exists.Rd0000644000176200001440000000076313107637173015416 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dir.exists.R \name{dir.exists} \alias{dir.exists} \title{Backport of dir.exists for R < 3.2.0} \usage{ dir.exists(paths) } \description{ See the original description in \code{base::dir.exists}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_dir.exists = getFromNamespace("dir.exists", "backports") bp_dir.exists(tempdir()) } \keyword{internal} backports/man/endsWith.Rd0000644000176200001440000000076313107637173015107 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/endsWith.R \name{endsWith} \alias{endsWith} \title{Backport of endsWith for R < 3.3.0} \usage{ endsWith(x, suffix) } \description{ See the original description in \code{base::endsWith}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_endsWith = getFromNamespace("endsWith", "backports") bp_endsWith(c("aabb", "bbcc"), "bb") } \keyword{internal} backports/man/anyNA.Rd0000644000176200001440000000073513107637173014327 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/anyNA.R \name{anyNA} \alias{anyNA} \title{Backport of anyNA for R versions < 3.2.0.} \usage{ anyNA(x, recursive = FALSE) } \description{ See the original description in \code{base::anyNA}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_anyNA = getFromNamespace("anyNA", "backports") bp_anyNA(letters) } \keyword{internal} backports/man/lengths.Rd0000644000176200001440000000075113145256222014755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lengths.R \name{lengths} \alias{lengths} \title{Backport of lengths for R < 3.2.0} \usage{ lengths(x, use.names = TRUE) } \description{ See the original description in \code{base::lengths}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_lengths = getFromNamespace("lengths", "backports") bp_lengths(list(1:3, 2)) } \keyword{internal} backports/man/import.Rd0000644000176200001440000000177213110373042014617 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/import.R \name{import} \alias{import} \title{Import backported functions into your package} \usage{ import(pkgname, obj = NULL) } \arguments{ \item{pkgname}{[\code{character(1)}]\cr Name of the package where the backported function should be assigned.} \item{obj}{[\code{character}]\cr Name of objects to assign, as character vector. If \code{NULL}, all backports which are not provided by R itself are assigned.} } \description{ Imports objects from \pkg{backports} into the namespace of other packages by assigning it during load-time. See examples for a code snippet to copy to your package. } \examples{ \dontrun{ # This imports all functions implemented in backports while the package is loaded .onLoad <- function(libname, pkgname) { backports::import(pkgname) } # This only imports the function "trimws" .onLoad <- function(libname, pkgname) { backports::import(pkgname, "trimws") } } } \seealso{ \code{\link[base]{.onLoad}} } backports/man/isFALSE.Rd0000644000176200001440000000074113145410203014465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/isFALSE.R \name{isFALSE} \alias{isFALSE} \title{Backport of isFALSE for R < 3.4.2} \usage{ isFALSE(x) } \description{ See the original description in \code{base::isFALSE}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_isFALSE = getFromNamespace("isFALSE", "backports") bp_isFALSE(FALSE) bp_isFALSE(iris) } \keyword{internal} backports/man/dotsElt.Rd0000644000176200001440000000076513145271754014743 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dotsElt.R \name{...elt} \alias{...elt} \title{Backport of ...elt for R < 3.4.2} \usage{ ...elt(n) } \description{ See the original description in \code{base::...elt}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_...elt = getFromNamespace("...elt", "backports") foo = function(n, ...) bp_...elt(n) foo(n = 2, "a", "b", "c") } \keyword{internal} backports/man/trimws.Rd0000644000176200001440000000106213107637173014640 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/trimws.R \name{trimws} \alias{trimws} \title{Backport of trimws for R < 3.3.0} \usage{ trimws(x, which = c("both", "left", "right")) } \description{ See the original description in \code{base::trimws}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_trimws = getFromNamespace("trimws", "backports") bp_trimws(c(" a ", "b ", " c")) bp_trimws(c(" a ", "b ", " c"), which = "left") } \keyword{internal} backports/man/hasName.Rd0000644000176200001440000000076613107637173014701 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/hasName.R \name{hasName} \alias{hasName} \title{Backport of hasName for R < 3.4.0} \usage{ hasName(x, name) } \description{ See the original description in \code{utils::hasName}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_hasName = getFromNamespace("hasName", "backports") bp_hasName(list(a = 1, b = 2), c("a", "b", "c")) } \keyword{internal} backports/man/get0.Rd0000644000176200001440000000106613107637173014156 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get0.R \name{get0} \alias{get0} \title{Backport of get0 for R < 3.2.0} \usage{ get0(x, envir = pos.to.env(-1L), mode = "any", inherits = TRUE, ifnotfound = NULL) } \description{ See the original description in \code{base::get0}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_get0 = getFromNamespace("get0", "backports") bp_get0("a") bp_get0("a", ifnotfound = 0) foo = 12 bp_get0("foo") } \keyword{internal} backports/man/startsWith.Rd0000644000176200001440000000100513107637173015464 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/startsWith.R \name{startsWith} \alias{startsWith} \title{Backport of startsWith for R < 3.3.0} \usage{ startsWith(x, prefix) } \description{ See the original description in \code{base::startsWith}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_startsWith = getFromNamespace("startsWith", "backports") bp_startsWith(c("aabb", "bbcc"), "bb") } \keyword{internal} backports/man/file.size.Rd0000644000176200001440000000143313107637173015205 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/file.mode.R, R/file.mtime.R, R/file.size.R \name{file.mode} \alias{file.mode} \alias{file.mtime} \alias{file.size} \title{Backports of wrappers around \code{file.info} for R < 3.2.0} \usage{ file.mode(...) file.mtime(...) file.size(...) } \description{ See the original description in \code{base::file.size}. } \examples{ # get functions from namespace instead of possibly getting # implementations shipped with recent R versions: bp_file.size = getFromNamespace("file.size", "backports") bp_file.mode = getFromNamespace("file.size", "backports") bp_file.mtime = getFromNamespace("file.size", "backports") fn = file.path(R.home(), "COPYING") bp_file.size(fn) bp_file.mode(fn) bp_file.size(fn) } \keyword{internal} backports/man/strrep.Rd0000644000176200001440000000072013107637173014632 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/strrep.R \name{strrep} \alias{strrep} \title{Backport of strrep for R < 3.3.0} \usage{ strrep(x, times) } \description{ See the original description in \code{base::strrep}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_strrep = getFromNamespace("strrep", "backports") bp_strrep("-", 10) } \keyword{internal} backports/man/file.info.Rd0000644000176200001440000000113313107637173015163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/file.info.R \name{file.info} \alias{file.info} \title{Backport of \code{file.info} for R < 3.2.0} \usage{ file.info(..., extra_cols = TRUE) } \description{ Argument \code{extra_cols} has been backported. See the original description in \code{base::file.info}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_file.info = getFromNamespace("file.info", "backports") bp_file.info(file.path(R.home(), "COPYING"), extra_cols = FALSE) } \keyword{internal} backports/man/dotsLength.Rd0000644000176200001440000000077613145256236015440 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dotsLength.R \name{...length} \alias{...length} \title{Backport of ...length for R < 3.4.2} \usage{ ...length() } \description{ See the original description in \code{base::...length}. } \examples{ # get function from namespace instead of possibly getting # implementation shipped with recent R versions: bp_...length = getFromNamespace("...length", "backports") foo = function(...) bp_...length() foo(1, 2, 3) } \keyword{internal}