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
|
library(testit)
assert('file_ext() and sans_ext() work', {
p = c('abc.doc', 'def123.tex#', 'path/to/foo.Rmd', 'backup.ppt~', 'pkg.tar.xz')
(file_ext(p) %==% c('doc', 'tex#', 'Rmd', 'ppt~', 'tar.xz'))
(sans_ext(p) %==% c('abc', 'def123', 'path/to/foo', 'backup', 'pkg'))
(file_ext(c('foo.bar.gz', 'foo', 'file.nb.html')) %==% c('gz', '', 'nb.html'))
# some special extensions
p = c('abc.c++', 'def.c--', 'ghi.e##', 'jkl.FB2K-COMPONENT', 'mno.WITNESS_CAMPAIGN', 'pqr.H!')
(file_ext(p, '-+!_#') %==% c('c++', 'c--', 'e##', 'FB2K-COMPONENT', 'WITNESS_CAMPAIGN', 'H!'))
# by default, these extensions are not recognized
(file_ext(p) %==% character(length(p)))
})
assert('with_ext() works for corner cases', {
(with_ext(character(), 'abc') %==% character())
(with_ext('abc', character()) %==% 'abc')
(with_ext(NA_character_, 'abc') %==% NA_character_)
(has_error(with_ext('abc', NA_character_)))
(with_ext('abc', c('d', 'e')) %==% c('abc.d', 'abc.e'))
(has_error(with_ext(c('a', 'b'), c('d', 'e', 'f'))))
(with_ext(c('a', 'b'), c('d', 'e')) %==% c('a.d', 'b.e'))
(with_ext(c('a', 'b'), c('d')) %==% c('a.d', 'b.d'))
(with_ext(c('a', 'b', 'c'), c('', '.d', 'e.e')) %==% c('a', 'b.d', 'c.e.e'))
})
assert('same_path() works', {
(is.na(same_path('~/foo', NA_character_)))
(is.na(same_path(NA_character_, '~/foo')))
(same_path('~/foo', file.path(Sys.getenv('HOME'), 'foo')))
(!same_path(tempdir(), 'foo'))
})
assert('normalize_path() works', {
f1 = tempfile()
writeLines('test symlink', f1)
f2 = paste0(f1, '~')
res = file.symlink(f1, f2) # this may fail (on Windows), i.e., res = FALSE
# resolve symlink by default
(!res || basename(normalize_path(f2)) %==% basename(f1))
# do not resolve symlink
(!res || basename(normalize_path(f2, resolve_symlink = FALSE)) %==% basename(f2))
# resolve_symlink = FALSE should work with inputs like . and ..
(normalize_path(c('.', '..'), resolve_symlink = FALSE) %==% normalize_path(c('.', '..')))
})
assert('url_filename() returns the file names in URLs', {
(url_filename('https://yihui.org/images/logo.png') %==% 'logo.png')
(url_filename(c(
'https://yihui.org/index.html',
'https://yihui.org/index.html?foo=bar',
'https://yihui.org/index.html#about'
)) %==% rep('index.html', 3))
})
assert('is_abs_path() recognizes absolute paths on Windows and *nix', {
(!is_abs_path('abc/def'))
(is_abs_path(if (.Platform$OS.type == 'windows') {
c('D:\\abc', '\\\\netdrive\\somewhere')
} else '/abc/def'))
})
assert('del_empty_dir() correctly deletes empty dirs', {
# do nothing is NULL
(del_empty_dir(NULL) %==% NULL)
# remove if empty
dir.create(temp_dir <- tempfile())
del_empty_dir(temp_dir)
(!dir_exists(temp_dir))
# do not remove if not empty
dir.create(temp_dir <- tempfile())
writeLines('test', tempfile(tmpdir = temp_dir))
(del_empty_dir(temp_dir) %==% NULL)
(dir_exists(temp_dir))
unlink(temp_dir, recursive = TRUE)
})
assert('mark_dirs add trailing / when necessary', {
local({
dir.create(tmp_dir <- tempfile())
tmp_dir_slash = paste0(tmp_dir, '/')
file.create(tmp_file <- tempfile(tmpdir = tmp_dir))
(mark_dirs(c(tmp_dir, tmp_file)) %==% c(tmp_dir_slash, tmp_file))
(mark_dirs(c(tmp_dir_slash, tmp_file)) %==% c(tmp_dir_slash, tmp_file))
unlink(tmp_dir, recursive = TRUE)
})
})
assert('relative_path() works', {
(relative_path(c('foo/bar.txt', 'foo/baz.txt'), 'foo/') %==% c('bar.txt', 'baz.txt'))
(relative_path('foo/bar.txt', 'foo') %==% 'bar.txt')
})
assert('proj_root() works', {
# detect .Rproj root
dir.create(tmp_dir <- tempfile())
tmp_dir_slash <- paste0(tmp_dir, '/')
file.create(f1 <- file.path(tmp_dir, 'test.Rproj'))
writeLines(c('Version: 1.2.3', 'test: 321'), f1)
(same_path(proj_root(tmp_dir), tmp_dir) %==% TRUE)
unlink(f1)
# detect package root
file.create(f2 <- file.path(tmp_dir, 'DESCRIPTION'))
writeLines(c('Package: abc', 'test: 321'), f2)
dir.create(tmp_dir_child <- tempfile(tmpdir = tmp_dir))
(same_path(proj_root(tmp_dir_child), tmp_dir) %==% TRUE)
unlink(tmp_dir, recursive = TRUE)
})
assert('file_rename() works', {
# work in temp dir
dir.create(tmp_dir <- tempfile())
owd = setwd(tmp_dir)
# empty dir is not moved but deleted
dir.create('dest')
dir.create('empty')
file_rename('empty', 'dest')
(dir.exists(c('empty', 'dest')) %==% c(FALSE, TRUE))
# files are moved correctly
dir.create('filled')
dummy_files = c('dummy1', 'dummy2')
file.create(file.path('filled', dummy_files))
file_rename('filled', 'dest1')
(dir.exists('filled') %==% FALSE)
(list.files('dest1') %==% dummy_files)
# rename multiple dirs
dir.create('dest2')
file_rename(c('dest1', 'dest2'), c('dest3', 'dest4'))
(dir.exists(sprintf('dest%d', 1:4)) %==% c(FALSE, FALSE, TRUE, TRUE))
# rename files
file_rename(file.path('dest3', dummy_files), dummy_files)
(length(list.files('dest3')) %==% 0L)
(file.exists(dummy_files) %==% c(TRUE, TRUE))
# remove temp dir
setwd(owd)
unlink(tmp_dir, recursive = TRUE)
})
|
