Preserve original reference in parse_remote_ref and enhance ref handling in build_pak_remote_ref

Author: e-kotov

R/util_resolve_remote.R

@@ -174,6 +174,8 @@ resolve_remote_pkg <- function(pkg_ref, cache_path = NULL) {
 #' @return List with components: type, user, repo, ref, subdir
 #' @keywords internal
 parse_remote_ref <- function(ref) {
+  original_ref <- ref
+
   # Handle web URLs
   if (grepl("^https?://", ref)) {
     return(parse_remote_url(ref))
@@ -200,7 +202,7 @@ parse_remote_ref <- function(ref) {
       repo = NA_character_,
       ref = NULL,
       subdir = NULL,
-      original = ref
+      original = original_ref
     ))
   }
 
@@ -226,7 +228,7 @@ parse_remote_ref <- function(ref) {
       repo = ref,
       ref = commit_ref,
       subdir = NULL,
-      original = ref
+      original = original_ref
     ))
   }
 
@@ -262,7 +264,7 @@ parse_remote_ref <- function(ref) {
       repo = ref,
       ref = commit_ref,
       subdir = NULL,
-      original = ref
+      original = original_ref
     ))
   }
 
@@ -281,7 +283,7 @@ parse_remote_ref <- function(ref) {
     repo = repo,
     ref = commit_ref,
     subdir = subdir,
-    original = ref
+    original = original_ref
   )
 }
 
@@ -299,33 +301,65 @@ build_pak_remote_ref <- function(parsed) {
       if (!is.null(parsed$subdir)) {
         ref <- paste0(ref, "/", parsed$subdir)
       }
+      if (!is.null(parsed$ref)) {
+        ref <- paste0(ref, "@", parsed$ref)
+      }
       ref
     },
     gitlab = {
       ref <- sprintf("gitlab::%s/%s", parsed$user, parsed$repo)
       if (!is.null(parsed$subdir)) {
         ref <- paste0(ref, "/-/", parsed$subdir)
       }
+      if (!is.null(parsed$ref)) {
+        ref <- paste0(ref, "@", parsed$ref)
+      }
+      ref
+    },
+    bioc = {
+      # bioc:: refs are built from repo and ref to ensure correctness
+      # even if original was missing the prefix.
+      ref <- sprintf("bioc::%s", parsed$repo)
+      if (!is.null(parsed$ref)) {
+        ref <- paste0(ref, "@", parsed$ref)
+      }
       ref
     },
-    bioc = sprintf("bioc::%s", parsed$repo),
-    git = sprintf("git::%s", parsed$original),
+    git = {
+      # For git:: we just use the original untouched string if it has the prefix
+      if (grepl("^git::", parsed$original)) {
+        parsed$original
+      } else {
+        ref <- sprintf("git::%s", parsed$original)
+        if (!is.null(parsed$ref)) {
+          ref <- paste0(ref, "@", parsed$ref)
+        }
+        ref
+      }
+    },
     bitbucket = {
       # Backward compatibility: translate bitbucket:: to git:: URL
       ref <- sprintf("git::https://bitbucket.org/%s/%s.git", parsed$user, parsed$repo)
       if (!is.null(parsed$subdir)) {
         warning("Subdirectories are not supported for Bitbucket legacy references. Using repository root.")
       }
+      if (!is.null(parsed$ref)) {
+        ref <- paste0(ref, "@", parsed$ref)
+      }
       ref
     },
     # Transparent pass-through for other pak types
-    sprintf("%s::%s", parsed$type, parsed$original)
+    if (grepl(paste0("^", parsed$type, "::"), parsed$original)) {
+      parsed$original
+    } else {
+      ref <- sprintf("%s::%s", parsed$type, parsed$original)
+      if (!is.null(parsed$ref)) {
+        ref <- paste0(ref, "@", parsed$ref)
+      }
+      ref
+    }
   )
 
-  if (!is.null(parsed$ref)) {
-    pak_ref <- paste0(pak_ref, "@", parsed$ref)
-  }
-
   pak_ref
 }
 
@@ -413,7 +447,7 @@ parse_remote_url <- function(url) {
     "ci", "build", "perf", "style", "revert",
     "renovate", "dependabot"
   )
-  is_version_tag <- grepl("^v?\\d+(\\Dots+)*([._-][A-Za-z0-9.+-]+)?$", ref_parts[1])
+  is_version_tag <- grepl("^v?\\d+(\\.\\d+)*([._-][A-Za-z0-9.+-]+)?$", ref_parts[1])
 
   if (ref_parts[1] %in% common_branches || is_version_tag) {
     ref <- ref_parts[1]

tests/testthat/test-remote.R

@@ -280,6 +280,9 @@ test_that("parse_remote_url parses GitHub URLs correctly", {
   p <- parse_remote_url("https://github.com/user/repo/tree/v1.2.3/pkg")
   expect_equal(p$ref, "v1.2.3")
   expect_equal(p$subdir, "pkg")
+
+  p <- parse_remote_url("https://github.com/user/repo/tree/v1.2.3.4/pkg")
+  expect_equal(p$ref, "v1.2.3.4")
 })
 
 test_that("parse_remote_url parses GitLab URLs correctly", {
@@ -444,6 +447,18 @@ test_that("parse_remote_url handles generic URLs as git::", {
   expect_equal(p$original, "https://example.com/repo.git")
 })
 
+test_that("parse_remote_ref preserves original reference with prefix and ref", {
+  p <- parse_remote_ref("bioc::Biobase@RELEASE_3_18")
+  expect_equal(p$original, "bioc::Biobase@RELEASE_3_18")
+  expect_equal(remote_display_name(p), "bioc::Biobase@RELEASE_3_18")
+
+  p2 <- parse_remote_ref("github::user/repo@main")
+  expect_equal(p2$original, "github::user/repo@main")
+
+  p3 <- parse_remote_ref("user/repo/subdir@v1.0.0")
+  expect_equal(p3$original, "user/repo/subdir@v1.0.0")
+})
+
 test_that("remote_display_name handles NA users and original refs", {
   p <- list(type = "git", original = "https://example.com/repo", user = NA_character_)
   expect_equal(remote_display_name(p), "https://example.com/repo")

tests/testthat/test-to_txt.R

@@ -361,13 +361,14 @@ test_that(
 
     fake_rdd_extract_code_spy <- function(
       pkg,
-      file,
-      include_tests,
-      include_roxygen,
-      force_fetch,
-      version,
-      cache_path,
-      keep_files
+      file = NULL,
+      include_tests = FALSE,
+      include_roxygen = FALSE,
+      force_fetch = FALSE,
+      version = NULL,
+      cache_path = getOption("rdocdump.cache_path"),
+      keep_files = "none",
+      ...
     ) {
       calls$rdd_force_fetch <- force_fetch
       "CODE"
@@ -428,13 +429,14 @@ test_that(
 
     fake_rdd_extract_code_spy <- function(
       pkg,
-      file,
-      include_tests,
-      include_roxygen,
-      force_fetch,
-      cache_path,
-      version,
-      keep_files
+      file = NULL,
+      include_tests = FALSE,
+      include_roxygen = FALSE,
+      force_fetch = FALSE,
+      version = NULL,
+      cache_path = getOption("rdocdump.cache_path"),
+      keep_files = "none",
+      ...
     ) {
       calls$rdd_force_fetch <- force_fetch
       "CODE"