Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/edicl-flexi-streams-20240429143708/mapping.lisp

KindCoveredAll%
expression1733 51.5
branch22100.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
2
 ;;; $Header: /usr/local/cvsrep/flexi-streams/mapping.lisp,v 1.3 2008/05/25 19:07:53 edi Exp $
3
 
4
 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
5
 
6
 ;;; Redistribution and use in source and binary forms, with or without
7
 ;;; modification, are permitted provided that the following conditions
8
 ;;; are met:
9
 
10
 ;;;   * Redistributions of source code must retain the above copyright
11
 ;;;     notice, this list of conditions and the following disclaimer.
12
 
13
 ;;;   * Redistributions in binary form must reproduce the above
14
 ;;;     copyright notice, this list of conditions and the following
15
 ;;;     disclaimer in the documentation and/or other materials
16
 ;;;     provided with the distribution.
17
 
18
 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19
 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20
 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21
 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22
 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23
 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24
 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25
 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26
 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27
 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28
 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
 
30
 (in-package :flexi-streams)
31
 
32
 (deftype octet ()
33
   "A shortcut for \(UNSIGNED-BYTE 8)."
34
   '(unsigned-byte 8))
35
 
36
 (deftype char* ()
37
   "Convenience shortcut to paper over the difference between LispWorks
38
 and the other Lisps."
39
   #+:lispworks 'lw:simple-char
40
   #-:lispworks 'character)
41
 
42
 (deftype string* ()
43
   "Convenience shortcut to paper over the difference between LispWorks
44
 and the other Lisps."
45
   #+:lispworks 'lw:text-string
46
   #-:lispworks 'string)
47
 
48
 (deftype char-code-integer ()
49
   "The subtype of integers which can be returned by the function CHAR-CODE."
50
   #-:cmu '(integer 0 #.(1- char-code-limit))
51
   #+:cmu '(integer 0 65533))
52
 
53
 (deftype code-point ()
54
   "The subtype of integers that's just big enough to hold all Unicode
55
 codepoints.
56
 
57
 See for example <http://unicode.org/glossary/#C>."
58
   '(mod #x110000))
59
 
60
 (defmacro defconstant (name value &optional doc)
61
   "Make sure VALUE is evaluated only once \(to appease SBCL)."
62
   `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
63
      ,@(when doc (list doc))))
64
 
65
 (defun invert-table (table)
66
   "`Inverts' an array which maps octets to character codes to a hash
67
 table which maps character codes to octets."
68
   (let ((hash (make-hash-table)))
69
     (loop for octet from 0
70
           for char-code across table
71
           unless (= char-code 65533)
72
           do (setf (gethash char-code hash) octet))
73
     hash))
74
 
75
 (defun make-decoding-table (list)
76
   "Creates and returns an array which contains the elements in the
77
 list LIST and has an element type that's suitable for character
78
 codes."
79
   (make-array (length list)
80
               :element-type 'char-code-integer
81
               :initial-contents list))