diff options
| author | Stephen Gildea | 2021-10-05 20:32:59 -0700 |
|---|---|---|
| committer | Stephen Gildea | 2021-10-05 20:34:03 -0700 |
| commit | aacafbe267306a2bb5d504ae408008d1ff7e9c8f (patch) | |
| tree | 7114a5eab87d308047aa7630b7f5a504ccb11913 | |
| parent | ead5c5cc5196c373421eaf8ebd996e652a37de81 (diff) | |
| download | emacs-aacafbe267306a2bb5d504ae408008d1ff7e9c8f.tar.gz emacs-aacafbe267306a2bb5d504ae408008d1ff7e9c8f.zip | |
Refactor mh-utils-tests macro 'with-mh-test-env'
* test/lisp/mh-e/mh-utils-tests.el (with-mh-test-env): Refactor to
reduce the size of the expanded macro.
(mh-test-utils-setup): New helper function.
(mh-ensure-native-trampolines): Absorbed by mh-test-utils-setup.
| -rw-r--r-- | test/lisp/mh-e/mh-utils-tests.el | 36 |
1 files changed, 19 insertions, 17 deletions
diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el index f1282ab44a6..bf684dbbea8 100644 --- a/test/lisp/mh-e/mh-utils-tests.el +++ b/test/lisp/mh-e/mh-utils-tests.el | |||
| @@ -95,26 +95,28 @@ install an MH variant and test it interactively." | |||
| 95 | (mh-sub-folders-cache (make-hash-table :test #'equal)) | 95 | (mh-sub-folders-cache (make-hash-table :test #'equal)) |
| 96 | ;; remember the original value | 96 | ;; remember the original value |
| 97 | (original-mh-envvar (getenv "MH"))) | 97 | (original-mh-envvar (getenv "MH"))) |
| 98 | (unless mh-test-variant-logged-already | ||
| 99 | (mh-variant-set mh-variant) | ||
| 100 | (setq mh-test-variant-logged-already t)) | ||
| 101 | (unwind-protect | 98 | (unwind-protect |
| 102 | (progn | 99 | (progn |
| 103 | (if mh-variant-in-use | 100 | (setq temp-home-dir (mh-test-utils-setup)) |
| 104 | (setq temp-home-dir (mh-test-utils-setup-with-variant)) | ||
| 105 | (mh-test-utils-setup-with-mocks)) | ||
| 106 | ,@body) | 101 | ,@body) |
| 107 | (if temp-home-dir (delete-directory temp-home-dir t)) | 102 | (if temp-home-dir (delete-directory temp-home-dir t)) |
| 108 | (setenv "MH" original-mh-envvar)))) | 103 | (setenv "MH" original-mh-envvar)))) |
| 109 | 104 | ||
| 110 | (defun mh-ensure-native-trampolines () | 105 | (defun mh-test-utils-setup () |
| 111 | "Build head of time the trampolines we'll need. | 106 | "Set dynamically bound variables needed by mock and/or variants. |
| 112 | As `call-process'' and `file-directory-p' will be redefined, the | 107 | Return the name of the root of the created directory tree, if any." |
| 113 | native compiler will invoke `call-process' to compile the | 108 | (unless mh-test-variant-logged-already |
| 114 | respective trampolines. To avoid interferences with the | 109 | (mh-variant-set mh-variant) |
| 115 | `call-process' mocking we build these AOT." | 110 | (setq mh-test-variant-logged-already t)) |
| 111 | ;; As `call-process'' and `file-directory-p' will be redefined, the | ||
| 112 | ;; native compiler will invoke `call-process' to compile the | ||
| 113 | ;; respective trampolines. To avoid interference with the | ||
| 114 | ;; `call-process' mocking, we build these ahead of time. | ||
| 116 | (when (native-comp-available-p) | 115 | (when (native-comp-available-p) |
| 117 | (mapc #'comp-subr-trampoline-install '(call-process file-directory-p)))) | 116 | (mapc #'comp-subr-trampoline-install '(call-process file-directory-p))) |
| 117 | (if mh-variant-in-use | ||
| 118 | (mh-test-utils-setup-with-variant) | ||
| 119 | (mh-test-utils-setup-with-mocks))) | ||
| 118 | 120 | ||
| 119 | (defun mh-test-utils-setup-with-mocks () | 121 | (defun mh-test-utils-setup-with-mocks () |
| 120 | "Set dynamically bound variables so that MH programs are mocked out. | 122 | "Set dynamically bound variables so that MH programs are mocked out. |
| @@ -125,9 +127,10 @@ The tests use this method if no configured MH variant is found." | |||
| 125 | (mh-populate-sub-folders-cache "+rela-folder/bar") | 127 | (mh-populate-sub-folders-cache "+rela-folder/bar") |
| 126 | (mh-populate-sub-folders-cache "+rela-folder/foo") | 128 | (mh-populate-sub-folders-cache "+rela-folder/foo") |
| 127 | (mh-populate-sub-folders-cache "+rela-folder/food") | 129 | (mh-populate-sub-folders-cache "+rela-folder/food") |
| 128 | (mh-ensure-native-trampolines) | ||
| 129 | (fset 'call-process #'mh-test-utils-mock-call-process) | 130 | (fset 'call-process #'mh-test-utils-mock-call-process) |
| 130 | (fset 'file-directory-p #'mh-test-utils-mock-file-directory-p)) | 131 | (fset 'file-directory-p #'mh-test-utils-mock-file-directory-p) |
| 132 | ;; no temp directory created | ||
| 133 | nil) | ||
| 131 | 134 | ||
| 132 | (defun mh-test-utils-mock-call-process (program | 135 | (defun mh-test-utils-mock-call-process (program |
| 133 | &optional _infile _destination _display | 136 | &optional _infile _destination _display |
| @@ -196,7 +199,7 @@ Return the name of the root of the created directory tree. | |||
| 196 | Set dynamically bound variables so that MH programs may log. | 199 | Set dynamically bound variables so that MH programs may log. |
| 197 | The tests use this method if a configured MH variant is found." | 200 | The tests use this method if a configured MH variant is found." |
| 198 | (let* ((temp-home-dir | 201 | (let* ((temp-home-dir |
| 199 | (make-temp-file "emacs-mh-e-unit-test" t)) | 202 | (make-temp-file "emacs-mh-e-unit-test-" t)) |
| 200 | (profile (expand-file-name | 203 | (profile (expand-file-name |
| 201 | ".mh_profile" temp-home-dir)) | 204 | ".mh_profile" temp-home-dir)) |
| 202 | (mail-dir (expand-file-name "Mail" temp-home-dir)) | 205 | (mail-dir (expand-file-name "Mail" temp-home-dir)) |
| @@ -215,7 +218,6 @@ The tests use this method if a configured MH variant is found." | |||
| 215 | (make-directory (expand-file-name "foo" abso-folder) t) | 218 | (make-directory (expand-file-name "foo" abso-folder) t) |
| 216 | (make-directory (expand-file-name "food" abso-folder) t) | 219 | (make-directory (expand-file-name "food" abso-folder) t) |
| 217 | (setq mh-test-abs-folder abso-folder) | 220 | (setq mh-test-abs-folder abso-folder) |
| 218 | (mh-ensure-native-trampolines) | ||
| 219 | (fset 'call-process #'mh-test-utils-log-call-process) | 221 | (fset 'call-process #'mh-test-utils-log-call-process) |
| 220 | (fset 'file-directory-p #'mh-test-utils-log-file-directory-p) | 222 | (fset 'file-directory-p #'mh-test-utils-log-file-directory-p) |
| 221 | temp-home-dir)) | 223 | temp-home-dir)) |