R/ScripDiff.R

ScripDiff <- function(commandfile, outfile=NULL, savefile=NULL, debug=FALSE, R.suf="R") {
    R.suf.regexp <- paste("\\.", R.suf, "$", sep="")
    if (is.null(outfile))
        outfile <- gsub(R.suf.regexp, ".Rout", commandfile, perl=TRUE)
    if (is.null(savefile))
        savefile <- paste(outfile, ".save", sep="")
    rtIn <- gsub(R.suf.regexp, ".Rt", commandfile, perl=TRUE)
    rtSave <- gsub(R.suf.regexp, ".Rt.save", commandfile, perl=TRUE)
    sumfile <- "test-summary.txt"
    if (debug) cat("ScripDiff: looking for rtIn: '", rtIn, "'\n", sep="")
    if (file.exists(rtIn)) {
        # tests were generated from a .Rt file
        failfile <- paste(rtIn, ".fail", sep="")
        logfile <- paste(rtIn, ".log", sep="")
        ignoreUpToRegExpr <- "> # End of scriptests preamble"
        ignoreAfterRegExpr <- "> # End of scriptests output"
    } else {
        # tests were generated in a pre-existing .R file
        # if there is a corresponding .Rout.save file, use the .Rt.save
        # file that was generated by initializeTests()
        failfile <- paste(commandfile, ".fail", sep="")
        logfile <- paste(commandfile, ".log", sep="")
        ignoreUpToRegExpr <- "Type 'q\\(\\)' to quit R"
        ignoreAfterRegExpr <- NULL
        if (debug) cat("ScripDiff: commands not generated from .Rt file; looking for savefile: '", savefile, "'\n", sep="")
        if (!file.exists(savefile)) {
            cat("ScripDiff: nothing to compare against for '", commandfile, "'\n", sep="")
            return(0L)
        }
    }
    if (!file.exists(rtSave)) {
        msg <- paste("ScripDiff: cannot find saved-test-object file '", rtSave, "' in '", getwd(), "'\n", sep="")
        cat(file=failfile, msg)
        cat(file=stdout(), msg)
        # cat(msg, "\n")
        return(NULL)
    }
    if (!file.exists(outfile)) {
        msg <- paste("ScripDiff: cannot find actual test output file '", outfile, "' in '", getwd(), "'\n", sep="")
        cat(file=failfile, msg)
        cat(file=stdout(), msg)
        # cat(msg, "\n")
        return(NULL)
    }
    # sink(file=stdout())
    if (debug) {
        cat("  * Loading saved transcript object from file \"", rtSave, "\" ...\n", sep="", file=stdout())
    }

    testObjName <- load(file=rtSave, envir=as.environment(-1))
    if (testObjName[1] != "tests")
        tests <- get(testObjName[1])
    if (debug)
        cat("  * Parsing actual test output from file \"", outfile, "\" ...\n", sep="", file=stdout())
    resList <- parseTranscriptFile(outfile, ignoreUpToRegExpr=ignoreUpToRegExpr, ignoreAfterRegExpr=ignoreAfterRegExpr)
    res <- compareTranscriptAndOutput(sub(".Rout", ".Rt", outfile), tests, resList, verbose=TRUE)
    res.summary <- summary(res)
    print(res.summary)
    # sink()
    sink(logfile)
    print(res, details=T)
    print(res.summary)
    sink()
    sink(sumfile, append=TRUE)
    print(res.summary)
    sink()
    return(0L)
}

Try the scriptests package in your browser

Any scripts or data that you put into this service are public.

scriptests documentation built on May 2, 2019, 4:28 p.m.