grovel-headers.c: Put win32 stuff into grovel-headers-win32.h.
[sbcl.git] / tests / unicode-collation.impure.lisp
blobb0a32aecccd2aabbfb5a2950ad244df4a9822047
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.
12 (use-package :sb-unicode)
14 (defun split-string (string delimiter)
15 (loop for begin = 0 then (1+ end)
16 for end = (position delimiter string) then (position delimiter string :start begin)
17 collect (subseq string begin end)
18 while end))
20 (defun parse-codepoints (string &key (singleton-list t))
21 (let ((list (mapcar
22 (lambda (s) (parse-integer s :radix 16))
23 (remove "" (split-string string #\Space) :test #'string=))))
24 (if (not (or (cdr list) singleton-list)) (car list) list)))
26 (defun parse-string (codepoints)
27 (coerce (mapcar #'code-char (parse-codepoints codepoints)) 'string))
29 (defun test-collation ()
30 (declare (optimize (debug 2)))
31 (with-test (:name (:collation)
32 :skipped-on '(not :sb-unicode))
33 (with-open-file (s "data/CollationTest_SHIFTED_SHORT.txt" :external-format :utf8)
34 (loop with previous-string = ""
35 for line = (read-line s nil nil)
36 while line
37 unless (or (eql 0 (position #\# line)) (string= line ""))
38 do (let ((string (parse-string (subseq line 0 (position #\; line)))))
39 (assert (unicode<= previous-string string))
40 (setf previous-string string))))))
42 (test-collation)