Skip to content

Commit

Permalink
Use a common variable .vc_dir_names for version control directory names.
Browse files Browse the repository at this point in the history 
Add format.check_package_CRAN_incoming(), and use this for print and QC.
Improve test for leftover *.Rcheck directories in package sources, and 
add a similar test for leftover .Rd2dvi* directories.
Add sanity checking for new-style package inst/NEWS.Rd files.

git-svn-id: https://svn.r-project.org/R/trunk@53952 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information
hornik committed Jan 11, 2011
1 parent 7742300 commit 839de42
Show file tree
Hide file tree
Showing 6 changed files with 155 additions and 41 deletions.
2 changes: 2 additions & 0 deletions src/library/tools/NAMESPACE
View file
Expand Up @@ -65,3 +65,5 @@ S3method("toRd", "default")
S3method("toRd", "bibentry")

S3method("as.character", "Rd")

S3method("format", "check_package_CRAN_incoming")
48 changes: 26 additions & 22 deletions src/library/tools/R/QC.R
View file
Expand Up @@ -4521,31 +4521,35 @@ function(dir)

}

format.check_package_CRAN_incoming <-
function(x, ...)
{
c(if(length(y <- x$bad_package))
sprintf("Conflicting package names (submitted: %s, existing: %s)",
y[[1L]], y[[2L]]),
if(length(y <- x$bad_version))
sprintf("Insufficient package version (submitted: %s, existing: %s)",
y[[1L]], y[[2L]]),
if(length(y <- x$new_maintainer))
c("New maintainer:",
strwrap(y[[1L]], indent = 2L, exdent = 4L),
"Old maintainer(s):",
strwrap(y[[2L]], indent = 2L, exdent = 4L)),
if(length(y <- x$bad_license))
sprintf("Non-FOSS package license (%s)", y),
if(length(y <- x$new_license))
c("Change to non-FOSS package license.",
"New license:",
strwrap(y[[1L]], indent = 2L, exdent = 4L),
"Old license:",
strwrap(y[[2L]], indent = 2L, exdent = 4L))
)
}

print.check_package_CRAN_incoming <-
function(x, ...)
{
if(length(y <- x$bad_package))
writeLines(sprintf("Conflicting package names (submitted: %s, existing: %s)",
y[[1L]], y[[2L]]))
if(length(y <- x$bad_version))
writeLines(sprintf("Insufficient package version (submitted: %s, existing: %s)",
y[[1L]], y[[2L]]))
if(length(y <- x$new_maintainer)) {
writeLines(c("New maintainer:",
strwrap(y[[1L]], indent = 2L, exdent = 4L),
"Old maintainer(s):",
strwrap(y[[2L]], indent = 2L, exdent = 4L)))
}
if(length(y <- x$bad_license)) {
writeLines(sprintf("Non-FOSS package license (%s)", y))
}
if(length(y <- x$new_license)) {
writeLines(c("Change to non-FOSS package license.",
"New license:",
strwrap(y[[1L]], indent = 2L, exdent = 4L),
"Old license:",
strwrap(y[[2L]], indent = 2L, exdent = 4L)))
}
writeLines(format(x))
invisible(x)
}

Expand Down
5 changes: 2 additions & 3 deletions src/library/tools/R/build.R
View file
Expand Up @@ -623,10 +623,9 @@ get_exclude_patterns <- function()
ignore.case = WINDOWS)

isdir <- file_test("-d", allfiles)
## Version-control directories
vcdirs <- c("CVS", ".svn", ".arch-ids", ".bzr", ".git", ".hg")
## old (pre-2.10.0) dirnames
exclude <- exclude | (isdir & (bases %in% c("check", "chm", vcdirs)))
exclude <- exclude | (isdir & (bases %in%
c("check", "chm", .vc_dir_names)))
exclude <- exclude | (isdir & grepl("([Oo]ld|\\.Rcheck)$", bases))
## FIXME: GNU make uses GNUmakefile (note capitalization)
exclude <- exclude | bases %in% c("Read-and-delete-me", "GNUMakefile")
Expand Down
103 changes: 90 additions & 13 deletions src/library/tools/R/check.R
View file
Expand Up @@ -491,23 +491,69 @@ R_runR <- function(cmd = NULL, Ropts = "", env = "",
}
}

