Coverage report: /home/ellis/.stash/quicklisp/dists/ultralisp/software/cl-babel-babel-20240610131823/src/sharp-backslash.lisp

KindCoveredAll%
expression060 0.0
branch06 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2
 ;;;
3
 ;;; sharp-backslash.lisp --- Alternative #\ dispatch code.
4
 ;;;
5
 ;;; Copyright (C) 2007-2009, Luis Oliveira  <loliveira@common-lisp.net>
6
 ;;;
7
 ;;; Permission is hereby granted, free of charge, to any person
8
 ;;; obtaining a copy of this software and associated documentation
9
 ;;; files (the "Software"), to deal in the Software without
10
 ;;; restriction, including without limitation the rights to use, copy,
11
 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12
 ;;; of the Software, and to permit persons to whom the Software is
13
 ;;; furnished to do so, subject to the following conditions:
14
 ;;;
15
 ;;; The above copyright notice and this permission notice shall be
16
 ;;; included in all copies or substantial portions of the Software.
17
 ;;;
18
 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19
 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20
 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21
 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22
 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23
 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24
 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25
 ;;; DEALINGS IN THE SOFTWARE.
26
 
27
 (in-package #:babel)
28
 
29
 #-allegro
30
 (defun sharp-backslash-reader (original-reader stream char numarg)
31
   (let ((1st-char (read-char stream)))
32
     (if (and (char-equal 1st-char #\u)
33
              ;; because #\z is not a digit char...
34
              (digit-char-p (peek-char nil stream nil #\z) 16))
35
         ;; something better than READ would be nice here
36
         (let ((token (let ((*read-base* 16)) (read stream))))
37
           (if (typep token 'babel-encodings::code-point)
38
               (code-char token)
39
               (if *read-suppress*
40
                   nil
41
                   (simple-reader-error
42
                    stream "Unrecognized character name: u~A" token))))
43
         (funcall original-reader
44
                  (make-concatenated-stream (make-string-input-stream
45
                                             (string 1st-char))
46
                                            stream)
47
                  char
48
                  numarg))))
49
 
50
 ;;; Allegro's PEEK-CHAR seems broken in some situations, and the code
51
 ;;; above would generate an error about too many calls to UNREAD-CHAR.
52
 ;;; Then Allegro's original SHARP-BACKSLASH wants to UNREAD-CHAR
53
 ;;; twice, very weird.  This is the best workaround I could think of.
54
 ;;; It sucks.
55
 #+allegro
56
 (defun sharp-backslash-reader (original-reader stream char numarg)
57
   (let* ((1st-char (read-char stream))
58
          (rest (ignore-errors (excl::read-extended-token stream)))
59
          (code (when (and rest (char-equal 1st-char #\u))
60
                  (ignore-errors (parse-integer rest :radix 16)))))
61
     (if code
62
         (code-char code)
63
         (with-input-from-string
64
             (s (concatenate 'string "#\\" (string 1st-char) rest))
65
           (read-char s)
66
           (read-char s)
67
           (funcall original-reader s char numarg)))))
68
 
69
 (defun make-sharp-backslash-reader ()
70
   (let ((original-sharp-backslash (get-dispatch-macro-character #\# #\\)))
71
     (lambda (stream char numarg)
72
       (sharp-backslash-reader original-sharp-backslash stream char numarg))))
73
 
74
 (defmacro enable-sharp-backslash-syntax ()
75
   `(eval-when (:compile-toplevel :execute)
76
      (setf *readtable* (copy-readtable *readtable*))
77
      (set-sharp-backslash-syntax-in-readtable)
78
      (values)))
79
 
80
 (defun set-sharp-backslash-syntax-in-readtable ()
81
   (set-dispatch-macro-character #\# #\\ (make-sharp-backslash-reader))
82
   (values))