File: test-utils-github.R

package info (click to toggle)
r-cran-usethis 3.1.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,228 kB
  • sloc: sh: 26; makefile: 17; cpp: 6; ansic: 3
file content (239 lines) | stat: -rw-r--r-- 7,583 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
test_that("parse_github_remotes() works, on named list or named character", {
  urls <- list(
    https      = "https://github.com/OWNER/REPO.git",
    ghe        = "https://github.acme.com/OWNER/REPO.git",
    browser    = "https://github.com/OWNER/REPO",
    ssh1       = "git@github.com:OWNER/REPO.git",
    ssh2       = "ssh://git@github.com/OWNER/REPO.git",
    gitlab1    = "https://gitlab.com/OWNER/REPO.git",
    gitlab2    = "git@gitlab.com:OWNER/REPO.git",
    bitbucket1 = "https://bitbucket.org/OWNER/REPO.git",
    bitbucket2 = "git@bitbucket.org:OWNER/REPO.git"
  )
  parsed <- parse_github_remotes(urls)
  expect_equal(parsed$name, names(urls))
  expect_equal(unique(parsed$repo_owner), "OWNER")
  expect_equal(
    parsed$host,
    c("github.com", "github.acme.com", "github.com", "github.com", "github.com",
      "gitlab.com", "gitlab.com", "bitbucket.org", "bitbucket.org")
  )
  expect_equal(unique(parsed$repo_name), "REPO")
  expect_equal(
    parsed$protocol,
    c("https", "https", "https", "ssh", "ssh", "https", "ssh", "https", "ssh")
  )

  parsed2 <- parse_github_remotes(unlist(urls))
  expect_equal(parsed, parsed2)
})

test_that("parse_github_remotes() works on edge cases", {
  parsed <- parse_github_remotes("https://github.com/HenrikBengtsson/R.rsp")
  expect_equal(parsed$repo_owner, "HenrikBengtsson")
  expect_equal(parsed$repo_name, "R.rsp")
})

test_that("parse_github_remotes() works for length zero input", {
  expect_no_error(
    parsed <- parse_github_remotes(character())
  )
  expect_equal(nrow(parsed), 0)
  expect_setequal(
    names(parsed),
    c("name", "url", "host", "repo_owner", "repo_name", "protocol")
  )
})

test_that("parse_repo_url() passes a naked repo spec through", {
  out <- parse_repo_url("OWNER/REPO")
  expect_equal(
    out,
    list(repo_spec = "OWNER/REPO", host = NULL)
  )
})

test_that("parse_repo_url() handles GitHub remote URLs", {
  urls <- list(
    https      = "https://github.com/OWNER/REPO.git",
    ghe        = "https://github.acme.com/OWNER/REPO.git",
    browser    = "https://github.com/OWNER/REPO",
    ssh        = "git@github.com:OWNER/REPO.git"
  )
  out <- map(urls, parse_repo_url)
  expect_match(map_chr(out, "repo_spec"), "OWNER/REPO", fixed = TRUE)
  out_host <- map_chr(out, "host")
  expect_match(
    out_host[c("https", "browser", "ssh")],
    "https://github.com",
    fixed = TRUE
  )
  expect_equal(out_host[["ghe"]], "https://github.acme.com")
})

test_that("parse_repo_url() errors for non-GitHub remote URLs", {
  urls <- list(
    gitlab1    = "https://gitlab.com/OWNER/REPO.git",
    gitlab2    = "git@gitlab.com:OWNER/REPO.git",
    bitbucket1 = "https://bitbucket.org/OWNER/REPO.git",
    bitbucket2 = "git@bitbucket.org:OWNER/REPO.git"
  )
  safely_parse_repo_url <- purrr::safely(parse_repo_url)
  out <- map(urls, safely_parse_repo_url)
  out_result <- map(out, "result")
  expect_true(all(map_lgl(out_result, is.null)))
})

test_that("github_remote_list() works", {
  local_interactive(FALSE)
  create_local_project()
  use_git()
  use_git_remote("origin", "https://github.com/OWNER/REPO.git")
  use_git_remote("upstream", "https://github.com/THEM/REPO.git")
  use_git_remote("foofy", "https://github.com/OTHERS/REPO.git")
  use_git_remote("gitlab", "https://gitlab.com/OTHERS/REPO.git")
  use_git_remote("bitbucket", "git@bitbucket.org:OWNER/REPO.git")

  grl <- github_remote_list()
  expect_setequal(grl$remote, c("origin", "upstream"))
  expect_setequal(grl$repo_spec, c("OWNER/REPO", "THEM/REPO"))

  grl <- github_remote_list(c("upstream", "foofy"))
  expect_setequal(grl$remote, c("upstream", "foofy"))
  nms <- names(grl)

  grl <- github_remote_list(c("gitlab", "bitbucket"))
  expect_equal(nrow(grl), 0)
  expect_named(grl, nms)
})

