aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNoam Postavsky2017-07-08 13:01:30 -0400
committerNoam Postavsky2017-07-08 14:28:17 -0400
commit4e3b9c544479f533d8932e739f9919c2fe952ef7 (patch)
tree49215c54910e6b9bf85f6cc2f961f887f49e1aa0
parentfd3bcfa36ec542fbca8cf5cc7c8b196e8baf8810 (diff)
downloademacs-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.el106
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.
72The following invariants must be true for all conformant implementations..." 70The 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.
112For every code point X assigned in this version of Unicode that is not specifically 110For every code point X assigned in this version of Unicode that is not specifically
113listed in Part 1, the following invariants must be true for all conformant 111listed 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