diff options
Diffstat (limited to 'test/lisp/cedet/srecode/fields-tests.el')
| -rw-r--r-- | test/lisp/cedet/srecode/fields-tests.el | 238 |
1 files changed, 238 insertions, 0 deletions
diff --git a/test/lisp/cedet/srecode/fields-tests.el b/test/lisp/cedet/srecode/fields-tests.el new file mode 100644 index 00000000000..5f634a5e4ce --- /dev/null +++ b/test/lisp/cedet/srecode/fields-tests.el | |||
| @@ -0,0 +1,238 @@ | |||
| 1 | ;;; srecode/fields-tests.el --- Tests for srecode/fields.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | ;; Extracted from srecode-fields.el in the CEDET distribution. | ||
| 25 | |||
| 26 | ;; Converted to ert from test/manual/cedet/srecode-tests.el | ||
| 27 | |||
| 28 | ;;; Code: | ||
| 29 | |||
| 30 | ;;; From srecode-fields: | ||
| 31 | |||
| 32 | (require 'ert) | ||
| 33 | (require 'srecode/fields) | ||
| 34 | |||
| 35 | (defvar srecode-field-utest-text | ||
| 36 | "This is a test buffer. | ||
| 37 | |||
| 38 | It is filled with some text." | ||
| 39 | "Text for tests.") | ||
| 40 | |||
| 41 | ;; FIXME: This test fails even before conversion to ert. | ||
| 42 | (ert-deftest srecode-field-utest-impl () | ||
| 43 | "Implementation of the SRecode field utest." | ||
| 44 | :tags '(:unstable) | ||
| 45 | (save-excursion | ||
| 46 | (find-file "/tmp/srecode-field-test.txt") | ||
| 47 | |||
| 48 | (erase-buffer) | ||
| 49 | (goto-char (point-min)) | ||
| 50 | (insert srecode-field-utest-text) | ||
| 51 | (set-buffer-modified-p nil) | ||
| 52 | |||
| 53 | ;; Test basic field generation. | ||
| 54 | (let ((srecode-field-archive nil) | ||
| 55 | (f nil)) | ||
| 56 | |||
| 57 | (end-of-line) | ||
| 58 | (forward-word -1) | ||
| 59 | |||
| 60 | (setq f (srecode-field "Test" | ||
| 61 | :name "TEST" | ||
| 62 | :start 6 | ||
| 63 | :end 8)) | ||
| 64 | |||
| 65 | (when (or (not (slot-boundp f 'overlay)) (not (oref f overlay))) | ||
| 66 | (error "Field test: Overlay info not created for field")) | ||
| 67 | |||
| 68 | (when (and (overlayp (oref f overlay)) | ||
| 69 | (not (overlay-get (oref f overlay) 'srecode-init-only))) | ||
| 70 | (error "Field creation overlay is not tagged w/ init flag")) | ||
| 71 | |||
| 72 | (srecode-overlaid-activate f) | ||
| 73 | |||
| 74 | (when (or (not (overlayp (oref f overlay))) | ||
| 75 | (overlay-get (oref f overlay) 'srecode-init-only)) | ||
| 76 | (error "New field overlay not created during activation")) | ||
| 77 | |||
| 78 | (when (not (= (length srecode-field-archive) 1)) | ||
| 79 | (error "Field test: Incorrect number of elements in the field archive")) | ||
| 80 | (when (not (eq f (car srecode-field-archive))) | ||
| 81 | (error "Field test: Field did not auto-add itself to the field archive")) | ||
| 82 | |||
| 83 | (when (not (overlay-get (oref f overlay) 'keymap)) | ||
| 84 | (error "Field test: Overlay keymap not set")) | ||
| 85 | |||
| 86 | (when (not (string= "is" (srecode-overlaid-text f))) | ||
| 87 | (error "Field test: Expected field text 'is', not %s" | ||
| 88 | (srecode-overlaid-text f))) | ||
| 89 | |||
| 90 | ;; Test deletion. | ||
| 91 | (srecode-delete f) | ||
| 92 | |||
| 93 | (when (slot-boundp f 'overlay) | ||
| 94 | (error "Field test: Overlay not deleted after object delete")) | ||
| 95 | ) | ||
| 96 | |||
| 97 | ;; Test basic region construction. | ||
| 98 | (let* ((srecode-field-archive nil) | ||
| 99 | (reg nil) | ||
| 100 | (fields | ||
| 101 | (list | ||
| 102 | (srecode-field "Test1" :name "TEST-1" :start 5 :end 10) | ||
| 103 | (srecode-field "Test2" :name "TEST-2" :start 15 :end 20) | ||
| 104 | (srecode-field "Test3" :name "TEST-3" :start 25 :end 30) | ||
| 105 | |||
| 106 | (srecode-field "Test4" :name "TEST-4" :start 35 :end 35)) | ||
| 107 | )) | ||
| 108 | |||
| 109 | (when (not (= (length srecode-field-archive) 4)) | ||
| 110 | (error "Region Test: Found %d fields. Expected 4" | ||
| 111 | (length srecode-field-archive))) | ||
| 112 | |||
| 113 | (setq reg (srecode-template-inserted-region "REG" | ||
| 114 | :start 4 | ||
| 115 | :end 40)) | ||
| 116 | |||
| 117 | (srecode-overlaid-activate reg) | ||
| 118 | |||
| 119 | ;; Make sure it was cleared. | ||
| 120 | (when srecode-field-archive | ||
| 121 | (error "Region Test: Did not clear field archive")) | ||
| 122 | |||
| 123 | ;; Auto-positioning. | ||
| 124 | (when (not (eq (point) 5)) | ||
| 125 | (error "Region Test: Did not reposition on first field")) | ||
| 126 | |||
| 127 | ;; Active region | ||
| 128 | (when (not (eq (srecode-active-template-region) reg)) | ||
| 129 | (error "Region Test: Active region not set")) | ||
| 130 | |||
| 131 | ;; Various sizes | ||
| 132 | (mapc (lambda (T) | ||
| 133 | (if (string= (eieio-object-name-string T) "Test4") | ||
| 134 | (progn | ||
| 135 | (when (not (srecode-empty-region-p T)) | ||
| 136 | (error "Field %s is not empty" | ||
| 137 | (eieio-object-name T))) | ||
| 138 | ) | ||
| 139 | (when (not (= (srecode-region-size T) 5)) | ||
| 140 | (error "Calculated size of %s was not 5" | ||
| 141 | (eieio-object-name T))))) | ||
| 142 | fields) | ||
| 143 | |||
| 144 | ;; Make sure things stay up after a 'command'. | ||
| 145 | (srecode-field-post-command) | ||
| 146 | (when (not (eq (srecode-active-template-region) reg)) | ||
| 147 | (error "Region Test: Active region did not stay up")) | ||
| 148 | |||
| 149 | ;; Test field movement. | ||
| 150 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | ||
| 151 | (nth 0 fields))) | ||
| 152 | (error "Region Test: Field %s not under point" | ||
| 153 | (eieio-object-name (nth 0 fields)))) | ||
| 154 | |||
| 155 | (srecode-field-next) | ||
| 156 | |||
| 157 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | ||
| 158 | (nth 1 fields))) | ||
| 159 | (error "Region Test: Field %s not under point" | ||
| 160 | (eieio-object-name (nth 1 fields)))) | ||
| 161 | |||
| 162 | (srecode-field-prev) | ||
| 163 | |||
| 164 | (when (not (eq (srecode-overlaid-at-point 'srecode-field) | ||
| 165 | (nth 0 fields))) | ||
| 166 | (error "Region Test: Field %s not under point" | ||
| 167 | (eieio-object-name (nth 0 fields)))) | ||
| 168 | |||
| 169 | ;; Move cursor out of the region and have everything cleaned up. | ||
| 170 | (goto-char 42) | ||
| 171 | (srecode-field-post-command) | ||
| 172 | (when (srecode-active-template-region) | ||
| 173 | (error "Region Test: Active region did not clear on move out")) | ||
| 174 | |||
| 175 | (mapc (lambda (T) | ||
| 176 | (when (slot-boundp T 'overlay) | ||
| 177 | (error "Overlay did not clear off of field %s" | ||
| 178 | (eieio-object-name T)))) | ||
| 179 | fields) | ||
| 180 | |||
| 181 | ;; End of LET | ||
| 182 | ) | ||
| 183 | |||
| 184 | ;; Test variable linkage. | ||
| 185 | (let* ((srecode-field-archive nil) | ||
| 186 | (f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8)) | ||
| 187 | (f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30)) | ||
| 188 | (f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40)) | ||
| 189 | (reg (srecode-template-inserted-region "REG" :start 4 :end 40))) | ||
| 190 | (srecode-overlaid-activate reg) | ||
| 191 | |||
| 192 | (when (not (string= (srecode-overlaid-text f1) | ||
| 193 | (srecode-overlaid-text f2))) | ||
| 194 | (error "Linkage Test: Init strings are not =")) | ||
| 195 | (when (string= (srecode-overlaid-text f1) | ||
| 196 | (srecode-overlaid-text f3)) | ||
| 197 | (error "Linkage Test: Init string on dissimilar fields is now the same")) | ||
| 198 | |||
| 199 | (goto-char 7) | ||
| 200 | (insert "a") | ||
| 201 | |||
| 202 | (when (not (string= (srecode-overlaid-text f1) | ||
| 203 | (srecode-overlaid-text f2))) | ||
| 204 | (error "Linkage Test: mid-insert strings are not =")) | ||
| 205 | (when (string= (srecode-overlaid-text f1) | ||
| 206 | (srecode-overlaid-text f3)) | ||
| 207 | (error "Linkage Test: mid-insert string on dissimilar fields is now the same")) | ||
| 208 | |||
| 209 | (goto-char 9) | ||
| 210 | (insert "t") | ||
| 211 | |||
| 212 | (when (not (string= (srecode-overlaid-text f1) "iast")) | ||
| 213 | (error "Linkage Test: tail-insert failed to captured added char")) | ||
| 214 | (when (not (string= (srecode-overlaid-text f1) | ||
| 215 | (srecode-overlaid-text f2))) | ||
| 216 | (error "Linkage Test: tail-insert strings are not =")) | ||
| 217 | (when (string= (srecode-overlaid-text f1) | ||
| 218 | (srecode-overlaid-text f3)) | ||
| 219 | (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | ||
| 220 | |||
| 221 | (goto-char 6) | ||
| 222 | (insert "b") | ||
| 223 | |||
| 224 | (when (not (string= (srecode-overlaid-text f1) "biast")) | ||
| 225 | (error "Linkage Test: tail-insert failed to captured added char")) | ||
| 226 | (when (not (string= (srecode-overlaid-text f1) | ||
| 227 | (srecode-overlaid-text f2))) | ||
| 228 | (error "Linkage Test: tail-insert strings are not =")) | ||
| 229 | (when (string= (srecode-overlaid-text f1) | ||
| 230 | (srecode-overlaid-text f3)) | ||
| 231 | (error "Linkage Test: tail-insert string on dissimilar fields is now the same")) | ||
| 232 | |||
| 233 | ;; Cleanup | ||
| 234 | (srecode-delete reg)) | ||
| 235 | |||
| 236 | (set-buffer-modified-p nil))) | ||
| 237 | |||
| 238 | ;;; srecode/fields-tests.el ends here | ||