diff options
| author | Noam Postavsky | 2017-07-08 13:01:30 -0400 |
|---|---|---|
| committer | Noam Postavsky | 2017-07-08 14:28:17 -0400 |
| commit | 4e3b9c544479f533d8932e739f9919c2fe952ef7 (patch) | |
| tree | 49215c54910e6b9bf85f6cc2f961f887f49e1aa0 | |
| parent | fd3bcfa36ec542fbca8cf5cc7c8b196e8baf8810 (diff) | |
| download | emacs-4e3b9c544479f533d8932e739f9919c2fe952ef7.tar.gz emacs-4e3b9c544479f533d8932e739f9919c2fe952ef7.zip | |
Semi-automate the procedure for updating UCS normalize test bad lines
* test/lisp/international/ucs-normalize-tests.el: Remove incorrect
commentary describing a manual procedure for producing the updated
failing lines, it did not actually work. Replace it with pointer to
new function which prints the updated values.
(ucs-normalize-tests--rule1-holds-p): Renamed from
ucs-normalize-tests--invariants-hold-p.
(ucs-normalize-tests--rule2-holds-p): Renamed from
ucs-normalize-tests--invariants-rule2-hold-p.
(ucs-normalize-tests--rule1-failing-for-partX): Renamed from
ucs-normalize-tests--invariants-failing-for-part.
(ucs-normalize-tests--rule1-failing-for-lines): Renamed from
ucs-normalize-tests--invariants-failing-for-lines.
(ucs-normalize-tests--part2-rule1-failed-lines): New variable.
(ucs-normalize-part2): Set it.
(ucs-normalize-part1): Always run through to end of test before
checking for failures.
(ucs-normalize-tests--insert-failing-lines)
(ucs-normalize-check-failing-lines): New functions, used to update
the *--failing-lines-part* variables.
| -rw-r--r-- | test/lisp/international/ucs-normalize-tests.el | 106 |
1 files changed, 74 insertions, 32 deletions
diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el index d85efe2d7bf..532449349db 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el | |||
| @@ -26,15 +26,13 @@ | |||
| 26 | ;; If there are lines marked as failing (see | 26 | ;; If there are lines marked as failing (see |
| 27 | ;; `ucs-normalize-tests--failing-lines-part1' and | 27 | ;; `ucs-normalize-tests--failing-lines-part1' and |
| 28 | ;; `ucs-normalize-tests--failing-lines-part2'), they may need to be | 28 | ;; `ucs-normalize-tests--failing-lines-part2'), they may need to be |
| 29 | ;; adjusted when NormalizationTest.txt is updated. To get a list of | 29 | ;; adjusted when NormalizationTest.txt is updated. Run the function |
| 30 | ;; currently failing lines, set those 2 variables to nil, run the | 30 | ;; `ucs-normalize-check-failing-lines' to see what changes are needed. |
| 31 | ;; tests, and inspect the values of | ||
| 32 | ;; `ucs-normalize-tests--part1-rule1-failed-lines' and | ||
| 33 | ;; `ucs-normalize-tests--part1-rule2-failed-chars', respectively. | ||
| 34 | 31 | ||
| 35 | ;;; Code: | 32 | ;;; Code: |
| 36 | 33 | ||
| 37 | (eval-when-compile (require 'cl-lib)) | 34 | (eval-when-compile (require 'cl-lib)) |
| 35 | (require 'seq) | ||
| 38 | (require 'ert) | 36 | (require 'ert) |
| 39 | (require 'ucs-normalize) | 37 | (require 'ucs-normalize) |
| 40 | 38 | ||
| @@ -67,11 +65,11 @@ And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity." | |||
| 67 | 65 | ||
| 68 | (defvar ucs-normalize-tests--chars-part1 nil) | 66 | (defvar ucs-normalize-tests--chars-part1 nil) |
| 69 | 67 | ||
| 70 | (defun ucs-normalize-tests--invariants-hold-p (&rest columns) | 68 | (defun ucs-normalize-tests--rule1-holds-p (&rest columns) |
| 71 | "Check 1st conformance rule. | 69 | "Check 1st conformance rule. |
| 72 | The following invariants must be true for all conformant implementations..." | 70 | The following invariants must be true for all conformant implementations..." |
| 73 | (when ucs-normalize-tests--chars-part1 | 71 | (when ucs-normalize-tests--chars-part1 |
| 74 | ;; See `ucs-normalize-tests--invariants-rule2-hold-p'. | 72 | ;; See `ucs-normalize-tests--rule2-holds-p'. |
| 75 | (aset ucs-normalize-tests--chars-part1 | 73 | (aset ucs-normalize-tests--chars-part1 |
| 76 | (caar columns) 1)) | 74 | (caar columns) 1)) |
| 77 | (cl-destructuring-bind (source nfc nfd nfkc nfkd) | 75 | (cl-destructuring-bind (source nfc nfd nfkc nfkd) |
| @@ -107,7 +105,7 @@ The following invariants must be true for all conformant implementations..." | |||
| 107 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkc)) | 105 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkc)) |
| 108 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkd))))) | 106 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkd))))) |
| 109 | 107 | ||
| 110 | (defun ucs-normalize-tests--invariants-rule2-hold-p (char) | 108 | (defun ucs-normalize-tests--rule2-holds-p (char) |
| 111 | "Check 2nd conformance rule. | 109 | "Check 2nd conformance rule. |
| 112 | For every code point X assigned in this version of Unicode that is not specifically | 110 | For every code point X assigned in this version of Unicode that is not specifically |
| 113 | listed in Part 1, the following invariants must be true for all conformant | 111 | listed in Part 1, the following invariants must be true for all conformant |
| @@ -120,7 +118,7 @@ implementations: | |||
| 120 | (equal X (ucs-normalize-tests--normalize NFKC X)) | 118 | (equal X (ucs-normalize-tests--normalize NFKC X)) |
| 121 | (equal X (ucs-normalize-tests--normalize NFKD X))))) | 119 | (equal X (ucs-normalize-tests--normalize NFKD X))))) |
| 122 | 120 | ||
| 123 | (cl-defun ucs-normalize-tests--invariants-failing-for-part (part &optional skip-lines &key progress-str) | 121 | (cl-defun ucs-normalize-tests--rule1-failing-for-partX (part &optional skip-lines &key progress-str) |
| 124 | "Returns a list of failed line numbers." | 122 | "Returns a list of failed line numbers." |
| 125 | (with-temp-buffer | 123 | (with-temp-buffer |
| 126 | (insert-file-contents ucs-normalize-test-data-file) | 124 | (insert-file-contents ucs-normalize-test-data-file) |
| @@ -137,7 +135,7 @@ implementations: | |||
| 137 | 0 nil 0.5)) | 135 | 0 nil 0.5)) |
| 138 | for line from beg-line to (1- end-line) | 136 | for line from beg-line to (1- end-line) |
| 139 | unless (or (= (following-char) ?#) | 137 | unless (or (= (following-char) ?#) |
| 140 | (ucs-normalize-tests--invariants-hold-p | 138 | (ucs-normalize-tests--rule1-holds-p |
| 141 | (ucs-normalize-tests--parse-column) | 139 | (ucs-normalize-tests--parse-column) |
| 142 | (ucs-normalize-tests--parse-column) | 140 | (ucs-normalize-tests--parse-column) |
| 143 | (ucs-normalize-tests--parse-column) | 141 | (ucs-normalize-tests--parse-column) |
| @@ -148,7 +146,7 @@ implementations: | |||
| 148 | do (forward-line) | 146 | do (forward-line) |
| 149 | if reporter do (progress-reporter-update reporter line))))) | 147 | if reporter do (progress-reporter-update reporter line))))) |
| 150 | 148 | ||
| 151 | (defun ucs-normalize-tests--invariants-failing-for-lines (lines) | 149 | (defun ucs-normalize-tests--rule1-failing-for-lines (lines) |
| 152 | "Returns a list of failed line numbers." | 150 | "Returns a list of failed line numbers." |
| 153 | (with-temp-buffer | 151 | (with-temp-buffer |
| 154 | (insert-file-contents ucs-normalize-test-data-file) | 152 | (insert-file-contents ucs-normalize-test-data-file) |
| @@ -156,7 +154,7 @@ implementations: | |||
| 156 | (cl-loop for prev-line = 1 then line | 154 | (cl-loop for prev-line = 1 then line |
| 157 | for line in lines | 155 | for line in lines |
| 158 | do (forward-line (- line prev-line)) | 156 | do (forward-line (- line prev-line)) |
| 159 | unless (ucs-normalize-tests--invariants-hold-p | 157 | unless (ucs-normalize-tests--rule1-holds-p |
| 160 | (ucs-normalize-tests--parse-column) | 158 | (ucs-normalize-tests--parse-column) |
| 161 | (ucs-normalize-tests--parse-column) | 159 | (ucs-normalize-tests--parse-column) |
| 162 | (ucs-normalize-tests--parse-column) | 160 | (ucs-normalize-tests--parse-column) |
| @@ -165,7 +163,7 @@ implementations: | |||
| 165 | collect line))) | 163 | collect line))) |
| 166 | 164 | ||
| 167 | (ert-deftest ucs-normalize-part0 () | 165 | (ert-deftest ucs-normalize-part0 () |
| 168 | (should-not (ucs-normalize-tests--invariants-failing-for-part 0))) | 166 | (should-not (ucs-normalize-tests--rule1-failing-for-partX 0))) |
| 169 | 167 | ||
| 170 | (defconst ucs-normalize-tests--failing-lines-part1 | 168 | (defconst ucs-normalize-tests--failing-lines-part1 |
| 171 | (list 15131 15132 15133 15134 15135 15136 15137 15138 | 169 | (list 15131 15132 15133 15134 15135 15136 15137 15138 |
| @@ -195,6 +193,8 @@ implementations: | |||
| 195 | "A list of line numbers.") | 193 | "A list of line numbers.") |
| 196 | (defvar ucs-normalize-tests--part1-rule2-failed-chars nil | 194 | (defvar ucs-normalize-tests--part1-rule2-failed-chars nil |
| 197 | "A list of code points.") | 195 | "A list of code points.") |
| 196 | (defvar ucs-normalize-tests--part2-rule1-failed-lines nil | ||
| 197 | "A list of line numbers.") | ||
| 198 | 198 | ||
| 199 | (defun ucs-normalize-tests--part1-rule2 (chars-part1) | 199 | (defun ucs-normalize-tests--part1-rule2 (chars-part1) |
| 200 | (let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2" | 200 | (let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2" |
| @@ -204,11 +204,11 @@ implementations: | |||
| 204 | (lambda (char-range listed-in-part) | 204 | (lambda (char-range listed-in-part) |
| 205 | (unless (eq listed-in-part 1) | 205 | (unless (eq listed-in-part 1) |
| 206 | (if (characterp char-range) | 206 | (if (characterp char-range) |
| 207 | (progn (unless (ucs-normalize-tests--invariants-rule2-hold-p char-range) | 207 | (progn (unless (ucs-normalize-tests--rule2-holds-p char-range) |
| 208 | (push char-range failed-chars)) | 208 | (push char-range failed-chars)) |
| 209 | (progress-reporter-update reporter char-range)) | 209 | (progress-reporter-update reporter char-range)) |
| 210 | (cl-loop for char from (car char-range) to (cdr char-range) | 210 | (cl-loop for char from (car char-range) to (cdr char-range) |
| 211 | unless (ucs-normalize-tests--invariants-rule2-hold-p char) | 211 | unless (ucs-normalize-tests--rule2-holds-p char) |
| 212 | do (push char failed-chars) | 212 | do (push char failed-chars) |
| 213 | do (progress-reporter-update reporter char))))) | 213 | do (progress-reporter-update reporter char))))) |
| 214 | chars-part1) | 214 | chars-part1) |
| @@ -219,26 +219,27 @@ implementations: | |||
| 219 | :tags '(:expensive-test) | 219 | :tags '(:expensive-test) |
| 220 | ;; This takes a long time, so make sure we're compiled. | 220 | ;; This takes a long time, so make sure we're compiled. |
| 221 | (dolist (fun '(ucs-normalize-tests--part1-rule2 | 221 | (dolist (fun '(ucs-normalize-tests--part1-rule2 |
| 222 | ucs-normalize-tests--invariants-failing-for-part | 222 | ucs-normalize-tests--rule1-failing-for-partX |
| 223 | ucs-normalize-tests--invariants-hold-p | 223 | ucs-normalize-tests--rule1-holds-p |
| 224 | ucs-normalize-tests--invariants-rule2-hold-p)) | 224 | ucs-normalize-tests--rule2-holds-p)) |
| 225 | (or (byte-code-function-p (symbol-function fun)) | 225 | (or (byte-code-function-p (symbol-function fun)) |
| 226 | (byte-compile fun))) | 226 | (byte-compile fun))) |
| 227 | (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t))) | 227 | (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t))) |
| 228 | (should-not | 228 | (setq ucs-normalize-tests--part1-rule1-failed-lines |
| 229 | (setq ucs-normalize-tests--part1-rule1-failed-lines | 229 | (ucs-normalize-tests--rule1-failing-for-partX |
| 230 | (ucs-normalize-tests--invariants-failing-for-part | 230 | 1 ucs-normalize-tests--failing-lines-part1 |
| 231 | 1 ucs-normalize-tests--failing-lines-part1 | 231 | :progress-str "UCS Normalize Test Part1, rule 1")) |
| 232 | :progress-str "UCS Normalize Test Part1, rule 1"))) | 232 | (setq ucs-normalize-tests--part1-rule2-failed-chars |
| 233 | (should-not (setq ucs-normalize-tests--part1-rule2-failed-chars | 233 | (ucs-normalize-tests--part1-rule2 |
| 234 | (ucs-normalize-tests--part1-rule2 | 234 | ucs-normalize-tests--chars-part1)) |
| 235 | ucs-normalize-tests--chars-part1))))) | 235 | (should-not ucs-normalize-tests--part1-rule1-failed-lines) |
| 236 | (should-not ucs-normalize-tests--part1-rule2-failed-chars))) | ||
| 236 | 237 | ||
| 237 | (ert-deftest ucs-normalize-part1-failing () | 238 | (ert-deftest ucs-normalize-part1-failing () |
| 238 | :expected-result :failed | 239 | :expected-result :failed |
| 239 | (skip-unless ucs-normalize-tests--failing-lines-part1) | 240 | (skip-unless ucs-normalize-tests--failing-lines-part1) |
| 240 | (should-not | 241 | (should-not |
| 241 | (ucs-normalize-tests--invariants-failing-for-lines | 242 | (ucs-normalize-tests--rule1-failing-for-lines |
| 242 | ucs-normalize-tests--failing-lines-part1))) | 243 | ucs-normalize-tests--failing-lines-part1))) |
| 243 | 244 | ||
| 244 | (defconst ucs-normalize-tests--failing-lines-part2 | 245 | (defconst ucs-normalize-tests--failing-lines-part2 |
| @@ -259,19 +260,60 @@ implementations: | |||
| 259 | (ert-deftest ucs-normalize-part2 () | 260 | (ert-deftest ucs-normalize-part2 () |
| 260 | :tags '(:expensive-test) | 261 | :tags '(:expensive-test) |
| 261 | (should-not | 262 | (should-not |
| 262 | (ucs-normalize-tests--invariants-failing-for-part | 263 | (setq ucs-normalize-tests--part2-rule1-failed-lines |
| 263 | 2 ucs-normalize-tests--failing-lines-part2 | 264 | (ucs-normalize-tests--rule1-failing-for-partX |
| 264 | :progress-str "UCS Normalize Test Part2"))) | 265 | 2 ucs-normalize-tests--failing-lines-part2 |
| 266 | :progress-str "UCS Normalize Test Part2")))) | ||
| 265 | 267 | ||
| 266 | (ert-deftest ucs-normalize-part2-failing () | 268 | (ert-deftest ucs-normalize-part2-failing () |
| 267 | :expected-result :failed | 269 | :expected-result :failed |
| 268 | (skip-unless ucs-normalize-tests--failing-lines-part2) | 270 | (skip-unless ucs-normalize-tests--failing-lines-part2) |
| 269 | (should-not | 271 | (should-not |
| 270 | (ucs-normalize-tests--invariants-failing-for-lines | 272 | (ucs-normalize-tests--rule1-failing-for-lines |
| 271 | ucs-normalize-tests--failing-lines-part2))) | 273 | ucs-normalize-tests--failing-lines-part2))) |
| 272 | 274 | ||
| 273 | (ert-deftest ucs-normalize-part3 () | 275 | (ert-deftest ucs-normalize-part3 () |
| 274 | (should-not | 276 | (should-not |
| 275 | (ucs-normalize-tests--invariants-failing-for-part 3))) | 277 | (ucs-normalize-tests--rule1-failing-for-partX 3))) |
| 278 | |||
| 279 | (defun ucs-normalize-tests--insert-failing-lines (var newval) | ||
| 280 | (insert (format "`%s' should be updated to:\n | ||
| 281 | \(defconst %s | ||
| 282 | (list " var var)) | ||
| 283 | (dolist (linos (seq-partition newval 8)) | ||
| 284 | (insert (mapconcat #'number-to-string linos " ") "\n")) | ||
| 285 | (insert ")\)")) | ||
| 286 | |||
| 287 | (defun ucs-normalize-check-failing-lines () | ||
| 288 | (interactive) | ||
| 289 | (let ((ucs-normalize-tests--failing-lines-part1 nil) | ||
| 290 | (ucs-normalize-tests--failing-lines-part2 nil)) | ||
| 291 | (setq ucs-normalize-tests--part1-rule1-failed-lines nil) | ||
| 292 | (setq ucs-normalize-tests--part1-rule2-failed-chars nil) | ||
| 293 | (setq ucs-normalize-tests--part2-rule1-failed-lines nil) | ||
| 294 | (ert "\\`ucs-normalize")) | ||
| 295 | |||
| 296 | (with-current-buffer (get-buffer-create "*ucs normalize change bad lines*") | ||
| 297 | (erase-buffer) | ||
| 298 | (unless (equal ucs-normalize-tests--part1-rule1-failed-lines | ||
| 299 | ucs-normalize-tests--failing-lines-part1) | ||
| 300 | (ucs-normalize-tests--insert-failing-lines | ||
| 301 | 'ucs-normalize-tests--failing-lines-part1 | ||
| 302 | ucs-normalize-tests--part1-rule1-failed-lines)) | ||
| 303 | |||
| 304 | (when ucs-normalize-tests--part1-rule2-failed-chars | ||
| 305 | (insert (format "Some characters failed rule 2!\n\n%S" | ||
| 306 | `(list ,@ucs-normalize-tests--part1-rule2-failed-chars)))) | ||
| 307 | |||
| 308 | (unless (equal ucs-normalize-tests--part2-rule1-failed-lines | ||
| 309 | ucs-normalize-tests--failing-lines-part2) | ||
| 310 | (ucs-normalize-tests--insert-failing-lines | ||
| 311 | 'ucs-normalize-tests--failing-lines-part2 | ||
| 312 | ucs-normalize-tests--part2-rule1-failed-lines)) | ||
| 313 | (if (> (buffer-size) 0) | ||
| 314 | (if noninteractive | ||
| 315 | (princ (buffer-string) standard-output) | ||
| 316 | (display-buffer (current-buffer))) | ||
| 317 | (message "No changes to failing lines needed")))) | ||
| 276 | 318 | ||
| 277 | ;;; ucs-normalize-tests.el ends here | 319 | ;;; ucs-normalize-tests.el ends here |