diff --git a/.gitignore b/.gitignore index b8cfcfdb..9680d90e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ - # Misc files .Rhistory *.Rproj @@ -10,6 +9,9 @@ tests/testthat/Rplots.pdf **/*.rda **/*.csv +# Keep data files in testdata +!/tests/testthat/testdata/*.csv + # build artifacts **/*.tar.gz pkgnet.Rcheck/* diff --git a/DESCRIPTION b/DESCRIPTION index 0682f753..51505ec5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,5 +35,5 @@ License: BSD_3_clause + file LICENSE URL: https://github.com/UptakeOpenSource/pkgnet BugReports: https://github.com/UptakeOpenSource/pkgnet/issues LazyData: TRUE -RoxygenNote: 6.1.0 +RoxygenNote: 6.1.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index a20e08e8..c558b17c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ import(data.table) importFrom(DT,datatable) importFrom(DT,formatRound) importFrom(R6,R6Class) +importFrom(R6,is.R6Class) importFrom(assertthat,assert_that) importFrom(assertthat,is.readable) importFrom(assertthat,is.string) diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index 0024b4e0..7a1378a5 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -5,6 +5,14 @@ #' its other functions, determining useful information such as which function is most #' central to the package. Combined with testing information it can be used as a powerful tool #' to plan testing efforts. +#' +#' R6 classes are supported, with methods treated as functions by the Reporter. +#' R6 methods will be named like \code{$$} +#' , e.g., \code{FunctionReporter$private_methods$extract_nodes}. Note that the +#' class name used will be the \emph{name of the generator object in the package's namespace}, +#' and \emph{not} the \code{classname} attribute of the class, which is not required to be defined +#' or to be the same as the generator object name. +#' #' @section Public Methods: #' \describe{ #' \item{\code{set_package(pkg_name, pkg_path)}}{ @@ -74,11 +82,52 @@ FunctionReporter <- R6::R6Class( }, report_markdown_path = function(){ system.file(file.path("package_report", "package_function_reporter.Rmd"), package = "pkgnet") + }, + pkg_R6_classes = function() { + if (is.null(private$cache$pkg_R6_classes)) { + pkg_env <- private$get_pkg_env() + private$cache$pkg_R6_classes <- Filter( + f = function(x, p = pkg_env){ + R6::is.R6Class(get(x, p)) + } + , x = names(pkg_env) + ) + } + return(private$cache$pkg_R6_classes) + }, + pkg_R6_methods = function() { + if (is.null(private$cache$pkg_R6_methods)){ + private$cache$pkg_R6_methods <- data.table::rbindlist(lapply( + X = self$pkg_R6_classes + , FUN = function(x, p = private$get_pkg_env()) { + .get_R6_class_methods(x, get(x,p)) + } + )) + } + return(private$cache$pkg_R6_methods) + }, + pkg_R6_inheritance = function() { + if (is.null(private$cache$pkg_R6_inheritance)) { + private$cache$pkg_R6_inheritance <- .get_R6_class_inheritance( + self$pkg_R6_classes + , self$pkg_name + , private$get_pkg_env() + ) + } + return(private$cache$pkg_R6_inheritance) } ), private = list( + get_pkg_env = function() { + if (is.null(private$cache$pkg_env)) { + # create a custom environment w/ this package's contents + private$cache$pkg_env <- loadNamespace(self$pkg_name) + } + return(private$cache$pkg_env) + }, + # add coverage to nodes table calculate_test_coverage = function(){ @@ -148,15 +197,16 @@ FunctionReporter <- R6::R6Class( return(invisible(NULL)) }, - extract_nodes = function(){ + extract_nodes = function() { if (is.null(self$pkg_name)) { log_fatal('Must set_package() before extracting nodes.') } - # create a custom environment w/ this package's contents - pkg_env <- loadNamespace(self$pkg_name) + pkg_env <- private$get_pkg_env() - # Filter objects to just functions + ## FUNCTIONS ## + + # Filter objects in package environment to just functions # This will now be a character vector full of function names funs <- Filter( f = function(x, p = pkg_env){is.function(get(x, p))} @@ -164,7 +214,10 @@ FunctionReporter <- R6::R6Class( ) # Create nodes data.table - nodes <- data.table::data.table(node = funs) + nodes <- data.table::data.table( + node = funs + , type = "function" + ) # Figure out which functions are exported # We need the package to be loaded first @@ -176,6 +229,17 @@ FunctionReporter <- R6::R6Class( exported_obj_names <- ls(sprintf("package:%s", self$pkg_name)) nodes[, isExported := node %in% exported_obj_names] + # Check if we have R6 functions + if (length(self$pkg_R6_classes) > 0) { + r6DT <- self$pkg_R6_methods[, .( + node = paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + , type = "R6 method" + , isExported = CLASS_NAME %in% exported_obj_names + )] + + nodes <- data.table::rbindlist(list(nodes, r6DT)) + } + return(nodes) }, @@ -187,12 +251,14 @@ FunctionReporter <- R6::R6Class( log_info(sprintf('Constructing network representation...')) # create a custom environment w/ this package's contents - pkg_env <- loadNamespace(self$pkg_name) + pkg_env <- private$get_pkg_env() + + ### FUNCTIONS ### # Get table of edges between functions # for each function, check if anything else in the package # was called by it - funs <- self$nodes[, node] + funs <- self$nodes[type == "function", node] edgeDT <- data.table::rbindlist( lapply( X = funs @@ -203,6 +269,27 @@ FunctionReporter <- R6::R6Class( , fill = TRUE ) + ### R6 METHODS ### + if (length(self$pkg_R6_classes) > 0) { + edgeDT <- data.table::rbindlist(c( + list(edgeDT) + , mapply( + FUN = .determine_R6_dependencies + , method_name = self$pkg_R6_methods[, METHOD_NAME] + , method_type = self$pkg_R6_methods[, METHOD_TYPE] + , class_name = self$pkg_R6_methods[, CLASS_NAME] + , MoreArgs = list( + methodsDT = self$pkg_R6_methods + , inheritanceDT = self$pkg_R6_inheritance + , pkg_env = private$get_pkg_env() + , pkg_functions = funs + ) + ) + ) + , fill = TRUE + ) + } + # If there are no edges, we still want to return a length-zero # data.table with correct columns if (nrow(edgeDT) == 0) { @@ -267,17 +354,265 @@ FunctionReporter <- R6::R6Class( # [description] parse out a function's body into a character # vector separating the individual symbols .parse_function <- function (x) { - + # If expression x is not an atomic value or symbol (i.e., name of object) or + # an environment pointer then we can break x up into list of components listable <- (!is.atomic(x) && !is.symbol(x) && !is.environment(x)) - if (!is.list(x) && listable) { x <- as.list(x) } if (listable){ + # Filter out atomic values because we don't care about them + x <- Filter(f = Negate(is.atomic), x = x) + + # Parse each listed expression recursively until + # they can't be listed anymore out <- unlist(lapply(x, .parse_function), use.names = FALSE) } else { + + # If not listable, deparse into a character string out <- paste(deparse(x), collapse = "\n") } return(out) } + +# [description] given an R6 class, returns a data.table +# enumerating all of its public, active binding, and private methods +#' @importFrom assertthat assert_that +#' @importFrom R6 is.R6Class +.get_R6_class_methods <- function(className, classGenerator) { + assertthat::assert_that( + assertthat::is.string(className) + , R6::is.R6Class(classGenerator) + ) + + method_types <- c('public_methods', 'active', 'private_methods') + + methodsDT <- data.table::rbindlist(do.call( + c, + lapply(method_types, function(mtype) { + lapply(names(classGenerator[[mtype]]), function(mname) { + list(METHOD_TYPE = mtype, METHOD_NAME = mname) + }) + }) + )) + methodsDT[, CLASS_NAME := className] + + return(methodsDT) +} + +# [description] given a list of R6 class names and the associated package +# environment, return a data.table of their parent classes +#' @importFrom data.table rbindlist +.get_R6_class_inheritance <- function(class_names, pkg_name, pkg_env) { + inheritanceDT <- data.table::rbindlist(lapply( + X = class_names + , FUN = function(x, p = pkg_env) { + parentClassName <- deparse(get(x, p)$inherit) + parentClassGenerator <- get(x, p)$get_inherit() + return(list( + CLASS_NAME = x + , PARENT_NAME = if (!is.null(parentClassGenerator)) { + parentClassName + } else { + NA_character_ + } + , PARENT_IN_PKG = (pkg_name == environmentName(parentClassGenerator$parent_env)) + )) + } + )) +} + +# [description] given an R6 method, parse its body and find all +# dependencies that it calls, returning as a pkgnet edge data.table +#' @importFrom data.table data.table +.determine_R6_dependencies <- function(method_name + , method_type + , class_name + , methodsDT + , inheritanceDT + , pkg_env + , pkg_functions +) { + # Get body of method + mbody <- body(get(class_name, envir = pkg_env)[[method_type]][[method_name]]) + + # Parse into symbols + mbodyDT <- data.table::data.table( + SYMBOL = unique(.parse_R6_expression(mbody)) + ) + + # Match to R6 methods + mbodyDT[grepl('(^self\\$|^private\\$)', SYMBOL) + , MATCH := vapply(X = SYMBOL + , FUN = .match_R6_class_methods + , FUN.VALUE = character(1) + , class_name = class_name + , methodsDT = methodsDT + , inheritanceDT = inheritanceDT + )] + + # Match to R6 superclass methods. This has a different recursion strategy + mbodyDT[grepl('(^super\\$)', SYMBOL) + , MATCH := vapply(X = unlist(strsplit( + SYMBOL, split = "$", fixed = TRUE + ))[[2]] + , FUN = .match_R6_super_methods + , FUN.VALUE = character(1) + , parent_name = inheritanceDT[CLASS_NAME == class_name + , PARENT_NAME] + , methodsDT = methodsDT + , inheritanceDT = inheritanceDT + )] + + # Match to functions in package + mbodyDT[!grepl('(^self\\$|^private\\$)', SYMBOL) + & is.na(MATCH) + & SYMBOL %in% pkg_functions + , MATCH := SYMBOL + ] + + if (nrow(mbodyDT[!is.na(MATCH)]) == 0) { + return(NULL) + } + + # Convention: If B depends on A, then B is the TARGET + # and A is the SOURCE so that it looks like A -> B + # fname calls . So fname depends on . + # So fname is TARGET and are SOURCEs + edgeDT <- data.table::data.table( + SOURCE = unique(mbodyDT[!is.na(MATCH), MATCH]) + , TARGET = paste(class_name, method_type, method_name, sep = "$") + ) + + return(edgeDT) +} + + +# [description] given a symbol name that is an R6 internal reference +# (self$x or private$x), match to a provided data.table of known R6 methods. +# Searches up inheritance tree. +#' @importFrom assertthat assert_that +.match_R6_class_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { + # Check if symbol matches method in this class + splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) + assertthat::assert_that(splitSymbol[1] %in% c('self', 'private')) + if (splitSymbol[1] == "self") { + out <- methodsDT[CLASS_NAME == class_name + & METHOD_TYPE %in% c("public_methods", "active") + & splitSymbol[2] == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + } else if (splitSymbol[1] == "private") { + out <- methodsDT[CLASS_NAME == class_name + & METHOD_TYPE == "private_methods" + & splitSymbol[2] == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + } + + # Above returns character(0) if not matched. Convert to NA_character + if (identical(out, character(0))) { + out <- NA_character_ + } + + # Not not matched, try parent if there is one and it is in package + if (is.na(out) + && inheritanceDT[CLASS_NAME == class_name + , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { + out <- .match_R6_class_methods( + symbol_name + , inheritanceDT[CLASS_NAME == class_name, PARENT_NAME] + , methodsDT + , inheritanceDT + ) + } + + # We should only have at most one match + assertthat::assert_that( + assertthat::is.string(out) + ) + + return(out) +} + + +# [description] given a symbol name that is an internal reference to a superclass +# method (super$), match to a provided data.table of known R6 methods +# by checking searching ancestor classes. We need this as a separate function because +# super$method_name calls don't specify public, private, or active. +# So we have to search all three for a parent class before moving up +# to the next parent class. Luckily, within one class definition you're not allowed +# to name things the same so we should only have one result. +#' @importFrom assertthat assert_that is.string +.match_R6_super_methods <- function(method_name, parent_name, methodsDT, inheritanceDT) { + + out <- methodsDT[CLASS_NAME == parent_name + & method_name == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + + # Above returns character(0) if not matched. Convert to NA_character + if (identical(out, character(0))) { + out <- NA_character_ + } + + # If not matched, try parent if there is one and it is in package + if (is.na(out) + && inheritanceDT[CLASS_NAME == parent_name + , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { + out <- .match_R6_super_methods( + method_name + , inheritanceDT[CLASS_NAME == parent_name, PARENT_NAME] + , methodsDT + , inheritanceDT + ) + } + + # We should only have at most one match + assertthat::assert_that( + assertthat::is.string(out) + ) + + return(out) +} + + +# [description] parses R6 expressions into a character vector of symbols and atomic +# values. Will not break up expressions of form self$foo, private$foo, or super$foo +.parse_R6_expression <- function(x) { + + # If expression x is not an atomic value or symbol (i.e., name of object) or + # an environment pointer then we can break x up into list of components + listable <- (!is.atomic(x) && !is.symbol(x) && !is.environment(x)) + + if (!is.list(x) && listable) { + xList <- as.list(x) + + # Check if expression x is of form self$foo, private$foo, or super$foo + if (identical(xList[[1]], quote(`$`)) + && (identical(xList[[2]], quote(self)) + || identical(xList[[2]], quote(private)) + || identical(xList[[2]], quote(super)) + ) + ) { + listable <- FALSE + } else { + x <- xList + } + } + + if (listable){ + # Filter out atomic values because we don't care about them + x <- Filter(f = Negate(is.atomic), x = x) + + # Parse each listed expression recursively until + # they can't be listed anymore + out <- unlist(lapply(x, .parse_R6_expression), use.names = FALSE) + } else { + # If not listable, deparse into a character string + out <- paste(deparse(x), collapse = "\n") + } + return(out) +} + diff --git a/R/testing_utils.R b/R/testing_utils.R index db52727d..fa541e42 100644 --- a/R/testing_utils.R +++ b/R/testing_utils.R @@ -28,6 +28,7 @@ pkgList <- c( baseballstats = file.path(pkgnetSourcePath, "inst", "baseballstats") , sartre = file.path(pkgnetSourcePath, "inst", "sartre") + , milne = file.path(pkgnetSourcePath, "inst", "milne") , pkgnet = pkgnetSourcePath ) diff --git a/inst/milne/DESCRIPTION b/inst/milne/DESCRIPTION new file mode 100644 index 00000000..a226c2a4 --- /dev/null +++ b/inst/milne/DESCRIPTION @@ -0,0 +1,18 @@ +Package: milne +Type: Package +Title: Now We Are Six +Version: 6.0 +Author: Uptake Data Science +Authors@R: c( + person("Jay", "Qi", email = "jay.qi@uptake.com", role = c("aut", "cre")) + ) +Maintainer: Jay Qi +Description: This package is used to test object-oriented class functionality for the reporters in `pkgnet`. So I think I'll be six now for ever and ever. +Imports: + R6 +Suggests: + covr, + testthat +License: file LICENSE +LazyData: TRUE +RoxygenNote: 6.1.1 diff --git a/inst/milne/LICENSE b/inst/milne/LICENSE new file mode 100644 index 00000000..d73603e3 --- /dev/null +++ b/inst/milne/LICENSE @@ -0,0 +1 @@ +this is a test package diff --git a/inst/milne/NAMESPACE b/inst/milne/NAMESPACE new file mode 100644 index 00000000..50c2834e --- /dev/null +++ b/inst/milne/NAMESPACE @@ -0,0 +1,9 @@ +# Generated by roxygen2: do not edit by hand + +export(Five) +export(Four) +export(One) +export(Six) +export(Three) +export(Two) +importFrom(R6,R6Class) diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R new file mode 100644 index 00000000..1382e842 --- /dev/null +++ b/inst/milne/R/The_End.R @@ -0,0 +1,137 @@ +#' @title Age One +#' @name One +#' @family TheEnd +#' @description Age One +#' @importFrom R6 R6Class +#' @export +One <- R6::R6Class( + classname = "One", + public = list( + initialize = function() { + cat("The End, by A. A. Milne \n") + }, + print_poem = function() { + cat("When I was One, \n", + "I had just begun. \n" + ) + }, + how_old_am_i = function() {private$get_age()} + ), + private = list( + get_age = function() {.classname(self)} + ) +) + +#' @title Age Two +#' @name Two +#' @family TheEnd +#' @description Age Two +#' @importFrom R6 R6Class +#' @export +Two <- R6::R6Class( + classname = "Two", + inherit = One, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Two, \n", + "I was nearly new. \n" + ) + } + ) +) + +#' @title Age Three +#' @name Three +#' @family TheEnd +#' @description Age Three +#' @importFrom R6 R6Class +#' @export +Three <- R6::R6Class( + # R6 classes don't need classname to match generator name + classname = "HardlyThree", + inherit = Two, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Three, \n", + "I was hardly Me. \n" + ) + } + ) +) + +#' @title Age Four +#' @name Four +#' @family TheEnd +#' @description Age Four +#' @importFrom R6 R6Class +#' @export +Four <- R6::R6Class( + # R6 classes don't need classname at all + classname = NULL, + inherit = Three, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Four, \n", + "I was not much more. \n" + ) + } + ) +) + +#' @title Age Five +#' @name Five +#' @family TheEnd +#' @description Age Five +#' @importFrom R6 R6Class +#' @export +Five <- R6::R6Class( + classname = "Five", + inherit = Four, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Five, \n", + "I was just alive. \n" + ) + } + ), + private = list( + ) +) + +#' @title Age Six +#' @name Six +#' @family TheEnd +#' @description Age Six +#' @importFrom R6 R6Class +#' @export +Six <- R6::R6Class( + classname = "Six", + inherit = Five, + public = list( + print_poem = function() { + super$print_poem() + cat("But now I am Six,", + "I'm as clever as clever. \n" + ) + private$print_ending() + } + ), + private = list( + print_ending = function() { + cat("So I think I'll be six now", + "for ever and ever." + ) + } + ) +) + +# [description] internal function +.classname <- function(obj) { + class(obj)[1] +} + + diff --git a/inst/milne/man/Five.Rd b/inst/milne/man/Five.Rd new file mode 100644 index 00000000..c39c415a --- /dev/null +++ b/inst/milne/man/Five.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Five} +\alias{Five} +\title{Age Five} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Five +} +\description{ +Age Five +} +\seealso{ +Other TheEnd: \code{\link{Four}}, \code{\link{One}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Four.Rd b/inst/milne/man/Four.Rd new file mode 100644 index 00000000..d41179bc --- /dev/null +++ b/inst/milne/man/Four.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Four} +\alias{Four} +\title{Age Four} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Four +} +\description{ +Age Four +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{One}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/One.Rd b/inst/milne/man/One.Rd new file mode 100644 index 00000000..8d227d54 --- /dev/null +++ b/inst/milne/man/One.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{One} +\alias{One} +\title{Age One} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +One +} +\description{ +Age One +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Six.Rd b/inst/milne/man/Six.Rd new file mode 100644 index 00000000..5baae338 --- /dev/null +++ b/inst/milne/man/Six.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Six} +\alias{Six} +\title{Age Six} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Six +} +\description{ +Age Six +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Three}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Three.Rd b/inst/milne/man/Three.Rd new file mode 100644 index 00000000..c6a5d574 --- /dev/null +++ b/inst/milne/man/Three.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Three} +\alias{Three} +\title{Age Three} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Three +} +\description{ +Age Three +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Six}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Two.Rd b/inst/milne/man/Two.Rd new file mode 100644 index 00000000..65cafb21 --- /dev/null +++ b/inst/milne/man/Two.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Two} +\alias{Two} +\title{Age Two} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Two +} +\description{ +Age Two +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Six}}, \code{\link{Three}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/tests/testthat.R b/inst/milne/tests/testthat.R new file mode 100644 index 00000000..55e1a2cb --- /dev/null +++ b/inst/milne/tests/testthat.R @@ -0,0 +1,12 @@ +# Note that you would never run this file directly. This is used by tools::testInstallPackages() +# and other packages like covr. +# To actually run the tests, you need to set the working directory then run +# devtools::test('milne') + +# This line ensures that R CMD check can run tests. +# See https://github.com/hadley/testthat/issues/144 +Sys.setenv("R_TESTS" = "") + +library(milne) + +testthat::test_check('milne') diff --git a/inst/milne/tests/testthat/test_The_End.R b/inst/milne/tests/testthat/test_The_End.R new file mode 100644 index 00000000..88a8645b --- /dev/null +++ b/inst/milne/tests/testthat/test_The_End.R @@ -0,0 +1,19 @@ +theEndClasses <- c('One', 'Two', 'Three', 'Four', 'Five', 'Six') + +# Helper function to avoid printing +# http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html +.quiet <- function(x) { + sink(tempfile()) + on.exit(sink()) + invisible(force(x)) +} + +for (thisClass in theEndClasses) { + test_that( + sprintf('%s class can be sucessfully intialized', thisClass) + , expect_true({ + .quiet({myObj <- get(thisClass)$new()}) + R6::is.R6(myObj) + }) + ) +} diff --git a/man/FunctionReporter.Rd b/man/FunctionReporter.Rd index f48c5a7b..45d7d890 100644 --- a/man/FunctionReporter.Rd +++ b/man/FunctionReporter.Rd @@ -13,6 +13,13 @@ This Reporter takes a package and uncovers the structure from its other functions, determining useful information such as which function is most central to the package. Combined with testing information it can be used as a powerful tool to plan testing efforts. + +R6 classes are supported, with methods treated as functions by the Reporter. +R6 methods will be named like \code{$$} +, e.g., \code{FunctionReporter$private_methods$extract_nodes}. Note that the +class name used will be the \emph{name of the generator object in the package's namespace}, +and \emph{not} the \code{classname} attribute of the class, which is not required to be defined +or to be the same as the generator object name. } \section{Public Methods}{ diff --git a/tests/testthat.R b/tests/testthat.R index 81684475..fbe211fa 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -60,7 +60,7 @@ if (Sys.getenv('PKGNET_REBUILD')){ # Uninstall Fake Packages From Test Library if Not Already Uninstalled try( utils::remove.packages( - pkgs = c('baseballstats', 'sartre', 'pkgnet') + pkgs = c('baseballstats', 'sartre', 'milne', 'pkgnet') , lib = Sys.getenv('PKGNET_TEST_LIB') ) ) diff --git a/tests/testthat/teardown_setTestEnv.R b/tests/testthat/teardown_setTestEnv.R index b15aef5f..1892febc 100644 --- a/tests/testthat/teardown_setTestEnv.R +++ b/tests/testthat/teardown_setTestEnv.R @@ -3,7 +3,7 @@ # Uninstall Fake Packages From Test Library if Not Already Uninstalled try( utils::remove.packages( - pkgs = c('baseballstats', 'sartre', 'pkgnet') + pkgs = c('baseballstats', 'sartre', 'milne', 'pkgnet') , lib = Sys.getenv('PKGNET_TEST_LIB') ) ) diff --git a/tests/testthat/test-functional_structure.R b/tests/testthat/test-functional_structure.R index dd37b05f..6e7f44b7 100644 --- a/tests/testthat/test-functional_structure.R +++ b/tests/testthat/test-functional_structure.R @@ -16,64 +16,90 @@ futile.logger::flog.threshold(0) ##### RUN TESTS ##### # Note: Packages 'baseballstats' and 'sartre' are installed by Travis CI before testing -# and uninstalled after testing. If running these tests locallaly. - - test_that('test packages installed alright',{ - expect_true(object = require("baseballstats" - , lib.loc = Sys.getenv('PKGNET_TEST_LIB') - ) - , info = "Fake test package baseballstats is not installed.") - - expect_true(object = require("sartre" - , lib.loc = Sys.getenv('PKGNET_TEST_LIB') - ) - , info = "Fake test package sartre is not installed") - }) - - test_that('FunctionReporter returns graph of functions', { - reporter <- FunctionReporter$new() - reporter$set_package(pkg_name = "baseballstats") - - # Nodes - expect_equivalent(object = sort(reporter$nodes$node) - , expected = sort(as.character(unlist(utils::lsf.str(asNamespace(reporter$pkg_name))))) - , info = "All functions are nodes, even ones without connections.") - - expect_true(object = is.element("node", names(reporter$nodes)) - , info = "Node column created") - - expect_s3_class(object = reporter$nodes - , class = "data.table") - - # Edges - expect_s3_class(object = reporter$edges - , class = "data.table") - - expect_true(object = all(c("TARGET", "SOURCE") %in% names(reporter$edges)) - , info = "TARGET and SCORE fields in edge table at minimum") - - # Plots - expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) - - }) - - test_that('FunctionReporter works on edge case one function', { +# and uninstalled after testing. If running these tests locallaly. + +test_that('test packages installed correctly',{ + + testPkgNames <- c("baseballstats", "sartre", "milne") + + for (thisTestPkg in testPkgNames) { + expect_true( + object = require(thisTestPkg + , lib.loc = Sys.getenv('PKGNET_TEST_LIB') + , character.only = TRUE) + , info = sprintf("Fake test package %s is not installed.", thisTestPkg) + ) + } +}) + +test_that('FunctionReporter returns graph of functions', { + reporter <- FunctionReporter$new() + reporter$set_package(pkg_name = "baseballstats") + + # Nodes + expect_equivalent(object = sort(reporter$nodes$node) + , expected = sort(as.character(unlist(utils::lsf.str(asNamespace(reporter$pkg_name))))) + , info = "All functions are nodes, even ones without connections.") + + expect_true(object = is.element("node", names(reporter$nodes)) + , info = "Node column created") + + expect_s3_class(object = reporter$nodes + , class = "data.table") + + # Edges + expect_s3_class(object = reporter$edges + , class = "data.table") + + expect_true(object = all(c("TARGET", "SOURCE") %in% names(reporter$edges)) + , info = "TARGET and SCORE fields in edge table at minimum") + + # Plots + expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) + +}) + +test_that('FunctionReporter works on edge case one function', { t2 <- FunctionReporter$new() t2$set_package('sartre') - + expect_true( object = (nrow(t2$nodes) == 1) , info = "One row in nodes table." ) - + expect_true( object = (nrow(t2$edges) == 0) , info = "Edges table is empty since there are no edges." ) - + expect_true(object = is.element("visNetwork", attributes(t2$graph_viz))) - - }) + +}) + +test_that('FunctionReporter works with R6 classes', { + reporter <- FunctionReporter$new() + reporter$set_package('milne') + + # Test nodes + expect_equivalent( + object = reporter$nodes + , expected = data.table::fread(file.path('testdata', 'milne_nodes.csv')) + , ignore.col.order = TRUE + , ignore.row.order = TRUE + ) + + # Test edges + expect_equivalent( + object = reporter$edges + , expected = data.table::fread(file.path('testdata', 'milne_edges.csv')) + , ignore.col.order = TRUE + , ignore.row.order = TRUE + ) + + # Test viz + expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) +}) ##### TEST TEAR DOWN ##### diff --git a/tests/testthat/testdata/milne_edges.csv b/tests/testthat/testdata/milne_edges.csv new file mode 100644 index 00000000..c863a9ca --- /dev/null +++ b/tests/testthat/testdata/milne_edges.csv @@ -0,0 +1,9 @@ +SOURCE,TARGET +One$public_methods$print_poem,Two$public_methods$print_poem +Two$public_methods$print_poem,Three$public_methods$print_poem +Three$public_methods$print_poem,Four$public_methods$print_poem +Four$public_methods$print_poem,Five$public_methods$print_poem +One$private_methods$get_age,One$public_methods$how_old_am_i +.classname,One$private_methods$get_age +Five$public_methods$print_poem,Six$public_methods$print_poem +Six$private_methods$print_ending,Six$public_methods$print_poem diff --git a/tests/testthat/testdata/milne_nodes.csv b/tests/testthat/testdata/milne_nodes.csv new file mode 100644 index 00000000..a71106cf --- /dev/null +++ b/tests/testthat/testdata/milne_nodes.csv @@ -0,0 +1,18 @@ +node,type,isExported +.classname,function,FALSE +Two$public_methods$print_poem,R6 method,TRUE +Two$public_methods$clone,R6 method,TRUE +Three$public_methods$print_poem,R6 method,TRUE +Three$public_methods$clone,R6 method,TRUE +Four$public_methods$print_poem,R6 method,TRUE +Four$public_methods$clone,R6 method,TRUE +Five$public_methods$print_poem,R6 method,TRUE +Five$public_methods$clone,R6 method,TRUE +One$public_methods$initialize,R6 method,TRUE +One$public_methods$print_poem,R6 method,TRUE +One$public_methods$how_old_am_i,R6 method,TRUE +One$public_methods$clone,R6 method,TRUE +One$private_methods$get_age,R6 method,TRUE +Six$public_methods$print_poem,R6 method,TRUE +Six$public_methods$clone,R6 method,TRUE +Six$private_methods$print_ending,R6 method,TRUE