[Roxygen-commits] r84 - in pkg: R tests tests/runit
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jul 25 06:23:15 CEST 2008
Author: pcd
Date: 2008-07-25 06:23:14 +0200 (Fri, 25 Jul 2008)
New Revision: 84
Added:
pkg/tests/runit/Rd-example-1.R
pkg/tests/runit/Rd-example-2.R
pkg/tests/runit/runit.Rd.R
pkg/tests/runit/runit.collate.R
Removed:
pkg/tests/runit/runit.all.R
Modified:
pkg/R/Rd.R
pkg/R/parse.R
pkg/R/roclet.R
pkg/tests/runit.R
Log:
parse-text; @examples overrides @example; trim lines pre-lex; roclet parse.parsed; honest per-roclet tests
Modified: pkg/R/Rd.R
===================================================================
--- pkg/R/Rd.R 2008-07-24 18:17:53 UTC (rev 83)
+++ pkg/R/Rd.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -108,7 +108,7 @@
#' @return \code{NULL}
post.parse <- function(partitum) {
parse.arguments()
- parse.examples()
+ parse.examples(partitum)
## sink(NULL)
}
@@ -197,20 +197,33 @@
examples <- NULL
+ #' Parse individual \code{@@example} clauses by adding the
+ #' pointed-to file to a global store.
+ #' @param key ignored
+ #' @param expression the file containing the example(s)
+ #' @return \code{NULL}
parse.example <- function(key, expression)
assign.parent('examples',
append(examples, expression),
environment())
- parse.examples <- function() {
- examples <- Reduce(c, Map(function(file)
- tryCatch(readLines(trim(file)),
- error=function(e) NULL),
- examples),
- NULL)
- if (!is.null(examples))
- cat(Rd.expression('examples',
- do.call(paste, c(as.list(examples), sep='\n'))))
+ #' If \code{@@examples} is provided, use that; otherwise, concatenate
+ #' the files pointed to by each \code{@@example}.
+ #' @param partitum the parsed elements
+ #' @return \code{NULL}
+ parse.examples <- function(partitum) {
+ if (!is.null(partitum$examples))
+ parse.expression('examples', partitum$examples)
+ else {
+ examples <- Reduce(c, Map(function(file)
+ tryCatch(readLines(trim(file)),
+ error=function(e) NULL),
+ examples),
+ NULL)
+ if (!is.null(examples))
+ parse.expression('examples',
+ do.call(paste, c(as.list(examples), sep='\n')))
+ }
}
roclet$register.parser('example', parse.example)
Modified: pkg/R/parse.R
===================================================================
--- pkg/R/parse.R 2008-07-24 18:17:53 UTC (rev 83)
+++ pkg/R/parse.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -183,6 +183,7 @@
'note',
'seealso',
'example',
+ 'examples',
'keywords',
'return',
'author',
@@ -311,11 +312,11 @@
#' @param ref the preref to be parsed
#' @return List containing the parsed preref
parse.ref.preref <- function(ref, ...) {
- lines <- getSrcLines(attributes(ref)$srcfile,
- car(ref),
- caddr(ref))
+ lines <- Map(trim.left, getSrcLines(attributes(ref)$srcfile,
+ car(ref),
+ caddr(ref)))
delimited.lines <-
- Filter(function(line) grep(LINE.DELIMITER, line), lines)
+ Filter(function(line) grep(sprintf('^%s', LINE.DELIMITER), line), lines)
## Trim LINE.DELIMITER + one space (benign for spaceless delimeters).
trimmed.lines <-
Map(function(line) substr(line, nchar(LINE.DELIMITER) + 2, nchar(line)),
@@ -479,3 +480,12 @@
#' @seealso \code{\link{parse.file}}
parse.files <- function(...)
Reduce(append, Map(parse.file, list(...)), NULL)
+
+#' Text-parsing hack using tempfiles for more facility.
+#' @param \dots lines of text to be parsed
+#' @return The parse tree
+parse.text <- function(...) {
+ file <- tempfile()
+ cat(..., sep='\n', file=file)
+ parse.file(file)
+}
Modified: pkg/R/roclet.R
===================================================================
--- pkg/R/roclet.R 2008-07-24 18:17:53 UTC (rev 83)
+++ pkg/R/roclet.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -58,10 +58,14 @@
for (parser in c(...))
roclet$register.default.parser(parser)
+ roclet$parse <- function(...)
+ roclet$parse.parsed(parse.files(...))
+
#' Parse material contained in files.
- #' @param \dots the files to parse
+ #' @param partita the parsed elements
+ #' (from e.g. \code{parse.files})
#' @return \code{NULL}
- roclet$parse <- function(...) {
+ roclet$parse.parsed <- function(partita) {
key.values <- function(partitum)
zip.list(attributes(partitum)$names, partitum)
@@ -75,7 +79,7 @@
do.call(proc, list(...))
maybe.call(pre.files)
- for (partitum in parse.files(...)) {
+ for (partitum in partita) {
maybe.call(pre.parse, partitum)
for (key.value in key.values(partitum)) {
key <- car(key.value)
Added: pkg/tests/runit/Rd-example-1.R
===================================================================
--- pkg/tests/runit/Rd-example-1.R (rev 0)
+++ pkg/tests/runit/Rd-example-1.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -0,0 +1 @@
+example <- 'example1'
Added: pkg/tests/runit/Rd-example-2.R
===================================================================
--- pkg/tests/runit/Rd-example-2.R (rev 0)
+++ pkg/tests/runit/Rd-example-2.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -0,0 +1 @@
+example <- 'example2'
Added: pkg/tests/runit/runit.Rd.R
===================================================================
--- pkg/tests/runit/runit.Rd.R (rev 0)
+++ pkg/tests/runit/runit.Rd.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -0,0 +1,51 @@
+check.Rd.roclet <- Curry(check.roclet,
+ make.roclet=make.Rd.roclet)
+
+check.Rd.output <- Curry(check.output,
+ make.roclet=make.Rd.roclet)
+
+test.example.files <- function()
+ check.Rd.output("#' @example runit/Rd-example-1.R
+ #' @example runit/Rd-example-2.R
+ roxygen()",
+ output=c("\\examples{example <- 'example1'",
+ "example <- 'example2'}"))
+
+test.free.example <- function()
+ check.Rd.output("#' @examples a <- 2
+ roxygen()",
+ output="\\examples{a <- 2}")
+
+test.free.example.overriding.example.file <- function()
+ check.Rd.output("#' @example runit/Rd-example-1.R
+ #' @examples a <- 2
+ roxygen()",
+ output="\\examples{a <- 2}")
+
+test.blank.file <- function()
+ check.Rd.roclet(function(roclet)
+ is.null(roclet$parse.parsed(parse.text(""))))
+
+test.naked.roxygen <- function()
+ check.Rd.roclet(function(roclet)
+ is.null(roclet$parse.parsed(parse.text("roxygen()"))))
+
+test.name.from.assignment <- function()
+ check.Rd.output('a <- 2',
+ output='\\name{a}')
+
+test.name.overriding.assignment <- function()
+ check.Rd.output("#' @name b
+ a <- 2",
+ output='\\name{b}')
+
+test.implicit.usage.from.formals <- function()
+ check.Rd.output("a <- function(a=1) {}",
+ output=c("\\name{a}",
+ "\\usage{a(a=1)}"))
+
+test.explicit.usage <- function()
+ check.Rd.output("#' @usage a(a=2)
+ a <- function(a=1) {}",
+ output=c("\\name{a}",
+ "\\usage{a(a=2)}"))
Deleted: pkg/tests/runit/runit.all.R
===================================================================
--- pkg/tests/runit/runit.all.R 2008-07-24 18:17:53 UTC (rev 83)
+++ pkg/tests/runit/runit.all.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -1,55 +0,0 @@
-test.namespace <- function() {
- roclet <- make.namespace.roclet()
- checkEquals(capture.output(roclet$parse('runit/namespace.R')),
- c('exportClasses(test)',
- 'exportMethods(test)',
- 'export(test)',
- 'exportPattern(test)',
- 'S3method(test)',
- 'import(test)',
- 'importFrom(test)',
- 'importClassesFrom(test)',
- 'importMethodsFrom(test)'))
-}
-
-test.Rd <- function() {
- roclet <- make.Rd.roclet()
- checkEquals(capture.output(roclet$parse('runit/Rd.R')),
- c('\\name{test}',
- '\\usage{test(a=1, b=test)}',
- '\\description{description}',
- '\\details{details}',
- '\\title{test}',
- '\\value{test}',
- '\\references{test}',
- '\\note{test}',
- '\\author{test at example.com}',
- '\\seealso{test}',
- '\\examples{test}',
- '\\concept{test}',
- '\\keyword{test1}',
- '\\keyword{test2}',
- '\\alias{test1}',
- '\\alias{test2}',
- '\\arguments{\\item{p1}{first param}',
- '\\item{p2}{second param}',
- '\\item{p3}{third param}}'))
-}
-
-test.collate <- function() {
- roclet <- make.collate.roclet()
- checkEquals(capture.output(roclet$parse('runit/collate/belt.R',
- 'runit/collate/jacket.R',
- 'runit/collate/pants.R',
- 'runit/collate/shirt.R',
- 'runit/collate/shoes.R',
- 'runit/collate/socks.R',
- 'runit/collate/tie.R',
- 'runit/collate/undershorts.R',
- 'runit/collate/watch.R')),
- paste('Collate: runit/collate/undershorts.R',
- 'runit/collate/pants.R runit/collate/belt.R',
- 'runit/collate/shirt.R runit/collate/tie.R',
- 'runit/collate/jacket.R runit/collate/socks.R',
- 'runit/collate/shoes.R runit/collate/watch.R'))
-}
Added: pkg/tests/runit/runit.collate.R
===================================================================
--- pkg/tests/runit/runit.collate.R (rev 0)
+++ pkg/tests/runit/runit.collate.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -0,0 +1,17 @@
+test.collate <- function() {
+ roclet <- make.collate.roclet()
+ checkEquals(capture.output(roclet$parse('runit/collate/belt.R',
+ 'runit/collate/jacket.R',
+ 'runit/collate/pants.R',
+ 'runit/collate/shirt.R',
+ 'runit/collate/shoes.R',
+ 'runit/collate/socks.R',
+ 'runit/collate/tie.R',
+ 'runit/collate/undershorts.R',
+ 'runit/collate/watch.R')),
+ paste('Collate: runit/collate/undershorts.R',
+ 'runit/collate/pants.R runit/collate/belt.R',
+ 'runit/collate/shirt.R runit/collate/tie.R',
+ 'runit/collate/jacket.R runit/collate/socks.R',
+ 'runit/collate/shoes.R runit/collate/watch.R'))
+}
Modified: pkg/tests/runit.R
===================================================================
--- pkg/tests/runit.R 2008-07-24 18:17:53 UTC (rev 83)
+++ pkg/tests/runit.R 2008-07-25 04:23:14 UTC (rev 84)
@@ -1,3 +1,15 @@
+check.roclet <- function(make.roclet, test) {
+ roclet <- make.roclet()
+ test(roclet)
+}
+
+check.output <- function(..., make.roclet, output)
+ check.roclet(make.roclet,
+ test=function(roclet)
+ checkEquals(capture.output(roclet$parse.parsed
+ (parse.text(...))),
+ output))
+
if (require('RUnit')) {
library(roxygen)
roclets <- defineTestSuite('roclets', 'runit')
More information about the Roxygen-commits
mailing list