SCM

SCM Repository

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

Diff of /pkg/inlinedocs/R/test.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.111  
changed lines
  Added in v.307

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