Changeset 12764


Ignore:
Timestamp:
Sep 4, 2009, 11:04:39 PM (10 years ago)
Author:
gb
Message:

ticket:524 : CHARACTER signals a TYPE-ERROR if its argument isn't a
character designator. Integers aren't character designators and never
have been (at least in ANSI CL.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/chars.lisp

    r12259 r12764  
    1818(in-package "CCL")
    1919
    20 ; If object is a character, it is returned.  If it is an integer, its INT-CHAR
    21 ; is returned. If it is a string of length 1, then the sole element of the
    22 ; string is returned.  If it is a symbol whose pname is of length 1, then
    23 ; the sole element of the pname is returned. Else error.
     20(defun character-designator-p (thing)
     21  (or (typep thing 'character)
     22      (typep thing '(string 1))
     23      (and (typep thing 'symbol) (typep (symbol-name thing) '(string 1)))))
     24
     25;;; If object is a character, it is returned.  If it is a string of
     26;;; length 1, then the sole element of the string is returned.  If it
     27;;; is a symbol whose pname is of length 1, then the sole element of
     28;;; the pname is returned. Else error.
    2429
    2530(defun character (arg)
     
    2833  (if (typep arg 'character)
    2934    arg
    30     (if (typep arg 'fixnum)
    31       (code-char arg)
    32       (if (and (typep arg 'string)
    33                (= (the fixnum (length arg)) 1))
    34         (char arg 0)
    35         (let* ((pname (if (typep arg 'symbol) (symbol-name arg))))
    36           (if (and pname (= (the fixnum (length pname)) 1))
    37             (char pname 0)
    38             (%err-disp $xcoerce arg 'character)))))))
     35    (if (and (typep arg 'string)
     36             (= (the fixnum (length arg)) 1))
     37      (char arg 0)
     38      (let* ((pname (if (typep arg 'symbol) (symbol-name arg))))
     39        (if (and pname (= (the fixnum (length pname)) 1))
     40          (char pname 0)
     41          (report-bad-arg arg '(satisfies character-designator-p)))))))
    3942
    4043
Note: See TracChangeset for help on using the changeset viewer.