1# Copyright (C) 2021 Brodie Gaslam 2# 3# This file is part of "diffobj - Diffs for R Objects" 4# 5# This program is free software: you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation, either version 2 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license. 16 17#' Run Rdiff Directly on R Objects 18#' 19#' These functions are here for reference and testing purposes. They are 20#' wrappers to \code{tools::Rdiff} and rely on an existing system diff utility. 21#' You should be using \code{\link{ses}} or \code{\link{diffChr}} instead of 22#' \code{Rdiff_chr} and \code{\link{diffPrint}} instead of \code{Rdiff_obj}. 23#' See limitations in note. 24#' 25#' \code{Rdiff_chr} runs diffs on character vectors or objects coerced to 26#' character vectors, where each value in the vectors is treated as a line in a 27#' file. \code{Rdiff_chr} always runs with the \code{useDiff} and \code{Log} 28#' parameters set to \code{TRUE}. 29#' 30#' \code{Rdiff_obj} runs diffs on the \code{print}ed representation of 31#' the provided objects. For each of \code{from}, \code{to}, will check if they 32#' are 1 length character vectors referencing an RDS file, and will use the 33#' contents of that RDS file as the object to compare. 34#' 35#' @note These functions will try to use the system \code{diff} utility. This 36#' will fail in systems that do not have that utility available (e.g. windows 37#' installation without Rtools). 38#' @importFrom tools Rdiff 39#' @export 40#' @seealso \code{\link{ses}}, \code{\link[=diffPrint]{diff*}} 41#' @param from character or object coercible to character for \code{Rdiff_chr}, 42#' any R object with \code{Rdiff_obj}, or a file pointing to an RDS object 43#' @param to character same as \code{from} 44#' @param nullPointers passed to \code{tools::Rdiff} 45#' @param silent TRUE or FALSE, whether to display output to screen 46#' @param minimal TRUE or FALSE, whether to exclude the lines that show the 47#' actual differences or only the actual edit script commands 48#' @return the Rdiff output, invisibly if \code{silent} is FALSE 49#' Rdiff_chr(letters[1:5], LETTERS[1:5]) 50#' Rdiff_obj(letters[1:5], LETTERS[1:5]) 51 52Rdiff_chr <- function(from, to, silent=FALSE, minimal=FALSE, nullPointers=TRUE) { 53 A <- try(as.character(from)) 54 if(inherits(A, "try-error")) stop("Unable to coerce `target` to character.") 55 B <- try(as.character(to)) 56 if(inherits(B, "try-error")) stop("Unable to coerce `current` to character.") 57 58 af <- tempfile() 59 bf <- tempfile() 60 writeLines(A, af) 61 writeLines(B, bf) 62 on.exit(unlink(c(af, bf))) 63 64 Rdiff_run( 65 silent=silent, minimal=minimal, from=af, to=bf, nullPointers=nullPointers 66 ) 67} 68#' @export 69#' @rdname Rdiff_chr 70 71Rdiff_obj <- function(from, to, silent=FALSE, minimal=FALSE, nullPointers=TRUE) { 72 dummy.env <- new.env() # used b/c unique object 73 files <- try( 74 vapply( 75 list(from, to), 76 function(x) { 77 if( 78 is.character(x) && length(x) == 1L && !is.na(x) && file_test("-f", x) 79 ) { 80 rdstry <- tryCatch(readRDS(x), error=function(x) dummy.env) 81 if(!identical(rdstry, dummy.env)) x <- rdstry 82 } 83 f <- tempfile() 84 on.exit(unlink(f)) 85 capture.output(if(isS4(x)) show(x) else print(x), file=f) 86 on.exit() 87 f 88 }, 89 character(1L) 90 ) ) 91 if(inherits(files, "try-error")) 92 stop("Unable to store text representation of objects") 93 on.exit(unlink(files)) 94 Rdiff_run( 95 from=files[[1L]], to=files[[2L]], silent=silent, minimal=minimal, 96 nullPointers=nullPointers 97 ) 98} 99# Internal use only: BEWARE, will unlink from, to 100 101Rdiff_run <- function(from, to, nullPointers, silent, minimal) { 102 stopifnot( 103 isTRUE(silent) || identical(silent, FALSE), 104 isTRUE(minimal) || identical(minimal, FALSE) 105 ) 106 res <- tryCatch( 107 Rdiff( 108 from=from, to=to, useDiff=TRUE, Log=TRUE, nullPointers=nullPointers 109 )$out, 110 warning=function(e) 111 stop( 112 "`tools::Rdiff` returned a warning; this likely means you are running ", 113 "without a `diff` utility accessible to R" 114 ) 115 ) 116 if(!is.character(res)) 117 # nocov start 118 stop("Internal Error: Unexpected tools::Rdiff output, contact maintainer") 119 # nocov end 120 121 res <- if(minimal) res[!grepl("^[<>-]", res)] else res 122 if(silent) res else { 123 cat(res, sep="\n") 124 invisible(res) 125 } 126} 127#' Attempt to Detect Whether diff Utility is Available 128#' 129#' Checks whether \code{\link[=Rdiff]{tools::Rdiff}} issues a warning when 130#' running with \code{useDiff=TRUE} and if it does assumes this is because the 131#' diff utility is not available. Intended primarily for testing purposes. 132#' 133#' @export 134#' @return TRUE or FALSE 135#' @param test.with function to test for diff presence with, typically Rdiff 136#' @examples 137#' has_Rdiff() 138 139has_Rdiff <- function(test.with=tools::Rdiff) { 140 f.a <- tempfile() 141 f.b <- tempfile() 142 on.exit(unlink(c(f.a, f.b))) 143 writeLines(letters[1:3], f.a) 144 writeLines(LETTERS, f.b) 145 tryCatch( 146 { 147 test.with( 148 from=f.a, to=f.b, useDiff=TRUE, Log=TRUE, nullPointers=FALSE 149 ) 150 TRUE 151 }, warning=function(e) FALSE 152 ) 153} 154