SCM

SCM Repository

[inlinedocs] Annotation of /pkg/inlinedocs/R/test.R
ViewVC logotype

Annotation of /pkg/inlinedocs/R/test.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 396 - (view) (download)

1 : tdhock 110 test.file <- function
2 :     ### Check an R code file with inlinedocs to see if the
3 :     ### extract.docs.file parser accurately extracts all the code inside!
4 :     ### The code file should contain a variable .result which is the
5 :     ### documentation list that you should get when you apply
6 :     ### extract.docs.file to the file. We check for identity of elements
7 :     ### of elements of the list, so the order of elements should not
8 :     ### matter, and thus this should be a good robust unit test.
9 : tdhock 113 (f,
10 : tdhock 110 ### File name of R code file with inlinedocs to parse and check.
11 : tdhock 113 verbose=TRUE
12 :     ### Show output?
13 : tdhock 110 ){
14 : tomaschwut 367 ##seealso<< \code{\link{save.test.result}}
15 : tdhock 110 e <- new.env()
16 : tdhock 156 suppressWarnings(sys.source(f,e))
17 : tdhock 110 ## these are the items to check for, in no particular order
18 :     .result <- e$.result
19 : tdhock 239 parsers <- e$.parsers
20 :     result <- extract.docs.file(f,parsers)
21 : tdhock 113 for(FUN in names(.result)){
22 :     if(verbose)cat(FUN,"")
23 : tdhock 138 fun <- result[[FUN]]
24 :     .fun <- .result[[FUN]]
25 :     ## first check to make sure all the stored items are there
26 :     for(N in names(.fun)){
27 :     .res <- .fun[[N]]
28 :     res <- fun[[N]]
29 :     if(is.null(res) || is.na(res) || is.na(.res) || .res!=res){
30 : tdhock 307 cat("\n-----\n",res,"\n-----\nin ",FUN,
31 :     "$",N,", expected:\n-----\n",.res,"\n-----\n")
32 :     stop("docs mismatch in ",f)
33 : tdhock 113 }
34 : tdhock 110 }
35 : tdhock 138 ## now check and see if there are no additional items!
36 :     additional <- !names(fun)%in%names(.fun)
37 :     show <- fun[additional] ##ignore NULL extracted items
38 :     show <- show[!sapply(show,is.null)]
39 :     if(length(show)){
40 :     cat("\n")
41 :     print(show)
42 : markus 396 print(result)#mm
43 : tdhock 138 stop("extracted some unexpected docs!")
44 :     }
45 : tdhock 110 }
46 : tdhock 202 ## make sure there are no unexpected outer lists
47 :     not.expected <- names(result)[!names(result)%in%names(.result)]
48 :     if(length(not.expected)){
49 :     print(not.expected)
50 :     stop("extracted some unexpected documentation objects!")
51 :     }
52 : tdhock 156 ## finally make a package using this file and see if it passes
53 : tdhock 275 ## without warnings TDH 27 May 2011 added !interactive() since
54 :     ## recursive calling R CMD check seems to systematically
55 :     ## fail... ERROR: startup.Rs not found. This file is usually copied
56 :     ## to the check directory and read as a .Rprofile, as done in
57 :     ## tools:::.runPackageTests ... is this a bug in R? Anyway for now
58 :     ## let's just not run the R CMD check.
59 :     if(!is.null(e$.dontcheck) || !interactive())return()
60 : tdhock 247 make.package.and.check(f,parsers,verbose)
61 : tdhock 239 if(verbose)cat("\n")
62 :     }
63 :    
64 : tdhock 249 make.package.and.check <- function
65 :     ### Assemble some R code into a package and process it using R CMD
66 :     ### check, stopping with an error if the check resulted in any errors
67 :     ### or warnings.
68 :     (f, ##<< R code file name from which we will make a package
69 :     parsers=default.parsers,
70 :     ### Parsers to use to make the package documentation.
71 :     verbose=TRUE
72 :     ### print the check command line?
73 :     ){
74 : tdhock 274 pkgname <- sub("[.][rR]$","",basename(f))
75 : tdhock 156 pkgdir <- file.path(tempdir(),pkgname)
76 :     if(file.exists(pkgdir))unlink(pkgdir,recursive=TRUE)
77 :     rdir <- file.path(pkgdir,"R")
78 : tdhock 275 if(verbose)print(rdir)
79 : tdhock 156 dir.create(rdir,recursive=TRUE)
80 : tdhock 344 sillydir <- system.file("silly",package="inlinedocs")
81 :     tocopy <- file.path(sillydir,c("DESCRIPTION","NAMESPACE"))
82 :     file.copy(tocopy,pkgdir)
83 : tdhock 156 file.copy(f,rdir)
84 : tdhock 239 package.skeleton.dx(pkgdir,parsers)
85 : tdhock 359 cmd <- sprintf("%s CMD check --as-cran %s",
86 :     file.path(R.home("bin"), "R"),
87 :     pkgdir)
88 : tdhock 156 if(verbose)cat(cmd,"\n")
89 :     checkLines <- system(cmd,intern=TRUE)
90 : tdhock 275 warnLines <- grep("(WARNING|ERROR)",checkLines,value=TRUE)
91 : tdhock 156 if(length(warnLines)>0){
92 :     print(warnLines)
93 : tdhock 275 stop("ERROR/WARNING encountered in package check!")
94 : tdhock 156 }
95 : tdhock 110 }
96 : tdhock 156
97 : tdhock 111 save.test.result <- function
98 :     ### For unit tests, this is an easy way of getting a text
99 :     ### representation of the list result of extract.docs.file.
100 :     (f
101 :     ### R code file with inlinedocs to process with extract.docs.file.
102 :     ){
103 : tdhock 113 .result <- extract.docs.file(f)
104 : tdhock 118 dump(".result",tmp <- tempfile(),control=NULL)
105 :     lines <- readLines(tmp)
106 : tdhock 113 cat(paste(lines,"\n"))
107 : tdhock 111 }

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge