blob: bd827e5498ffa3c79356f038d10e8434471eaf58 (
plain)
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
|
;;; unit tests for src/fileio.c -*- lexical-binding: t; -*-
;; Copyright 2017-2019 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(require 'ert)
(defun try-link (target link)
(make-symbolic-link target link)
(let* ((read-link (file-symlink-p link))
(failure (unless (string-equal target read-link)
(list 'string-equal target read-link))))
(delete-file link)
failure))
(defun fileio-tests--symlink-failure ()
(let* ((dir (make-temp-file "fileio" t))
(link (expand-file-name "link" dir)))
(unwind-protect
(let (failure
(char 0))
(while (and (not failure) (< char 127))
(setq char (1+ char))
(when (and (eq system-type 'cygwin) (eq char 92))
(setq char (1+ char)))
(setq failure (try-link (string char) link)))
(or failure
(try-link "/:" link)))
(delete-directory dir t))))
(ert-deftest fileio-tests--odd-symlink-chars ()
"Check that any non-NULL ASCII character can appear in a symlink.
Also check that an encoding error can appear in a symlink."
;; Some Windows versions don't support symlinks, and those which do
;; will pop up UAC elevation prompts, so we disable this test on
;; MS-Windows.
(skip-unless (not (eq system-type 'windows-nt)))
(should (equal nil (fileio-tests--symlink-failure))))
(ert-deftest fileio-tests--directory-file-name ()
(should (equal (directory-file-name "/") "/"))
(should (equal (directory-file-name "//") "//"))
(should (equal (directory-file-name "///") "/"))
(should (equal (directory-file-name "////") "/"))
(should (equal (directory-file-name "/abc") "/abc"))
(should (equal (directory-file-name "/abc/") "/abc"))
(should (equal (directory-file-name "/abc//") "/abc")))
(ert-deftest fileio-tests--directory-file-name-dos-nt ()
"Like fileio-tests--directory-file-name, but for DOS_NT systems."
(skip-unless (memq system-type '(ms-dos windows-nt)))
(should (equal (directory-file-name "d:/") "d:/"))
(should (equal (directory-file-name "d://") "d:/"))
(should (equal (directory-file-name "d:///") "d:/"))
(should (equal (directory-file-name "d:////") "d:/"))
(should (equal (directory-file-name "d:/abc") "d:/abc"))
(should (equal (directory-file-name "d:/abc/") "d:/abc"))
(should (equal (directory-file-name "d:/abc//") "d:/abc")))
(ert-deftest fileio-tests--file-name-as-directory ()
(should (equal (file-name-as-directory "") "./"))
(should (equal (file-name-as-directory "/") "/"))
(should (equal (file-name-as-directory "//") "//"))
(should (equal (file-name-as-directory "///") "///"))
(should (equal (file-name-as-directory "////") "////"))
(should (equal (file-name-as-directory "/abc") "/abc/"))
(should (equal (file-name-as-directory "/abc/") "/abc/"))
(should (equal (file-name-as-directory "/abc//") "/abc//")))
(ert-deftest fileio-tests--file-name-as-directory-dos-nt ()
"Like fileio-tests--file-name-as-directory, but for DOS_NT systems."
(skip-unless (memq system-type '(ms-dos windows-nt)))
(should (equal (file-name-as-directory "d:/") "d:/"))
(should (equal (file-name-as-directory "d:\\") "d:/"))
(should (equal (file-name-as-directory "d://") "d://"))
(should (equal (file-name-as-directory "d:///") "d:///"))
(should (equal (file-name-as-directory "d:////") "d:////"))
(should (equal (file-name-as-directory "d:\\\\\\\\") "d:////"))
(should (equal (file-name-as-directory "d:/abc") "d:/abc/"))
(should (equal (file-name-as-directory "D:\\abc") "d:/abc/"))
(should (equal (file-name-as-directory "d:/abc/") "d:/abc/"))
(should (equal (file-name-as-directory "D:\\abc/") "d:/abc/"))
(should (equal (file-name-as-directory "D:/abc//") "d:/abc//")))
(ert-deftest fileio-tests--relative-HOME ()
"Test that expand-file-name works even when HOME is relative."
(let ((old-home (getenv "HOME")))
(setenv "HOME" "a/b/c")
(should (equal (expand-file-name "~/foo")
(expand-file-name "a/b/c/foo")))
(when (memq system-type '(ms-dos windows-nt))
;; Test expansion of drive-relative file names.
(setenv "HOME" "x:foo")
(should (equal (expand-file-name "~/bar") "x:/foo/bar")))
(setenv "HOME" old-home)))
(ert-deftest fileio-tests--insert-file-interrupt ()
(let ((text "-*- coding: binary -*-\n\xc3\xc3help")
f)
(unwind-protect
(progn
(setq f (make-temp-file "ftifi"))
(write-region text nil f nil 'silent)
(with-temp-buffer
(catch 'toto
(let ((set-auto-coding-function (lambda (&rest _) (throw 'toto nil))))
(insert-file-contents f)))
(goto-char (point-min))
(forward-line 1)
(let ((c1 (char-after)))
(forward-char 1)
(should (equal c1 (char-before)))
(should (equal c1 (char-after))))))
(if f (delete-file f)))))
|
