[Sciviews-commits] r335 - in pkg/svTools: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Oct 25 11:53:08 CEST 2010
Author: phgrosjean
Date: 2010-10-25 11:53:08 +0200 (Mon, 25 Oct 2010)
New Revision: 335
Added:
pkg/svTools/R/lint.R
pkg/svTools/man/lint.Rd
Removed:
pkg/svTools/R/lintUsage.R
pkg/svTools/man/lintUsage.Rd
Modified:
pkg/svTools/DESCRIPTION
pkg/svTools/NAMESPACE
pkg/svTools/NEWS
pkg/svTools/R/parseError.R
pkg/svTools/R/svTools-internal.R
pkg/svTools/R/tryParse.R
Log:
lintUsage renamed lint
Several bugs corrected, related to lint
Modified: pkg/svTools/DESCRIPTION
===================================================================
--- pkg/svTools/DESCRIPTION 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/DESCRIPTION 2010-10-25 09:53:08 UTC (rev 335)
@@ -6,9 +6,9 @@
Description: Set of tools aimed at wrapping some of the functionalities
of the packages tools, utils and codetools into a nicer format so
that an IDE can use them
-Version: 0.9-0
-Date: 2010-09-26
-Author: Romain Francois
+Version: 0.9-1
+Date: 2010-10-01
+Author: Romain Francois & Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
LazyLoad: yes
Modified: pkg/svTools/NAMESPACE
===================================================================
--- pkg/svTools/NAMESPACE 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/NAMESPACE 2010-10-25 09:53:08 UTC (rev 335)
@@ -10,9 +10,9 @@
completeRoxygen,
completeRoxygenParam,
generateRoxygenTemplate,
+ lint,
lintDescription,
- lintNamespace,
- lintUsage,
+ lintNamespace,
pkgDesc,
pkgInstalled,
pkgLoaded,
Modified: pkg/svTools/NEWS
===================================================================
--- pkg/svTools/NEWS 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/NEWS 2010-10-25 09:53:08 UTC (rev 335)
@@ -1,7 +1,19 @@
= svTools News
-== Change in svTools 0.9-0
+== Changes in svTools 0.9-1
+* Several bugs eliminated in tryParse() and lintUsage().
+
+* lintUsage() renamed lint() for simplicity.
+
+* lint() added to support code linter for Komodo with new 'flat' or 'rjson'
+ output format. The function takes R code as a character string, or the name of
+ a file and it outputs a data.frame, text, or rjson object that contains the
+ error messages.
+
+
+== Changes in svTools 0.9-0
+
* This is a major rewriting of the package. Dependency to operators was
eliminated, and most functions and arguments have changed!
Added: pkg/svTools/R/lint.R
===================================================================
--- pkg/svTools/R/lint.R (rev 0)
+++ pkg/svTools/R/lint.R 2010-10-25 09:53:08 UTC (rev 335)
@@ -0,0 +1,149 @@
+### A function that lints provided code and returns a data.frame, a flat text
+### output or a rjson object (for Komodo)
+lint <- function (file, text = NULL, filename = NULL,
+encoding = getOption("encoding"), type = c("data.frame", "flat", "rjson"),
+sep = "+++")
+{
+ if (missing(file)) {
+ if (is.null(text) || !is.character(text))
+ stop("If you do not provide 'file', you must provide R code in 'text'")
+ ## Place the code in a temporary file
+ f <- tempfile()
+ on.exit(unlink(f))
+ cat(text, sep = "\n", file = f)
+ } else f <- file
+ type <- match.arg(type)
+ ## Run .lint() on this file
+ res <- .lint(f, encoding = encoding)
+ ## Is it something to return?
+ if (nrow(res) == 0) return("") else {
+ ## For type == data.frame, change nothing
+ if (type == "data.frame") return(res)
+ ## I prefer to get warning|error+++(filename)+++line+++col+++message
+ res <- res[, c(5, 1:4)]
+ if (is.null(filename)) {
+ res <- res[, -2] # Eliminate filename
+ } else {
+ ## Replace file by filename
+ res$file <- rep(filename, nrow(res))
+ }
+ if (type == "rjson") {
+ ## Print a rjson object version of the data
+ cat(toRjson(res), sep = "")
+ } else {
+ ## Print a flat version of the results
+ cat(apply(res, 1, paste, collapse = sep), sep = "\n")
+ }
+ return(invisible(res))
+ }
+}
+
+### Wrapper for the checkUsage function in codetools.
+### Romain Francois <francoisromain at free.fr>
+.lint <- function (file, encoding = getOption("encoding"))
+{
+ if (is.character(file) && regexpr('^rwd:', file) > 0)
+ file <- sub('^rwd:', getwd(), file)
+ file <- tools:::file_path_as_absolute(file)
+
+ old.op <- options(encoding = encoding)
+ on.exit(options(old.op))
+
+ resetErrors(file = file)
+
+ ## First parse for errors
+ p.out <- tryParse(file, action = addError, encoding = encoding)
+ if (inherits(p.out, "data.frame")) return(getErrors(file = file))
+ if (length(p.out) == 0) return(emptyError())
+
+ ## Hack to retrieve information from codetools
+ chkres <- new.env()
+ chkres$findings <- NULL
+ report <- function (x)
+ assign("findings", c(chkres$findings, x), envir = chkres)
+
+ addErrorFile <- function (line, msg)
+ addError(line = line, message = gsub("(\\\n|^: )", "", msg),
+ file = file, type = "warning")
+
+ finding <- function (txt, p, i, rx, rx2) {
+ param <- sub(rx, "\\1", txt)
+ param <- gsub("\\.", "\\\\.", param)
+ exprs <- p[[i]][[3]][[3]]
+ srcref <- do.call(rbind, lapply(attr(exprs, "srcref"), as.integer))
+ regex <- sprintf(rx2, param)
+ for (j in 1:length(exprs)) {
+ ## I don't understand this, since retrieve of source code is easier
+ #src <- .as.characterSrcRef(attr(exprs, "srcref")[[j]],
+ # useSource = TRUE, encoding = encoding)
+ #matchingLines <- grep(regex, src)
+ matchingLines <- grep(regex, attr(exprs, "srcref")[[j]])
+ if (length(matchingLines))
+ return(matchingLines + as.integer(srcref[j, 1]) - 1)
+ }
+ }
+
+ findParamChangedByAssign <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: parameter .(.*). changed by assignment\\\n",
+ rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)"))
+
+ findUnusedLocalAssign <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: local variable .(.*). assigned but may not be used\\\n",
+ rx2 = "^[^.a-zA-Z0-9_(,]*%s[[:space:]]*(=|<-|<<-)"))
+
+ findNoGlobalDef <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: no visible global function definition for .(.*).\\\n",
+ rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\("))
+
+ findNoLocalDefAsFun <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: local variable .(.*). used as function with no apparent local function definition\\\n",
+ rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\("))
+
+ findNoBindingGlobalVar <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: no visible binding for global variable .(.*).\\\n",
+ rx2 = "[^.a-zA-Z0-9_]*%s[^.a-zA-Z0-9_]*"))
+
+ findMultipleLocalDef <- function (txt, p, i)
+ return(finding(txt, p, i,
+ rx = "^.*: multiple local function definitions for .(.*). with different formal arguments\\\n",
+ rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)[[:space:]]*function"))
+
+ searchAndReport <- function (regex, fun) {
+ if (length(test.match <- grep(regex, chkres$findings)))
+ for (j in test.match) {
+ out <- fun(chkres$findings[j], p.out, i)
+ if (length(out)) addErrorFile(out, chkres$findings[j])
+ }
+ }
+
+ for (i in 1:length(p.out)) {
+ if (.looksLikeAFunction(p.out[[i]])) {
+ env <- new.env()
+ eval(p.out[[i]], envir = env)
+ fname <- ls(env)
+ if (length(fname) == 1) {
+ chkres$findings <- NULL
+ checkUsage(env[[fname]], report = report, all = TRUE, name = "")
+ #cat(chkres$findings, "\n")
+ if (length(chkres$findings)) {
+ searchAndReport("changed by assignment", findParamChangedByAssign)
+ searchAndReport("assigned but may not be used", findUnusedLocalAssign)
+ searchAndReport("no visible global function definition", findNoGlobalDef)
+ searchAndReport("no apparent local function definition", findNoLocalDefAsFun)
+ searchAndReport("no visible binding for global variable", findNoBindingGlobalVar)
+ searchAndReport("multiple local function definitions", findMultipleLocalDef)
+### TODO: this needs to be improved to deal with nested functions
+# if (length(test.assign <- grep(" may not be used", chkres$findings)))
+# for (j in test.assign)
+# addErrorFile(attr(p.out, "srcref")[[i]][1], chkres$findings[j])
+ }
+ }
+ }
+ }
+ return(getErrors(file = file))
+}
Deleted: pkg/svTools/R/lintUsage.R
===================================================================
--- pkg/svTools/R/lintUsage.R 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/R/lintUsage.R 2010-10-25 09:53:08 UTC (rev 335)
@@ -1,96 +0,0 @@
-### Wrapper for the checkUsage function in codetools.
-### Romain Francois <francoisromain at free.fr>
-lintUsage <- function (file, encoding = getOption("encoding"))
-{
- if (is.character(file) && regexpr('^rwd:', file) > 0)
- file <- sub('^rwd:', getwd(), file)
-
- old.op <- options(encoding = encoding)
- on.exit(options(old.op))
-
- ## First parse for errors
- p.out <- tryParse(file, action = addError, encoding = encoding)
- if (inherits(p.out, "data.frame")) return(getErrors(file = file))
- if (length(p.out) == 0) return(emptyError())
- resetErrors(file = file)
-
- ## Silly hack to retrieve information from codetools
- findings <- NULL
- report <- function (x)
- assign("findings", c(findings, x), envir = environment())
-
- addErrorFile <- function (line, msg)
- addError(line = line, message = gsub("(\\\n|^: )", "", msg),
- file = file, type = "warning")
-
- finding <- function (txt, p, i, rx, rx2) {
- param <- sub(rx, "\\1", txt)
- param <- gsub("\\.", "\\\\.", param)
- exprs <- p[[i]][[3]][[3]]
- srcref <- do.call(rbind, lapply(attr(exprs, "srcref"), as.integer))
- for (j in 1:length(exprs)) {
- src <- .as.characterSrcRef(attr(exprs, "srcref")[[j]],
- useSource = TRUE, encoding = encoding)
- matchingLines <- grep(sprintf(rx2, param), src)
- if (length(matchingLines))
- return(matchingLines + as.integer(srcref[j, 1]) - 1)
- }
- }
-
- findParamChangedByAssign <- function (txt, p, i)
- return(finding(txt, p, i,
- rx = "^.*: parameter .(.*). changed by assignment\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)"))
-
- findUnusedLocalAssign <- function (txt, p, i)
- return(finding(txt, p, i,
- rx = "^.*: local variable .(.*). assigned but may not be used\\\n",
- rx2 = "^[^.a-zA-Z0-9_(,]*%s[[:space:]]*(=|<-|<<-)"))
-
- findNoGlobalDef <- function (txt, p, i)
- return(finding(txt, p, i,
- rx = "^.*: no visible global function definition for .(.*).\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\("))
-
- findNoLocalDefAsFun <- function (txt, p, i)
- return(finding(txt, p, i,
- rx = "^.*: local variable .(.*). used as function with no apparent local function definition\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*\\("))
-
- findMultipleLocalDef <- function (txt, p, i)
- return(finding(txt, p, i,
- rx = "^.*: multiple local function definitions for .(.*). with different formal arguments\\\n",
- rx2 = "[^.a-zA-Z0-9_]*%s[[:space:]]*(=|<-|<<-)[[:space:]]*function"))
-
- searchAndReport <- function (regex, fun) {
- if (length(test.match <- grep(regex, findings)))
- for (j in test.match) {
- out <- fun(findings[j], p.out, i)
- if (length(out)) addErrorFile(out, findings[j])
- }
- }
-
- for (i in 1:length(p.out)) {
- if (.looksLikeAFunction(p.out[[i]])) {
- env <- new.env()
- eval(p.out[[i]], envir = env)
- fname <- ls(env)
- if (length(fname) == 1) {
- findings <- NULL
- checkUsage(env[[fname]], all = TRUE, report = report, name = "")
- if (length(findings)) {
- searchAndReport("changed by assignment", findParamChangedByAssign)
- searchAndReport("assigned but may not be used", findUnusedLocalAssign)
- searchAndReport("no visible global function definition", findNoGlobalDef)
- searchAndReport("no apparent local function definition", findNoLocalDefAsFun)
- searchAndReport("multiple local function definitions", findMultipleLocalDef)
-### TODO: this needs to be improved to deal with nested functions
- if (length(test.assign <- grep(" may not be used", findings)))
- for (j in test.assign)
- addErrorFile(attr(p.out, "srcref")[[i]][1], findings[j])
- }
- }
- }
- }
- return(getErrors(file = file))
-}
Modified: pkg/svTools/R/parseError.R
===================================================================
--- pkg/svTools/R/parseError.R 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/R/parseError.R 2010-10-25 09:53:08 UTC (rev 335)
@@ -22,11 +22,13 @@
line <- try(as.integer(sub(rx, "\\2", msg, perl = TRUE)), silent = TRUE)
if (inherits(line, "try-error")) line <- NA_integer_
column <- try(as.integer(sub(rx, "\\3", msg, perl = TRUE)), silent = TRUE)
- if (inherits(column, "try-error")) {
+ if (inherits(column, "try-error"))
column <- NA_integer_
- } else {
- message <- sub(rx, "\\4", msg, perl = TRUE)
- }
+ ## FIXME: there is a bug here: if we use tabulations, they are converted into
+ ## four spaces somewhere... That means the column number is not correct any more
+ ## For now, we prefer to return column 1 everytime until the bug is fixed!
+ column <- 1
+ message <- sub(rx, "\\4", msg, perl = TRUE)
return(structure(data.frame(file = file, line = line, column = column,
message = message, type = "error", stringsAsFactors = FALSE),
Modified: pkg/svTools/R/svTools-internal.R
===================================================================
--- pkg/svTools/R/svTools-internal.R 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/R/svTools-internal.R 2010-10-25 09:53:08 UTC (rev 335)
@@ -5,8 +5,11 @@
.looksLikeAFunction <- function (p)
{
- if (length(p[[1]]) != 1) return(FALSE)
- if (!as.character(p[[1]]) %in% c("<-", "<<-", "=")) return(FALSE)
+ # Sometimes, p is not subsettable => use try here
+ p1 <- try(p[[1]], silent = TRUE)
+ if (inherits(p1, "try-error")) return(FALSE)
+ if (length(p1) != 1) return(FALSE)
+ if (!as.character(p1) %in% c("<-", "<<-", "=")) return(FALSE)
if (length(p) <= 2) return(FALSE)
if (is.null(p[[3]])) return(FALSE)
if (length(p[[3]]) == 1) return(FALSE)
@@ -17,8 +20,10 @@
.looksLikeAnIf <- function (p)
{
- if(length(p[[1]]) != 1) return(FALSE)
- return(as.character(p[[1]]) == "if")
+ # Sometimes, p is not subsettable => use try here
+ p1 <- try(p[[1]], silent = TRUE)
+ if(length(p1) != 1) return(FALSE)
+ return(as.character(p1) == "if")
}
.getIfSrcRef <- function (p)
Modified: pkg/svTools/R/tryParse.R
===================================================================
--- pkg/svTools/R/tryParse.R 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/R/tryParse.R 2010-10-25 09:53:08 UTC (rev 335)
@@ -10,10 +10,20 @@
filename <- summary(file)$description
}
- out <- try(parse(file), silent = TRUE)
+ ## On Windows, filename could be c:/dir/file.R and the ':' does interfere
+ ## with the mechanism used to retrieve the error by parseError()
+ ## Hence, we prefer to change working dir to the file dir and pass only
+ ## the file basename to parse!
+ dir <- dirname(filename)
+ basefile <- basename(filename)
+ odir <- getwd()
+ setwd(dir)
+ on.exit(setwd(odir), add = TRUE)
+
+ out <- try(parse(file, srcfile = srcfile(basefile)), silent = TRUE)
if (inherits(out, "try-error")) {
err <- parseError(out)
- if (is.na(err$file[1])) err$file <- rep(filename, nrow(err))
+ err$file <- rep(filename, nrow(err))
if (!missing(action)) action(err)
return(invisible(err))
} else return(invisible(out))
Added: pkg/svTools/man/lint.Rd
===================================================================
--- pkg/svTools/man/lint.Rd (rev 0)
+++ pkg/svTools/man/lint.Rd 2010-10-25 09:53:08 UTC (rev 335)
@@ -0,0 +1,38 @@
+\name{lint}
+\alias{lint}
+
+\title{ Look for error in a R code file }
+\description{
+ Simple wrapper to the \code{checkUsage()} function of the codetools package
+ that calls \code{checkUsage()} on all objects contained in a source file.
+}
+\usage{
+lint(file, text = NULL, filename = NULL, encoding = getOption("encoding"),
+ type = c("data.frame", "flat", "rjson"), sep = "+++")
+}
+
+\arguments{
+ \item{file}{ file to check. }
+ \item{text}{ the R source code (as text) to lint; used only if \code{file} is
+ not provided. }
+ \item{filename}{ the filename to flag returned errors. }
+ \item{encoding}{ encoding to assume for the file. }
+ \item{type}{ the type of output to produce. }
+ \item{sep}{ in case of flat output, what is the indicator to use as field
+ separator ? }
+}
+
+\value{
+ A data frame, text output or rjson object of the errors/problems in the file
+ or the R code in 'text' is returned.
+}
+
+\author{ Romain Francois <francoisromain at free.fr> &
+ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link[codetools]{checkUsage}}, \code{\link{lintDescription}},
+ \code{\link{lintNamespace}} }
+
+\keyword{ manip }
+
+\concept{ Code correction (linter) }
Deleted: pkg/svTools/man/lintUsage.Rd
===================================================================
--- pkg/svTools/man/lintUsage.Rd 2010-10-19 14:06:53 UTC (rev 334)
+++ pkg/svTools/man/lintUsage.Rd 2010-10-25 09:53:08 UTC (rev 335)
@@ -1,28 +0,0 @@
-\name{lintUsage}
-\alias{lintUsage}
-
-\title{ Look for error in a R code file }
-\description{
- Simple wrapper to the \code{checkUsage()} function of the codetools package
- that calls \code{checkUsage()} on all objects contained in a source file.
-}
-\usage{
-lintUsage(file, encoding = getOption("encoding"))
-}
-
-\arguments{
- \item{file}{ file to check. }
- \item{encoding}{ encoding to assume for the file. }
-}
-
-\value{
- A data frame of the errors/problems in the file is returned.
-}
-
-\author{ Romain Francois <francoisromain at free.fr> }
-\seealso{ \code{\link[codetools]{checkUsage}}, \code{\link{lintDescription}},
- \code{\link{lintNamespace}} }
-
-\keyword{ manip }
-
-\concept{ Code correction (linter) }
More information about the Sciviews-commits
mailing list