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
| | ;;; pdumper-tests.el --- pdumper tests -*- lexical-binding: t; -*-
;; Copyright (C) 2022 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/>.
;;; Code:
(require 'ert-x)
(defun pdumper-tests--readable-arg (form)
(let ((print-gensym t)
(print-circle t)
(print-length nil)
(print-level nil)
(print-escape-control-characters t)
(print-escape-newlines t)
(print-escape-multibyte t)
(print-escape-nonascii t))
(if-let ((str (readablep form)))
str
(error "unreadable form %S" form))))
(defun pdumper-tests--eval-arg (form)
(concat "--eval=" (pdumper-tests--readable-arg form)))
(defun pdumper-tests--batch-eval-command (emacs form)
`(,@emacs "--quick" "--batch"
,(pdumper-tests--eval-arg form)))
(defun pdumper-tests--emacs-binary ()
(expand-file-name invocation-name invocation-directory))
(defun pdumper-tests--check-output (dir command)
"Run COMMAND as a synchronous subprocess.
The process' current directory is set to DIR. Fail the test if
the process exits with a non-zero status. Otherwise, return its
output as a string."
(with-temp-buffer
(setq default-directory dir)
(let ((result (apply #'call-process
(car command)
nil t nil
(cdr command))))
(unless (equal 0 result)
(ert-info ((format "In directory %S" dir))
(ert-info ((format "Ran command %S" command))
(ert-info ((format "With output %S" (buffer-string)))
(should (equal 0 result)))))))
(buffer-string)))
(defun pdumper-tests--batch-redump (loadup-form redumped-form)
"Redump the current Emacs binary and verify it works.
First, run the current Emacs binary in a synchronous subprocess.
Evaluate LOADUP-FORM in it, then dump it with
`dump-emacs-portable'.
Second, run the current Emacs binary in a second subprocess, this
time with \"--dump-file\" set to the dump file just created.
Evaluate REDUMPED-FORM in this second process.
Returns the output of the second run as a string."
(ert-with-temp-directory tmpdir
(let* ((dump-file (concat tmpdir "redump.pdmp"))
(loadup-file (concat tmpdir "redump.el"))
(emacs-binary (pdumper-tests--emacs-binary))
(dump-command (pdumper-tests--batch-eval-command
(list emacs-binary)
`(progn
(load ,loadup-file)
(dump-emacs-portable ,dump-file)))))
(with-temp-file loadup-file
(insert (prin1-to-string loadup-form)))
(should (string-search "Dump complete"
(pdumper-tests--check-output
tmpdir dump-command)))
(let* ((redumped-emacs-command
(list emacs-binary
(concat "--dump-file=" dump-file)))
(redumped-emacs-validate
(pdumper-tests--batch-eval-command
redumped-emacs-command
redumped-form)))
(pdumper-tests--check-output
tmpdir
redumped-emacs-validate)))))
(ert-deftest pdumper-tests-redump-overlays ()
"Test portable dumping when overlays are in a buffer.
In an Emacs subprocess create a buffer with some overlays, then
dump it. Run with the new dump file and verify the buffer exists
and is in the correct state."
(skip-unless (fboundp 'pdumper-stats))
(let* ((overlay-buffer " *redump-overlays*")
(phrase "Lorem ipsum dolor sit amet, consectetur...")
(redump-output
(pdumper-tests--batch-redump
`(with-current-buffer (get-buffer-create ,overlay-buffer)
(insert ,phrase)
(dotimes (i 8)
(make-overlay (+ (point-min) i)
(+ (point-min) (+ i 10)))))
`(with-current-buffer (get-buffer-create ,overlay-buffer)
(unless (equal ,phrase (buffer-string))
(error "buffer text not as expected"))
(let ((overlays (overlays-in (point-min) (point-max))))
(princ (format "Redumped overlay count: <%d>"
(length overlays))))))))
;; Dumping of a buffer's overlays is not implemented. Overlays
;; are dumped as if they had been deleted, so the redumped Emacs
;; should have zero overlays in the *redump-overlays* buffer. See
;; bug#59029. */
(should (string-search "Redumped overlay count: <0>"
redump-output))))
(provide 'pdumper-tests)
;;; pdumper-tests.el ends here
|