more increase of test coverage for has_ci chaoss metric #11

Author: mpadge

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: githist
 Title: Code analyses traced along the 'git' history of a package
-Version: 0.1.0.048
+Version: 0.1.0.049
 Authors@R: 
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265"))

R/chaoss-metrics-external.R

@@ -28,20 +28,9 @@ cran_downloads <- function (pkg_name, end_date = Sys.Date ()) {
 
 has_gh_ci_tests <- function (path) {
 
-    url <- pkg_gh_url_from_path (path)
-    if (length (url) == 0L) {
-        return (FALSE)
-    }
+    or <- org_repo_from_path (path)
 
-    url_parts <- strsplit (url, "\\/") [[1]]
-    i <- which (url_parts == "github.com")
-    if (length (i) == 0L || i > (length (url_parts) + 2L)) {
-        return (FALSE)
-    }
-    org <- url_parts [i + 1L]
-    repo <- url_parts [i + 2L]
-
-    ci_data <- github_repo_workflow_query (org, repo)
+    ci_data <- github_repo_workflow_query (or [1], or [2])
     h <- gert::git_log (repo = path, max = 1e6)
     any (ci_data$sha %in% h$commit)
 }

R/gh-queries.R

@@ -1,30 +1,3 @@
-github_repo_files_query <- function (org = NULL, repo = NULL) {
-
-    q <- paste0 ("{
-        repository(owner:\"", org, "\", name:\"", repo, "\") {
-            object(expression: \"HEAD:\") {
-                ... on Tree {
-                    entries {
-                        name
-                        type
-                        mode
-                        object {
-                            ... on Commit {
-                                oid
-                                committedDate
-                            }
-                            ... on Blob {
-                                byteSize
-                                isBinary
-                            }
-                        }
-                    }
-                }
-            }
-        }
-    }")
-}
-
 #' Retrieve latest GitHub workflow results from Rest API
 #'
 #' This uses default of 30 most recent results.

R/utils.R

@@ -66,6 +66,24 @@ pkg_gh_url_from_path <- function (path) {
     return (ret)
 }
 
+org_repo_from_path <- function (path) {
+
+    url <- pkg_gh_url_from_path (path)
+    if (length (url) == 0L) {
+        return (FALSE)
+    }
+
+    url_parts <- strsplit (url, "\\/") [[1]]
+    i <- which (url_parts == "github.com")
+    if (length (i) == 0L || i > (length (url_parts) + 2L)) {
+        return (FALSE)
+    }
+    org <- url_parts [i + 1L]
+    repo <- url_parts [i + 2L]
+
+    c (org, repo)
+}
+
 filter_git_hist <- function (h, n, step_days) {
     if (!is.null (n)) {
         h <- h [seq_len (n), ]

codemeta.json

@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci-review-tools/githist",
   "issueTracker": "https://github.com/ropensci-review-tools/githist/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.0.048",
+  "version": "0.1.0.049",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

tests/testthat/test-chaoss-metrics-external.R

@@ -28,4 +28,12 @@ test_that ("chaoss has CI external", {
         "gh_workflow",
         github_repo_workflow_query (org, repo, n = 2L)
     )
+
+    expect_s3_class (ci_data, "data.frame")
+    expect_equal (nrow (ci_data), 2L)
+    expect_equal (ncol (ci_data), 7L)
+    expect_equal (
+        names (ci_data),
+        c ("name", "id", "sha", "title", "status", "conclusion", "created")
+    )
 })

tests/testthat/test-chaoss-metrics-internal.R

@@ -27,11 +27,14 @@ test_that ("chaoss has CI internal", {
     url <- "https://github.com/my/pkg"
     desc <- c (
         readLines (desc_path),
-        paste0 ("URL: ", url),
+        paste0 ("URL: ", url)
     )
     writeLines (desc, desc_path)
 
     expect_identical (url, pkg_gh_url_from_path (path))
 
+    org_repo <- org_repo_from_path (path)
+    expect_identical (org_repo, c ("my", "pkg"))
+
     fs::dir_delete (path)
 })