all_dirs <- .list_dirs(".", full.names = TRUE, recursive = TRUE)

## several packages have had check dirs in the sources, e.g.
## ./languageR/languageR.Rcheck
## ./locfdr/man/locfdr.Rcheck
## ./clustvarsel/inst/doc/clustvarsel.Rcheck
## ./bicreduc/OldFiles/bicreduc.Rcheck
## ./waved/man/waved.Rcheck
## ./waved/..Rcheck
alldirs <- dirname(dir(".", all.files = TRUE, full.names = TRUE))
check_files <- grep("\\.Rcheck$", alldirs, value = TRUE)
if (length(check_files)) {
if (!any) warnLog()
printLog(Log, "Found the following directory(s) with ",
"names of check directories:\n")
printLog(Log, paste(c("", check_files, ""), collapse = "\n"))
printLog(Log, "Most likely, these were included erroneously.\n")
ind <- grepl("\\.Rcheck$", all_dirs)
if(any(ind)) {
if(!any) warnLog()
any <- TRUE
printLog(Log,
"Found the following directory(s) with ",
"names of check directories:\n",
paste(" ", all_dirs[ind], sep = "",
collapse = "\n"),
"\n",
"Most likely, these were included erroneously.\n")
}

## Several packages had leftover Rd2dvi build directories in
## their sources, e.g.
## ./catmap/man/.Rd2dvi
## ./Rdsm/man/.Rd2dvi7366
## ./depmix/man/.Rd2dvi1150
## ./beadarrayMSV/man/.Rd2dvi2933
## ./qgraph/man/.Rd2dvi4352
## ./qgraph/man/.Rd2dvi1532
## ./qgraph/man/.Rd2dvi2032
## ./qgraph/man/.Rd2dvi6032
ind <- grepl("^\\.Rd2dvi", basename(all_dirs))
if(any(ind)) {
if(!any) warnLog()
any <- TRUE
printLog(Log,
"Found the following directory(s) with ",
"names of Rd2dvi build directories:\n",
paste(" ", all_dirs[ind], sep = "",
collapse = "\n"),
"\n",
"Most likely, these were included erroneously.\n")
}

## <FIXME>
## Packages also should not contain version control subdirs
## provided that we check a .tar.gz: is there a way to test for
## this?
## ind <- basename(all_dirs) %in% .vc_dir_names
## if(any(ind)) {
## if(!any) warnLog()
## any <- TRUE
## printLog(Log,
## "Found the following directory(s) with ",
## "names of version control directories:\n",
## paste(" ", all_dirs[ind], sep = "",
## collapse = "\n"),
## "\n",
## "These should not be in a package tarball.\n")
## }
## </FIXME>

if (subdirs != "no") {
Rcmd = "tools:::.check_package_subdirs(\".\")\n";
## We don't run this in the C locale, as we only require
Expand Down Expand Up @@ -594,6 +640,38 @@ R_runR <- function(cmd = NULL, Ropts = "", env = "",
}
}

## Valid NEWS.Rd?
nfile <- file.path("inst", "NEWS.Rd")
if(file.exists(nfile)) {
## Catch all warning and error messages.
## We use the same construction in at least another place,
## so maybe factor out a common utility function
## .try_catch_all_warnings_and_errors
## eventually.
## For testing package NEWS.Rd files, we really need a real
## QC check function eventually ...
.warnings <- NULL
.error <- NULL
withCallingHandlers(tryCatch(tools:::.build_news_db_from_package_NEWS_Rd(nfile),
error = function(e)
.error <<- conditionMessage(e)),
warning = function(e) {
.warnings <<- c(.warnings,
conditionMessage(e))
invokeRestart("muffleWarning")
})
msg <- c(.warnings, .error)
if(length(msg)) {
if(!any) warnLog("Problems with news in inst/NEWS.Rd:")
any <- TRUE
printLog(Log,
paste(" ",
unlist(strsplit(msg, "\n", fixed = TRUE)),
sep = "", collapse = "\n"),
"\n")
}
}

## Valid CITATION metadata?
if (file.exists(file.path("inst", "CITATION"))) {
Rcmd <- "tools:::.check_citation(\"inst/CITATION\")\n"
Expand All @@ -602,7 +680,7 @@ R_runR <- function(cmd = NULL, Ropts = "", env = "",
if(!any) warnLog("Invalid citation information in 'inst/CITATION':")
any <- TRUE
printLog(Log,
paste(" ", out, sep = "", collapse="\n"),
paste(" ", out, sep = "", collapse = "\n"),
"\n")
}
}
Expand Down Expand Up @@ -1890,13 +1968,12 @@ R_runR <- function(cmd = NULL, Ropts = "", env = "",
checkingLog(Log, "CRAN incoming feasibility")
out <- .check_package_CRAN_incoming(pkgdir)
if(length(out)) {
## TODO: work with object directly
res <- utils::capture.output(print(out))
if (any(grepl("Conflicting", res))) {
res <- format(out)
if(length(out$bad_package)) {
errorLog(Log)
printLog(Log, paste(c(res, ""), collapse = "\n"))
do_exit(1L)
} else if (any(grepl("Insufficient", res)))
} else if(length(out$bad_version))
warnLog()
else noteLog(Log)
printLog(Log, paste(c(res, ""), collapse = "\n"))
Expand Down
5 changes: 2 additions & 3 deletions src/library/tools/R/install.R
View file
Expand Up @@ -973,9 +973,8 @@
## <NOTE>
## Remove stuff we should not have installed in the first place.
## When installing from a source directory under version
## control, we should really exclude the subdirs CVS, .svn
## (Subversion), .arch-ids (arch), .git and .hg (mercurial).
for(d in c("CVS", ".svn", ".arch-ids", ".git", ".hg")) {
## control, we should really exclude the version control subdirs.
for(d in .vc_dir_names) {
## FIXME
if (!WINDOWS)
system(paste("find", shQuote(instdir), "-name", d,
Expand Down
33 changes: 33 additions & 0 deletions src/library/tools/R/utils.R
View file
Expand Up @@ -425,6 +425,14 @@ function(file, pdf = FALSE, clean = FALSE, quiet = TRUE,
## comes out? Also, pre-2.12.0 is out weeks before all of BioC 2.7)
## E.g. pre-2.13.0 was out ca Sept 20, BioC 2.8 was ready Nov 17.

### ** .vc_dir_names

## Version control directory names: CVS, .svn (Subversion), .arch-ids
## (arch), .bzr, .git and .hg (mercurial).

.vc_dir_names <-
c("CVS", ".svn", ".arch-ids", ".bzr", ".git", ".hg")

### * Internal utility functions.

### ** %w/o%
Expand Down Expand Up @@ -940,6 +948,31 @@ function(fname, envir, mustMatch = TRUE)
if(mustMatch) res == fname else nzchar(res)
}

### ** .list_dirs

## Should have base::list.dirs eventually ...

.list_dirs <-
function(path = ".", full.names = FALSE, recursive = FALSE)
{
## Always find all directories for now.

## Note that list.files(recursive = TRUE) excludes directories.
files <- list.files(path, all.files = TRUE)
dirs <- files[file_test("-d", file.path(path, files))]
if(recursive)
dirs <- unique(c(dirs,
dirname(list.files(path, all.files = TRUE,
recursive = TRUE))))
## <FIXME>
## What should we do about "." and ".."?
dirs <- dirs %w/o% c(".", "..")
## </FIXME>
if(full.names)
dirs <- file.path(path, dirs)
dirs
}

### ** .load_package_quietly

.load_package_quietly <-
Expand Down

0 comments on commit 839de42

Please sign in to comment.