add regression test for issue #646 and fixup git_remote (#658)

NEWS.md

@@ -1,5 +1,7 @@
 # remotes (development version)
 
+* Fix regex to handle user names in URL in `git_remote`, add regression tests (@achimgaedke, #646).
+
 # remotes 2.4.1
 
 * pkgbuild is no longer accidentally loaded even in standalone mode (#548)

R/install-git.R

@@ -79,10 +79,14 @@ git_remote <- function(url, subdir = NULL, ref = NULL, credentials = git_credent
     stop("`credentials` can only be used with `git = \"git2r\"`", call. = FALSE)
   }
 
-  meta <- re_match(url, "(?<url>(?:git@)?[^@]*)(?:@(?<ref>.*))?")
-  ref <- ref %||% (if (meta$ref == "") NULL else meta$ref)
+   url_parts = re_match( url,
+         "(?<protocol>[^/]*://)?(?<authhost>[^/]+)(?<path>[^@]*)(@(?<ref>.*))?")
 
-  list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](meta$url, subdir, ref, credentials)
+  ref <- ref %||% (if (url_parts$ref == "") NULL else url_parts$ref)
+
+  url = paste0(url_parts$protocol, url_parts$authhost, url_parts$path)
+
+  list(git2r = git_remote_git2r, external = git_remote_xgit)[[git]](url, subdir, ref, credentials)
 }
 
 

tests/testthat/test-install-git.R

@@ -166,11 +166,24 @@ test_that("git_remote returns the url", {
   remote <- git_remote(url)
   expect_equal(remote$url, "[email protected]:cran/falsy.git")
 
-  # works with ref (git protocal)
+  # works with ref (git protocol)
   url <- "[email protected]:cran/falsy.git@master"
   remote <- git_remote(url)
   expect_equal(remote$url, "[email protected]:cran/falsy.git")
   expect_equal(remote$ref, "master")
+
+  url <- "ssh://[email protected]:7999/proj/name.git"
+  remote <- git_remote(url)
+  expect_equal(remote$url, "ssh://[email protected]:7999/proj/name.git")
+
+  url <- "ssh://[email protected]:7999/proj/name.git@fixup/issue"
+  remote <- git_remote(url)
+  expect_equal(remote$url, "ssh://[email protected]:7999/proj/name.git")
+  expect_equal(remote$ref, "fixup/issue")
+
+  url <- "https://[email protected]/someuser/MyProject/_git/MyPackage"
+  remote <- git_remote(url)
+  expect_equal(remote$url, "https://[email protected]/someuser/MyProject/_git/MyPackage")
 })
 
 test_that("remote_package_name.git2r_remote returns the package name if it exists", {