tests/strings.lisp

   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)