GopherProxy

	tstrings.lisp - clic - Clic is an command line interactive client for gopher wr…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	tstrings.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 <[email protected]>
	6 ;;; Copyright (C) 2007, Luis Oliveira <[email protected]>
	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 encod…
	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)