Changeset 11639


Ignore:
Timestamp:
Jan 22, 2009, 12:17:53 AM (11 years ago)
Author:
gb
Message:

Define *CASE-SENSITIVE-FILESYSTEM*, default it to T.
Usee it to determine whether EQUAL and CCL::PATH-STR-MATCH-P (at least) do
case-sensitive comparisons of pathname components.
Of course, whehter or not a filesystem is case-sensitive is an attribute
of the filesystem and not of the value of a lisp variable; this variable
really controls nothing more than whether or not the implementation assumes
that the filesystems it encounters are case-sensitive or not, and therefore
whether or not comparisons of pathname components should fold case or not.

This is a hack, which might disappear if a better way of solving the problem
it's trying to solve becomes apparent.

Location:
trunk/source
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/l0-init.lisp

    r11425 r11639  
    166166(defvar *nx-debug* 1)
    167167
     168(defparameter *case-sensitive-filesystem* t)
     169
    168170;;; end
  • trunk/source/level-0/l0-pred.lisp

    r11063 r11639  
    383383                           (declare (fixnum x-size skip))
    384384                           (when (= x-size (the fixnum (uvsize y)))
    385                              (do* ((i 1 (1+ i)))
    386                                   ((= i x-size) t)
    387                                (declare (fixnum i))
    388                                (unless (or (= i skip)
    389                                            (equal (%svref x i) (%svref y i)))
    390                                  (return)))))))))))))
     385                             (if *case-sensitive-filesystem*
     386                               (do* ((i 1 (1+ i)))
     387                                    ((= i x-size) t)
     388                                 (declare (fixnum i))
     389                                 (unless (or (= i skip)
     390                                             (equal (%svref x i) (%svref y i)))
     391                                   (return)))
     392                                                              (do* ((i 1 (1+ i)))
     393                                    ((= i x-size) t)
     394                                 (declare (fixnum i))
     395                                 (unless (or (= i skip)
     396                                             (equalp (%svref x i) (%svref y i)))
     397                                   (return))))))))))))))
    391398
    392399#+ppc32-target
  • trunk/source/level-1/l1-pathnames.lisp

    r10942 r11639  
    581581                (return)))))))))
    582582
     583
    583584(defun path-str-match-p (pattern str p-start s-start p-end s-end)
    584585  (declare (fixnum p-start s-start p-end s-end)
     
    593594        (return nil))
    594595      (let ((p (%scharcode pattern p-start)))
     596        (unless *case-sensitive-filesystem*
     597          (setq p (%char-code-upcase p)))
    595598        (when (eq p esc)
    596599          (when (eq (setq p-start (1+ p-start)) p-end)
    597600            (return nil))
    598           (setq p (%scharcode pattern p-start)))
    599         (unless (eq p (%scharcode str s-start))
    600           (return nil))
     601          (setq p (%scharcode pattern p-start))
     602          (unless *case-sensitive-filesystem*
     603            (setq p (%char-code-upcase p))))
     604        (let* ((q (%scharcode str s-start)))
     605          (unless *case-sensitive-filesystem*
     606            (setq q (%char-code-upcase q)))
     607          (unless (eq p q)
     608            (return nil)))
    601609        (setq p-start (1+ p-start))
    602610        (setq s-start (1+ s-start))))))
Note: See TracChangeset for help on using the changeset viewer.