unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 1e426407a1015ac9e5a8c9e6ccb574d82b18a527 4067 bytes (raw)
name: test/lisp/darwin-fns-tests.el 	 # note: path name is non-authoritative(*)

 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
 
;;; darwin-fns-tests.el --- tests for darwin-fns.el  -*- lexical-binding: t -*-

;; Copyright (C) 2021  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 darwin-fns-tests--run-emacs (expr1 expr2)
  "Run Emacs in batch mode and evaluate EXPR1 and EXPR2.
Return (EXIT-STATUS . OUTPUT), where OUTPUT is stderr and stdout."
  (let ((emacs (expand-file-name invocation-name invocation-directory))
        (process-environment nil))
    (with-temp-buffer
      (let ((res (call-process emacs nil t nil
                               "--quick" "--batch"
                               (format "--eval=%S" expr1)
                               (format "--eval=%S" expr2))))
        (cons res (buffer-string))))))

(ert-deftest darwin-fns-sandbox ()
  (skip-unless (eq system-type 'darwin))
  ;; Test file reading and writing under various sandboxing conditions.
  (let* ((some-text "abcdef")
         (new-text "ghijkl")
         (test-file (file-truename (make-temp-file "test")))
         (file-dir (file-name-directory test-file)))
    (unwind-protect
        (dolist (mode '(read write))
          (ert-info ((symbol-name mode) :prefix "mode: ")
            (dolist (sandbox '(allow-all deny-all allow-read))
              (ert-info ((symbol-name sandbox) :prefix "sandbox: ")
                ;; Prepare initial file contents.
                (with-temp-buffer
                  (insert some-text)
                  (write-file test-file))

                (let* ((sandbox-form
                        (pcase-exhaustive sandbox
                          ('allow-all nil)
                          ('deny-all '(darwin-sandbox-enter nil))
                          ('allow-read `(darwin-sandbox-enter '(,file-dir)))))
                       (action-form
                        (pcase-exhaustive mode
                          ('read `(progn (find-file-literally ,test-file)
                                         (message "OK: %s" (buffer-string))))
                          ('write `(with-temp-buffer
                                     (insert ,new-text)
                                     (write-file ,test-file)))))
                       (allowed (or (eq sandbox 'allow-all)
                                    (and (eq sandbox 'allow-read)
                                         (eq mode 'read))))
                       (res-out (darwin-fns-tests--run-emacs
                                 sandbox-form action-form))
                       (exit-status (car res-out))
                       (output (cdr res-out))
                       (file-contents
                        (with-temp-buffer
                          (insert-file-contents-literally test-file)
                          (buffer-string))))
                  (if allowed
                      (should (equal exit-status 0))
                    (should-not (equal exit-status 0)))
                  (when (eq mode 'read)
                    (if allowed
                        (should (equal output (format "OK: %s\n" some-text)))
                      (should-not (string-search some-text output))))
                  (should (equal file-contents
                                 (if (and (eq mode 'write) allowed)
                                     new-text
                                   some-text))))))))

      ;; Clean up.
      (ignore-errors (delete-file test-file)))))


(provide 'darwin-fns-tests)

debug log:

solving 1e426407a1 ...
found 1e426407a1 in https://yhetil.org/emacs-bugs/F61CF0B6-6AB0-415C-BAD4-54273D0DD476@acm.org/

applying [1/1] https://yhetil.org/emacs-bugs/F61CF0B6-6AB0-415C-BAD4-54273D0DD476@acm.org/
diff --git a/test/lisp/darwin-fns-tests.el b/test/lisp/darwin-fns-tests.el
new file mode 100644
index 0000000000..1e426407a1

Checking patch test/lisp/darwin-fns-tests.el...
Applied patch test/lisp/darwin-fns-tests.el cleanly.

index at:
100644 1e426407a1015ac9e5a8c9e6ccb574d82b18a527	test/lisp/darwin-fns-tests.el

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).