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 203 - (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 :     e <- new.env()
15 : tdhock 156 suppressWarnings(sys.source(f,e))
16 : tdhock 110 ## these are the items to check for, in no particular order
17 :     .result <- e$.result
18 : tdhock 203 result <- extract.docs.file(f,e$.parsers)
19 : tdhock 113 for(FUN in names(.result)){
20 :     if(verbose)cat(FUN,"")
21 : tdhock 138 fun <- result[[FUN]]
22 :     .fun <- .result[[FUN]]
23 :     ## first check to make sure all the stored items are there
24 :     for(N in names(.fun)){
25 :     .res <- .fun[[N]]
26 :     res <- fun[[N]]
27 :     if(is.null(res) || is.na(res) || is.na(.res) || .res!=res){
28 : tdhock 113 stop(f,":\n\n",res,"\nin ",FUN,"$",N,", expected:\n\n",.res,"\n")
29 :     }
30 : tdhock 110 }
31 : tdhock 138 ## now check and see if there are no additional items!
32 :     additional <- !names(fun)%in%names(.fun)
33 :     show <- fun[additional] ##ignore NULL extracted items
34 :     show <- show[!sapply(show,is.null)]
35 :     if(length(show)){
36 :     cat("\n")
37 :     print(show)
38 :     stop("extracted some unexpected docs!")
39 :     }
40 : tdhock 110 }
41 : tdhock 202 ## make sure there are no unexpected outer lists
42 :     not.expected <- names(result)[!names(result)%in%names(.result)]
43 :     if(length(not.expected)){
44 :     print(not.expected)
45 :     stop("extracted some unexpected documentation objects!")
46 :     }
47 : tdhock 156 ## finally make a package using this file and see if it passes
48 :     ## without warnings
49 :     if(!is.null(e$.dontcheck))return()
50 :     pkgname <- sub(".[rR]$","",basename(f))
51 :     pkgdir <- file.path(tempdir(),pkgname)
52 :     if(file.exists(pkgdir))unlink(pkgdir,recursive=TRUE)
53 :     rdir <- file.path(pkgdir,"R")
54 :     dir.create(rdir,recursive=TRUE)
55 :     desc <- file.path(system.file(package="inlinedocs"),"silly","DESCRIPTION")
56 :     file.copy(desc,pkgdir)
57 :     file.copy(f,rdir)
58 :     package.skeleton.dx(pkgdir)
59 :     cmd <- sprintf("%s CMD check %s",file.path(R.home("bin"), "R"),pkgdir)
60 :     if(verbose)cat(cmd,"\n")
61 :     checkLines <- system(cmd,intern=TRUE)
62 :     warnLines <- grep("WARNING",checkLines,value=TRUE)
63 :     if(length(warnLines)>0){
64 :     print(warnLines)
65 :     stop("WARNING encountered in package check!")
66 :     }
67 : tdhock 113 if(verbose)cat("\n")
68 : tdhock 110 }
69 : tdhock 156
70 : tdhock 111 save.test.result <- function
71 :     ### For unit tests, this is an easy way of getting a text
72 :     ### representation of the list result of extract.docs.file.
73 :     (f
74 :     ### R code file with inlinedocs to process with extract.docs.file.
75 :     ){
76 : tdhock 113 .result <- extract.docs.file(f)
77 : tdhock 118 dump(".result",tmp <- tempfile(),control=NULL)
78 :     lines <- readLines(tmp)
79 : tdhock 113 cat(paste(lines,"\n"))
80 : 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