strings.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
strings.lisp (6395B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; strings.lisp --- Tests for foreign string conversion.
4 ;;;
5 ;;; Copyright (C) 2005, James Bielman <jamesjb@jamesjb.com>
6 ;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
7 ;;;
8 ;;; Permission is hereby granted, free of charge, to any person
9 ;;; obtaining a copy of this software and associated documentation
10 ;;; files (the "Software"), to deal in the Software without
11 ;;; restriction, including without limitation the rights to use, copy,
12 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
13 ;;; of the Software, and to permit persons to whom the Software is
14 ;;; furnished to do so, subject to the following conditions:
15 ;;;
16 ;;; The above copyright notice and this permission notice shall be
17 ;;; included in all copies or substantial portions of the Software.
18 ;;;
19 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
20 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
21 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
22 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
23 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
24 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
25 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
26 ;;; DEALINGS IN THE SOFTWARE.
27 ;;;
28
29 (in-package #:cffi-tests)
30
31 ;;;# Foreign String Conversion Tests
32 ;;;
33 ;;; With the implementation of encoding support, there are a lot of
34 ;;; things that can go wrong with foreign string conversions. This is
35 ;;; a start at defining tests for strings and encoding conversion, but
36 ;;; there needs to be a lot more.
37
38 (babel:enable-sharp-backslash-syntax)
39
40 ;;; *ASCII-TEST-STRING* contains the characters in the ASCII character
41 ;;; set that we will convert to a foreign string and check against
42 ;;; *ASCII-TEST-BYTES*. We don't bother with control characters.
43 ;;;
44 ;;; FIXME: It would probably be good to move these tables into files
45 ;;; in "tests/", especially if we ever want to get fancier and have
46 ;;; tests for more encodings.
47 (eval-when (:compile-toplevel :load-toplevel :execute)
48 (defparameter *ascii-test-string*
49 (concatenate 'string " !\"#$%&'()*+,-./0123456789:;"
50 "<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]"
51 "^_`abcdefghijklmnopqrstuvwxyz{|}~")))
52
53 ;;; *ASCII-TEST-BYTES* contains the expected ASCII encoded values
54 ;;; for each character in *ASCII-TEST-STRING*.
55 (eval-when (:compile-toplevel :load-toplevel :execute)
56 (defparameter *ascii-test-bytes*
57 (let ((vector (make-array 95 :element-type '(unsigned-byte 8))))
58 (loop for i from 0
59 for code from 32 below 127
60 do (setf (aref vector i) code)
61 finally (return vector)))))
62
63 ;;; Test basic consistency converting a string to and from Lisp using
64 ;;; the default encoding.
65 (deftest string.conversion.basic
66 (with-foreign-string (s *ascii-test-string*)
67 (foreign-string-to-lisp s))
68 #.*ascii-test-string* 95)
69
70 (deftest string.conversion.basic.2
71 (with-foreign-string ((ptr size) "123" :null-terminated-p nil)
72 (values (foreign-string-to-lisp ptr :count 3) size))
73 "123" 3)
74
75 ;;; Ensure that conversion of *ASCII-TEST-STRING* to a foreign buffer
76 ;;; and back preserves ASCII encoding.
77 (deftest string.encoding.ascii
78 (with-foreign-string (s *ascii-test-string* :encoding :ascii)
79 (let ((vector (make-array 95 :element-type '(unsigned-byte 8))))
80 (loop for i from 0 below (length vector)
81 do (setf (aref vector i) (mem-ref s :unsigned-char i)))
82 vector))
83 #.*ascii-test-bytes*)
84
85 ;;; FIXME: bogus test. We need support for BOM or UTF-16{BE,LE}.
86 (pushnew 'string.encoding.utf-16.basic rtest::*expected-failures*)
87
88 ;;; Test UTF-16 conversion of a string back and forth. Tests proper
89 ;;; null terminator handling for wide character strings and ensures no
90 ;;; byte order marks are added. (Why no BOM? --luis)
91 ;;;
92 ;;; FIXME: an identical test using :UTF-16 wouldn't work because on
93 ;;; little-endian architectures, :UTF-16 defaults to little-endian
94 ;;; when writing and big-endian on reading because the BOM is
95 ;;; suppressed.
96 #-babel::8-bit-chars
97 (progn
98 (deftest string.encoding.utf-16le.basic
99 (with-foreign-string (s *ascii-test-string* :encoding :utf-16le)
100 (foreign-string-to-lisp s :encoding :utf-16le))
101 #.*ascii-test-string* 190)
102
103 (deftest string.encoding.utf-16be.basic
104 (with-foreign-string (s *ascii-test-string* :encoding :utf-16be)
105 (foreign-string-to-lisp s :encoding :utf-16be))
106 #.*ascii-test-string* 190))
107
108 ;;; Ensure that writing a long string into a short buffer does not
109 ;;; attempt to write beyond the edge of the buffer, and that the
110 ;;; resulting string is still null terminated.
111 (deftest string.short-write.1
112 (with-foreign-pointer (buf 6)
113 (setf (mem-ref buf :unsigned-char 5) 70)
114 (lisp-string-to-foreign "ABCDE" buf 5 :encoding :ascii)
115 (values (mem-ref buf :unsigned-char 4)
116 (mem-ref buf :unsigned-char 5)))
117 0 70)
118
119 #-babel::8-bit-chars
120 (deftest string.encoding.utf-8.basic
121 (with-foreign-pointer (buf 7 size)
122 (let ((string (concatenate 'babel:unicode-string
123 '(#\u03bb #\u00e3 #\u03bb))))
124 (lisp-string-to-foreign string buf size :encoding :utf-8)
125 (loop for i from 0 below size
126 collect (mem-ref buf :unsigned-char i))))
127 (206 187 195 163 206 187 0))
128
129 (defparameter *basic-latin-alphabet* "abcdefghijklmnopqrstuvwxyz")
130
131 (deftest string.encodings.all.basic
132 (let (failed)
133 ;;; FIXME: UTF-{32,16} and friends fail due to lack of BOM. See
134 ;;; STRING.ENCODING.UTF-16.BASIC for more details.
135 (dolist (encoding (remove-if (lambda (x)
136 (member x '(:utf-32 :utf-16 :ucs-2)))
137 (babel:list-character-encodings)))
138 ;; (format t "Testing ~S~%" encoding)
139 (with-foreign-string (ptr *basic-latin-alphabet* :encoding encoding)
140 (let ((string (foreign-string-to-lisp ptr :encoding encoding)))
141 ;; (format t " got ~S~%" string)
142 (unless (string= *basic-latin-alphabet* string)
143 (push encoding failed)))))
144 failed)
145 nil)
146
147 ;;; rt: make sure *default-foreign-enconding* binds to a keyword
148 (deftest string.encodings.default
149 (keywordp *default-foreign-encoding*)
150 t)