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

Legend:
Removed from v.138  
changed lines
  Added in v.367

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