50
50
(require 'vc-hg )
51
51
52
52
(declare-function tramp-find-executable " tramp-sh" )
53
+ (declare-function tramp-get-remote-gid " tramp-sh" )
53
54
(declare-function tramp-get-remote-path " tramp-sh" )
54
55
(declare-function tramp-get-remote-perl " tramp-sh" )
55
56
(declare-function tramp-get-remote-stat " tramp-sh" )
@@ -3113,22 +3114,38 @@ This tests also `access-file', `file-readable-p',
3113
3114
(file-remote-p tmp-name1)
3114
3115
(replace-regexp-in-string
3115
3116
" /" " //" (file-remote-p tmp-name1 'localname ))))
3117
+ ; ; `file-ownership-preserved-p' is implemented only in tramp-sh.el.
3118
+ (test-file-ownership-preserved-p (tramp--test-sh-p))
3116
3119
attr)
3117
3120
(unwind-protect
3118
3121
(progn
3122
+ ; ; A sticky bit could damage the `file-ownership-preserved-p' test.
3123
+ (when
3124
+ (and test-file-ownership-preserved-p
3125
+ (zerop (logand
3126
+ #o1000
3127
+ (file-modes tramp-test-temporary-file-directory))))
3128
+ (write-region " foo" nil tmp-name1)
3129
+ (setq test-file-ownership-preserved-p
3130
+ (= (tramp-compat-file-attribute-group-id
3131
+ (file-attributes tmp-name1))
3132
+ (tramp-get-remote-gid
3133
+ (tramp-dissect-file-name tmp-name1) 'integer )))
3134
+ (delete-file tmp-name1))
3135
+
3119
3136
(should-error
3120
3137
(access-file tmp-name1 " error" )
3121
3138
:type tramp-file-missing)
3122
3139
; ; `file-ownership-preserved-p' should return t for
3123
- ; ; non-existing files. It is implemented only in tramp-sh.el.
3124
- (when (tramp--test-sh-p)
3140
+ ; ; non-existing files.
3141
+ (when test-file-ownership-preserved-p
3125
3142
(should (file-ownership-preserved-p tmp-name1 'group )))
3126
3143
(write-region " foo" nil tmp-name1)
3127
3144
(should (file-exists-p tmp-name1))
3128
3145
(should (file-readable-p tmp-name1))
3129
3146
(should (file-regular-p tmp-name1))
3130
3147
(should-not (access-file tmp-name1 " error" ))
3131
- (when (tramp--test-sh-p)
3148
+ (when test-file-ownership-preserved-p
3132
3149
(should (file-ownership-preserved-p tmp-name1 'group )))
3133
3150
3134
3151
; ; We do not test inodes and device numbers.
@@ -3158,16 +3175,16 @@ This tests also `access-file', `file-readable-p',
3158
3175
(should (stringp (tramp-compat-file-attribute-group-id attr)))
3159
3176
3160
3177
(tramp--test-ignore-make-symbolic-link-error
3161
- (should-error
3162
- (access-file tmp-name2 " error" )
3163
- :type tramp-file-missing)
3164
- (when (tramp--test-sh-p)
3178
+ (should-error
3179
+ (access-file tmp-name2 " error" )
3180
+ :type tramp-file-missing)
3181
+ (when test-file-ownership-preserved-p
3165
3182
(should (file-ownership-preserved-p tmp-name2 'group )))
3166
3183
(make-symbolic-link tmp-name1 tmp-name2)
3167
3184
(should (file-exists-p tmp-name2))
3168
3185
(should (file-symlink-p tmp-name2))
3169
3186
(should-not (access-file tmp-name2 " error" ))
3170
- (when (tramp--test-sh-p)
3187
+ (when test-file-ownership-preserved-p
3171
3188
(should (file-ownership-preserved-p tmp-name2 'group )))
3172
3189
(setq attr (file-attributes tmp-name2))
3173
3190
(should
@@ -3198,15 +3215,15 @@ This tests also `access-file', `file-readable-p',
3198
3215
(tramp-dissect-file-name tmp-name3))))
3199
3216
(delete-file tmp-name2))
3200
3217
3201
- (when (tramp--test-sh-p)
3218
+ (when test-file-ownership-preserved-p
3202
3219
(should (file-ownership-preserved-p tmp-name1 'group )))
3203
3220
(delete-file tmp-name1)
3204
3221
(make-directory tmp-name1)
3205
3222
(should (file-exists-p tmp-name1))
3206
3223
(should (file-readable-p tmp-name1))
3207
3224
(should-not (file-regular-p tmp-name1))
3208
3225
(should-not (access-file tmp-name1 " " ))
3209
- (when (tramp--test-sh-p)
3226
+ (when test-file-ownership-preserved-p
3210
3227
(should (file-ownership-preserved-p tmp-name1 'group )))
3211
3228
(setq attr (file-attributes tmp-name1))
3212
3229
(should (eq (tramp-compat-file-attribute-type attr) t )))
@@ -4357,7 +4374,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4357
4374
(with-no-warnings
4358
4375
(make-process
4359
4376
:name " test5" :buffer (current-buffer )
4360
- :command '(" cat" " /" )
4377
+ :command '(" cat" " /does-not-exist " )
4361
4378
:stderr stderr
4362
4379
:file-handler t )))
4363
4380
(should (processp proc))
@@ -4367,7 +4384,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4367
4384
(delete-process proc)
4368
4385
(with-current-buffer stderr
4369
4386
(should
4370
- (string-match " cat:.* Is a directory" (buffer-string )))))
4387
+ (string-match
4388
+ " cat:.* No such file or directory" (buffer-string )))))
4371
4389
4372
4390
; ; Cleanup.
4373
4391
(ignore-errors (delete-process proc))
@@ -4381,7 +4399,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4381
4399
(with-no-warnings
4382
4400
(make-process
4383
4401
:name " test6" :buffer (current-buffer )
4384
- :command '(" cat" " /" )
4402
+ :command '(" cat" " /does-not-exist " )
4385
4403
:stderr tmpfile
4386
4404
:file-handler t )))
4387
4405
(should (processp proc))
@@ -4392,7 +4410,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4392
4410
(with-temp-buffer
4393
4411
(insert-file-contents tmpfile)
4394
4412
(should
4395
- (string-match " cat:.* Is a directory" (buffer-string )))))
4413
+ (string-match
4414
+ " cat:.* No such file or directory" (buffer-string )))))
4396
4415
4397
4416
; ; Cleanup.
4398
4417
(ignore-errors (delete-process proc))
0 commit comments