Changeset 6124


Ignore:
Timestamp:
Apr 4, 2007, 3:26:04 AM (12 years ago)
Author:
gb
Message:

Handle missing brackets in UNESCAPE-FOREIGN-NAME.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/objc-gf/ccl/lib/db-io.lisp

    r6103 r6124  
    14351435                   (string-downcase key)
    14361436                   (string key)))
    1437          (nbrackets (count #\< string)))
    1438     (declare (fixnum nbrackets))
     1437         (nleftbrackets (count #\< string))
     1438         (nrightbrackets (count #\> string))
     1439         (nbrackets (+ nleftbrackets nrightbrackets)))
     1440    (declare (fixnum nleftbrackets nrightbrackets nbrackets))
    14391441    (if (zerop nbrackets)
    14401442      string
    1441       (let* ((len (length string))
    1442              (out (make-string (- len (* 2 nbrackets))))
    1443              (j 0)
    1444              (state :lower))
    1445         (dotimes (i len out)
    1446           (let* ((ch (schar string i)))
    1447             (if (or (and (eq ch #\<)
    1448                          (eq state :upper))
    1449                     (and (eq ch #\>)
    1450                          (eq state :lower)))
    1451               (error "Mismatched brackets in ~s." key))
    1452             (case ch
    1453               (#\< (setq state :upper))
    1454               (#\> (setq state :lower))
    1455               (t (setf (schar out j) (if (eq state :upper)
    1456                                        (char-upcase ch)
    1457                                        (char-downcase ch))
    1458                        j (1+ j))))))))))
     1443      (if (/= nleftbrackets nrightbrackets)
     1444        (error "Mismatched brackets in ~s." key)
     1445        (let* ((len (length string))
     1446               (out (make-string (- len nbrackets)))
     1447               (j 0)
     1448               (state :lower))
     1449          (dotimes (i len out)
     1450            (let* ((ch (schar string i)))
     1451              (if (or (and (eq ch #\<)
     1452                           (eq state :upper))
     1453                      (and (eq ch #\>)
     1454                           (eq state :lower)))
     1455                (error "Mismatched brackets in ~s." key))
     1456              (case ch
     1457                (#\< (setq state :upper))
     1458                (#\> (setq state :lower))
     1459                (t (setf (schar out j) (if (eq state :upper)
     1460                                         (char-upcase ch)
     1461                                         (char-downcase ch))
     1462                         j (1+ j)))))))))))
    14591463
    14601464       
Note: See TracChangeset for help on using the changeset viewer.