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

Fix a test on -sb-unicode.

Browse source
This commit is contained in:
Stas Boukarev 2019-09-29 14:33:19 +03:00
parent 31acc6c221
commit 3085962e45
1 changed files with 18 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -100,29 +100,23 @@
(split-string (remove +mul+ (remove +div+ string)) #\Space)
:test #'string=)) 'string))
(defvar *line-break-exceptions*
(let ((strings
(with-open-file (s "data/line-break-exceptions.lisp-expr" :external-format :utf-8)
(read s)))
(result (make-hash-table :test 'equal)))
(dolist (s strings result)
(setf (gethash s result) t))))
(defun test-line-breaking ()
(declare (optimize (debug 2)))
(with-test (:name (:line-breaking)
:skipped-on (not :sb-unicode))
(with-test (:name (:line-breaking)
:skipped-on (not :sb-unicode))
(let* ((line-break-exceptions (make-hash-table :test 'equal))
(strings
(with-open-file (s "data/line-break-exceptions.lisp-expr" :external-format :utf-8)
(read s))))
(dolist (s strings)
(setf (gethash s line-break-exceptions) t))
(with-open-file (s "data/LineBreakTest.txt" :external-format :utf8)
(loop for line = (read-line s nil nil)
while line
do (let ((string (subseq line 0 (max 0 (1- (or (position #\# line) 1))))))
(unless (string= string "")
(let* ((expected (process-line-break-line string))
(annotated (sb-unicode::line-break-annotate
(string-from-line-break-line string)))
(actual (substitute :can :must annotated)))
(if (gethash string *line-break-exceptions*)
(assert (not (equal expected actual)))
(assert (equal expected actual))))))))))
(test-line-breaking)
while line
do (let ((string (subseq line 0 (max 0 (1- (or (position #\# line) 1))))))
(unless (string= string "")
(let* ((expected (process-line-break-line string))
(annotated (sb-unicode::line-break-annotate
(string-from-line-break-line string)))
(actual (substitute :can :must annotated)))
(if (gethash string line-break-exceptions)
(assert (not (equal expected actual)))
(assert (equal expected actual))))))))))