Core Function Changes to Accommodate Empty Lists in Recursion, Covr B…

…ehavior on Windows & Vignette Path Warnings (#322)

.github/workflows/release.yml

@@ -79,7 +79,7 @@ jobs:
         with:
           fetch-depth: 1
       - name: If local, apt update
-        if: ${ (env.ACT || false)}
+        if: ${{ (env.ACT || false)}}
         run: sudo apt update
       - name: Install Tidy Ubuntu
         run: sudo apt install -y tidy

NEWS.md

@@ -5,8 +5,11 @@
 
 ## CHANGES
 * Updated `pkgnet-intro` vignette to include information on the Class Inheritance Reporter and other minor edits. 
+* Recursive functions `.parse_function` and `.parse_R6_expression` made tolerant to control statemets like `break` or `next` that would break the recursion. (#322)
+* Excessive warnings removed for custom `vignette_path` param in `CreatePackageVignette()` (#322)
 
 ## BUGFIXES
+* `CreatePackageReporter()` failing on Windows to build package coverage when `report_path` specified. (#322) 
 
 # pkgnet 0.4.2
 ## NEW FEATURES

R/CreatePackageVignette.R

@@ -85,42 +85,6 @@ CreatePackageVignette <- function(pkg = "."
                           , dirname(vignette_path)))
     }
 
-    # Check if vignette_path matches the right package
-    # if the path is to a file in a directory named vignettes
-    vignetteDirAbsPath <- normalizePath(dirname(vignette_path))
-    # If path is a vignettes directory
-    if (grepl('/vignettes$', vignetteDirAbsPath)) {
-        # Get path for expected DESCRIPTION file for package
-        expectedDescriptionPath <- gsub(
-            pattern = "vignettes$"
-            , replacement = "DESCRIPTION"
-            , x = vignetteDirAbsPath
-            )
-
-        # If DESCRIPTION file exists check the name
-        if (file.exists(expectedDescriptionPath)) {
-            foundPkgName <- read.dcf(expectedDescriptionPath)[1,][["Package"]]
-
-            # If it doesn't match pkg_name, give warning
-            if (!identical(foundPkgName, pkg_name)) {
-                log_warn(glue::glue(
-                    "You are writing a report for {pkg_name} to the vignettes "
-                    , "directory for {foundPkgName}"
-                    , pkg_name = pkg_name
-                    , foundPkgName = foundPkgName))
-            }
-
-        # Otherwise, warn that we're writing to a vignettes folder inside
-        # a directory that is not a package root
-        } else {
-            log_warn(paste(
-                "You specified a path to a vignettes directory"
-                , vignetteDirAbsPath
-                , "that is not inside a package root directory."
-            ))
-        }
-    }
-
     log_info(sprintf(
         "Creating pkgnet package report as vignette for %s..."
         , pkg_name

R/FunctionReporter.R

@@ -151,12 +151,22 @@ FunctionReporter <- R6::R6Class(
 
             log_info(sprintf("Calculating test coverage for %s...", self$pkg_name))
 
+            # workaround for covr conflict with loaded packages on windows
+            if(.Platform$OS.type == "windows") {
+                detach(paste0('package:',self$pkg_name), unload = TRUE, character.only = TRUE)
+            }
+
             pkgCovDT <- data.table::as.data.table(covr::package_coverage(
                 path = private$pkg_path
                 , type = "tests"
                 , combine_types = FALSE
             ))
 
+            # workaround for covr conflict with loaded packages on windows
+            if(.Platform$OS.type == "windows") {
+                attachNamespace(self$pkg_name)
+            }
+
             pkgCovDT <- pkgCovDT[, .(coveredLines = sum(value > 0)
                                     , totalLines = .N
                                     , coverageRatio = sum(value > 0)/.N
@@ -395,12 +405,17 @@ FunctionReporter <- R6::R6Class(
     if (!is.list(x) && listable) {
         x <- as.list(x)
 
-        # Check for expression of the form foo$bar
-        # We still want to split it up because foo might be a function
-        # but we want to get rid of bar, because it's a symbol in foo's namespace
-        # and not a symbol that could be reliably matched to the package namespace
-        if (identical(x[[1]], quote(`$`))) {
-            x <- x[1:2]
+        if (length(x) > 0){
+            # Check for expression of the form foo$bar
+            # We still want to split it up because foo might be a function
+            # but we want to get rid of bar, because it's a symbol in foo's namespace
+            # and not a symbol that could be reliably matched to the package namespace
+            if (identical(x[[1]], quote(`$`))) {
+                x <- x[1:2]
+            }
+        } else {
+            # make empty lists "not listable" so recursion stops
+            listable <- FALSE 
         }
     }
 
@@ -640,35 +655,38 @@ FunctionReporter <- R6::R6Class(
     # an environment pointer then we can break x up into list of components
     listable <- (!is.atomic(x) && !is.symbol(x) && !is.environment(x))
 
+    # If it is not a list but listable...
     if (!is.list(x) && listable) {
+        # Convert to list
         xList <- as.list(x)
-
-        # Check if expression x is from _$_
-        if (identical(xList[[1]], quote(`$`))) {
-
-            # Check if expression x is of form self$foo, private$foo, or super$foo
-            # We want to keep those together because they could refer to the class'
-            # methods. So expression is not listable
-            if (identical(xList[[2]], quote(self))
-                || identical(xList[[2]], quote(private))
-                || identical(xList[[2]], quote(super))) {
-                listable <- FALSE
-
-            # If expression lefthand side is not keyword, we still want to split
-            # it up because left might be a function
-            # but we want to get rid of right, because it's a symbol in left's namespace
-            # and not a symbol that could be reliably matched to the package namespace
+        if (length(xList) > 0){
+            # Check if expression x is from _$_
+            if (identical(xList[[1]], quote(`$`))) {
+                # Check if expression x is of form self$foo, private$foo, or super$foo
+                if (identical(xList[[2]], quote(self)) || identical(xList[[2]], quote(private)) || identical(xList[[2]], quote(super))) {
+                    # We want to keep those together because they could refer to the class'
+                    # methods. So expression is not listable
+                    listable <- FALSE
+                } else {
+                    # If expression lefthand side is not keyword, we still want to split
+                    # it up because left might be a function
+                    # but we want to get rid of right, because it's a symbol in left's namespace
+                    # and not a symbol that could be reliably matched to the package namespace
+                    x <- xList[1:2]
+                }
             } else {
+                # Left Hand is not a _$_.  Proceed as normal list.
                 x <- xList
-                x <- x[1:2]
             }
-
-        # Otherwise list as usual
         } else {
-            x <- xList
-        }
+            # List is zero length.  This might occur when encountering a "break" command.
+            # Make empty list "non-listable" so recursion stops in following step.
+            listable <- FALSE
+        }   
     }
 
+
+
     if (listable){
         # Filter out atomic values because we don't care about them
         x <- Filter(f = Negate(is.atomic), x = x)

R/testing_utils.R

@@ -65,6 +65,7 @@
         , sartre = file.path(pkgnetSourcePath, testPkgSourceDir, "sartre")
         , milne = file.path(pkgnetSourcePath, testPkgSourceDir, "milne")
         , silverstein = file.path(pkgnetSourcePath, testPkgSourceDir, "silverstein")
+        , control = file.path(pkgnetSourcePath, testPkgSourceDir, "control")
         , pkgnet = pkgnetSourcePath
     )
 

inst/control/DESCRIPTION

@@ -0,0 +1,12 @@
+Package: control
+Type: Package
+Title: Have self control, don't break!
+Version: 0.1
+Author: Brian Burns
+Maintainer: Brian Burns <[email protected]>
+Description: This package is used to test that functions in pkgnet don't break on control statements.
+Imports:
+    R6
+License: file LICENSE
+LazyData: TRUE
+RoxygenNote: 7.3.1

inst/control/LICENSE

@@ -0,0 +1 @@
+this is a test package

inst/control/NAMESPACE

@@ -0,0 +1,5 @@
+# Generated by roxygen2: do not edit by hand
+
+export(next_up)
+export(take_a_break)
+export(testClass)

inst/control/R/self_control.R

@@ -0,0 +1,23 @@
+#' @title Take a Break
+#' @name take_a_break
+#' @description Test if .parse_function() breaks with control function 'break'
+#' @export
+take_a_break <- function() {
+    for (i in 1:10){
+        if (i==5){
+            break
+            }
+        }
+    }
+
+#' @title Next Up
+#' @name next_up
+#' @description Test if .parse_function() breaks with control function 'next'
+#' @export
+next_up <- function() {
+    for (i in 1:10){
+        if (i==5){
+            next
+            }
+        }
+    }

inst/control/R/self_control_R6.R

@@ -0,0 +1,29 @@
+#' Test Class for Control Statements
+#' 
+#' @description A Test Class for Control Statements handling in R6
+#' @export 
+testClass <- R6::R6Class(
+    classname = "testClass",
+    public = list(
+        #' @description
+        #' Test if .parse_R6_expression () breaks with control function 'break'
+        #' @return Nothing
+        take_a_break = function() {
+            for (i in 1:10){
+                if (i==5){
+                    break
+                    }
+                }
+            },
+        #' @description
+        #' Test if .parse_R6_expression () breaks with control function 'next'
+        #' @return Nothing
+        next_up = function() {
+            for (i in 1:10){
+                if (i==5){
+                    next
+                    }
+                }
+            }
+    )
+)

inst/package_report/package_vignette_template.Rmd

@@ -4,7 +4,7 @@ output:
     rmarkdown::html_vignette:
         toc: true
 vignette: >
-    %\VignetteIndexEntry{Package Report, by pkgnet}
+    %\VignetteIndexEntry{ {{pkg_name}} Package Report, by pkgnet }
     %\VignetteEngine{knitr::rmarkdown}
     %\VignetteEncoding{UTF-8}
 ---

tests/testthat/test-0-test-package-installation.R

@@ -3,7 +3,7 @@
 # correctly and being available.
 
 test_that('Test packages installed correctly',{
-    testPkgNames <- c("baseballstats", "sartre", "milne", "silverstein")
+    testPkgNames <- c("baseballstats", "sartre", "milne", "silverstein","control")
     for (thisTestPkg in testPkgNames) {
         expect_true(
             object = require(thisTestPkg

tests/testthat/test-CreatePackageReport.R

@@ -132,6 +132,40 @@ test_that("CreatePackageReport respects report_path when explicitly given", {
     expect_true(any(grepl("Dependency Network", readLines(testing_file))))
 })
 
+test_that("Test that CreatePackageReport runs with control statements", {
+
+    testReportPath <- tempfile(
+        pattern = "control"
+        , fileext = ".html"
+    )
+
+    createdReport <- CreatePackageReport(
+        pkg_name = "control"
+        , report_path = testReportPath
+    )
+
+    testthat::expect_true({
+        reporters <- grep("Reporter$", names(createdReport), value = TRUE)
+        all(vapply(
+            X = reporters
+            , FUN = function(x) {
+                is.null(createdReport[[x]]) | inherits(createdReport[[x]], "AbstractPackageReporter")
+            }
+            , FUN.VALUE = logical(1)
+        ))
+    })
+    testthat::expect_true(file.exists(testReportPath) && file.size(testReportPath) > 0)
+    testthat::expect_true(inherits(createdReport, "PackageReport"))
+    testthat::expect_true(
+        all(
+            vapply(DefaultReporters(), function(x){class(x)[1]}, FUN.VALUE = character(1))
+                %in% names(createdReport)
+        )
+        , info = "Returned report object doesn't have reporters accessible")
+    file.remove(testReportPath)
+})
+
+
 ##### TEST TEAR DOWN #####
 
 Sys.unsetenv("PKGNET_SUPPRESS_BROWSER")