common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Minor quality-of-life improvement to unicode breaking tests

Browse source 
On failure, display the line, its number in the file, the expected
result, and the actual result.
This commit is contained in:
Christophe Rhodes 2022-06-29 21:43:41 +01:00
parent bce63ffcfc
commit 2d6559efdb
1 changed files with 28 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
tests/unicode-breaking.pure.lisp
View file

@ -37,17 +37,21 @@
(remove "" (split-string string #\Space) :test #'string=)))) (remove "" (split-string string #\Space) :test #'string=))))
(if (not (or (cdr list) singleton-list)) (car list) list))) (if (not (or (cdr list) singleton-list)) (car list) list)))
(defun test-line (fn line) (defun test-line (fn line n)
(let ((relevant-portion (subseq line 0 (position #\# line)))) (let ((relevant-portion (subseq line 0 (position #\# line))))
(when (string/= relevant-portion "") (when (string/= relevant-portion "")
(let ((string (let* ((string
(coerce (mapcar (coerce (mapcar
#'code-char #'code-char
(parse-codepoints (parse-codepoints
(remove +mul+ (remove +div+ relevant-portion)))) (remove +mul+ (remove +div+ relevant-portion))))
'string))) 'string))
(assert (equalp (funcall fn string) (actual (funcall fn string))
(line-to-clusters relevant-portion))))))) (expected (line-to-clusters relevant-portion)))
(assert (equalp actual expected)
()
"~@<line ~D: ~S - expected: ~S, actual: ~S~@:>"
n line expected actual)))))
(defun test-graphemes () (defun test-graphemes ()
(declare (optimize (debug 2))) (declare (optimize (debug 2)))
@ -55,8 +59,9 @@
:skipped-on (not :sb-unicode)) :skipped-on (not :sb-unicode))
(with-open-file (s "data/GraphemeBreakTest.txt" :external-format :utf8) (with-open-file (s "data/GraphemeBreakTest.txt" :external-format :utf8)
(loop for line = (read-line s nil nil) (loop for line = (read-line s nil nil)
for n from 0
while line while line
do (test-line #'graphemes (remove #\Tab line)))))) do (test-line #'graphemes (remove #\Tab line) n)))))
(test-graphemes) (test-graphemes)
@ -66,8 +71,9 @@
:skipped-on (not :sb-unicode)) :skipped-on (not :sb-unicode))
(with-open-file (s "data/WordBreakTest.txt" :external-format :utf8) (with-open-file (s "data/WordBreakTest.txt" :external-format :utf8)
(loop for line = (read-line s nil nil) (loop for line = (read-line s nil nil)
for n from 0
while line while line
do (test-line #'words (remove #\Tab line)))))) do (test-line #'words (remove #\Tab line) n)))))
(test-words) (test-words)
@ -77,8 +83,9 @@
:skipped-on (not :sb-unicode)) :skipped-on (not :sb-unicode))
(with-open-file (s "data/SentenceBreakTest.txt" :external-format :utf8) (with-open-file (s "data/SentenceBreakTest.txt" :external-format :utf8)
(loop for line = (read-line s nil nil) (loop for line = (read-line s nil nil)
for n from 0
while line while line
do (test-line #'sentences (remove #\Tab line)))))) do (test-line #'sentences (remove #\Tab line) n)))))
(test-sentences) (test-sentences)
@ -110,6 +117,7 @@
(setf (gethash s line-break-exceptions) t)) (setf (gethash s line-break-exceptions) t))
(with-open-file (s "data/LineBreakTest.txt" :external-format :utf8) (with-open-file (s "data/LineBreakTest.txt" :external-format :utf8)
(loop for line = (read-line s nil nil) (loop for line = (read-line s nil nil)
for n from 0
while line while line
do (let ((string (subseq line 0 (max 0 (1- (or (position #\# line) 1)))))) do (let ((string (subseq line 0 (max 0 (1- (or (position #\# line) 1))))))
(unless (string= string "") (unless (string= string "")
@ -118,5 +126,11 @@
(string-from-line-break-line string))) (string-from-line-break-line string)))
(actual (substitute :can :must annotated))) (actual (substitute :can :must annotated)))
(if (gethash string line-break-exceptions) (if (gethash string line-break-exceptions)
(assert (not (equal expected actual))) (assert (not (equal expected actual))
(assert (equal expected actual)))))))))) ()
"~@<line ~D: ~S - expected: ~S, actual; ~S~:@>"
n string expected actual)
(assert (equal expected actual)
()
"~@<line ~D: ~S - expected: ~S, actual; ~S~:@>"
n string expected actual)))))))))