test_that("github_remotes(), github_remote_list() accept explicit 0-row input", {
  x <- data.frame(name = character(), url = character(), stringsAsFactors = FALSE)
  grl <- github_remote_list(x = x)
  expect_equal(nrow(grl), 0)
  expect_true(all(map_lgl(grl, is.character)))

  gr <- github_remotes(x = x)
  expect_equal(nrow(grl), 0)
})

test_that("github_remotes() works", {
  skip_if_offline("github.com")
  skip_if_no_git_user()

  create_local_project()
  use_git()

  # no git remotes = 0-row edge case
  expect_no_error(
    grl <- github_remotes()
  )

  # a public remote = no token necessary to get github info
  use_git_remote("origin", "https://github.com/r-lib/usethis.git")
  expect_no_error(
    grl <- github_remotes()
  )
  expect_false(grl$is_fork)
  expect_true(is.na(grl$parent_repo_owner))

  # no git remote by this name = 0-row edge case
  expect_no_error(
    grl <- github_remotes("foofy")
  )

  # gh::gh() call should fail, so we should get no info from github
  use_git_remote("origin", "https://github.com/r-lib/DOESNOTEXIST.git", overwrite = TRUE)
  expect_no_error(
    grl <- github_remotes()
  )
  expect_true(is.na(grl$is_fork))
})

test_that("github_url_from_git_remotes() is idempotent", {
  url <- "https://github.com/r-lib/usethis.git"
  out <- github_url_from_git_remotes(url)
  expect_equal(out, github_url_from_git_remotes(out))
})

# GitHub remote configuration --------------------------------------------------

test_that("we understand the list of all possible configs", {
  expect_snapshot(all_configs())
})

test_that("'no_github' is reported correctly", {
 expect_snapshot(new_no_github())
})

test_that("'ours' is reported correctly", {
 expect_snapshot(new_ours())
})

test_that("'theirs' is reported correctly", {
 expect_snapshot(new_theirs())
})

test_that("'fork' is reported correctly", {
 expect_snapshot(new_fork())
})

test_that("'maybe_ours_or_theirs' is reported correctly", {
 expect_snapshot(new_maybe_ours_or_theirs())
})

test_that("'maybe_fork' is reported correctly", {
 expect_snapshot(new_maybe_fork())
})

test_that("'fork_cannot_push_origin' is reported correctly", {
 expect_snapshot(new_fork_cannot_push_origin())
})

test_that("'fork_upstream_is_not_origin_parent' is reported correctly", {
 expect_snapshot(new_fork_upstream_is_not_origin_parent())
})

test_that("'upstream_but_origin_is_not_fork' is reported correctly", {
 expect_snapshot(new_upstream_but_origin_is_not_fork())
})

test_that("'fork_upstream_is_not_origin_parent' is detected correctly", {
  # inspired by something that actually happened:
  # 1. r-pkgs/gh is created
  # 2. user forks and clones: origin = USER/gh, upstream = r-pkgs/gh
  # 3. parent repo becomes r-lib/gh, due to transfer or ownership or owner
  #    name change
  # Now upstream looks like it does not point to fork parent.
  local_interactive(FALSE)
  create_local_project()
  use_git()
  use_git_remote("origin", "https://github.com/jennybc/gh.git")
  use_git_remote("upstream", "https://github.com/r-pkgs/gh.git")
  gr <- github_remotes(github_get = FALSE)
  gr$github_got <- TRUE
  gr$is_fork <- c(TRUE, FALSE)
  gr$can_push <- TRUE
  gr$perm_known <- TRUE
  gr$parent_repo_owner <- c("r-lib", NA)
  gr$parent_repo_name <- c("gh", NA)
  gr$parent_repo_spec <- c("r-lib/gh", NA)
  local_mocked_bindings(github_remotes = function(...) gr)
  cfg <- github_remote_config()
  expect_equal(cfg$type, "fork_upstream_is_not_origin_parent")
  expect_snapshot(error = TRUE, stop_bad_github_remote_config(cfg))
})

test_that("bad github config error", {
  expect_snapshot(
    error = TRUE,
    stop_bad_github_remote_config(new_fork_upstream_is_not_origin_parent())
  )
})

test_that("maybe bad github config error", {
  expect_snapshot(
    error = TRUE,
    stop_maybe_github_remote_config(new_maybe_fork())
  )
})