tests/unicode-collation.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (use-package :sb-unicode)
  13
  14 (defun parse-codepoints (string &key (singleton-list t))
  15   (let ((list (mapcar
  16               (lambda (s) (parse-integer s :radix 16))
  17               (remove "" (split-string string #\Space) :test #'string=))))
  18     (if (not (or (cdr list) singleton-list)) (car list) list)))
  19
  20 (defun parse-string (codepoints)
  21   (coerce (mapcar #'code-char (parse-codepoints codepoints)) 'string))
  22
  23 (defun test-collation ()
  24   (declare (optimize (debug 2)))
  25   (with-test (:name (:collation)
  26                     :skipped-on (not :sb-unicode))
  27     (with-open-file (s "data/CollationTest_SHIFTED_SHORT.txt" :external-format :utf8)
  28       (loop with previous-string = ""
  29          for line = (read-line s nil nil)
  30          while line
  31          unless (or (eql 0 (position #\# line)) (string= line ""))
  32          do (let ((string (parse-string (subseq line 0 (position #\; line)))))
  33               (assert (unicode<= previous-string string))
  34               (setf previous-string string))))))
  35
  36 (test-collation)