Changeset 15601 for trunk/source/level-0


Ignore:
Timestamp:
Jan 21, 2013, 6:21:56 PM (6 years ago)
Author:
gb
Message:

Logical host names aren't case-sensitive in CCL; don't hash logical
pathnames (or compare them with EQUAL) as if they were.

Location:
trunk/source/level-0
Files:
2 edited

Legend:

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

    r15596 r15601  
    324324      (if logical
    325325        (progn
    326           (incorporate (%logical-pathname-host key))
     326          (setq hash (%%equalphash (%logical-pathname-host key)))
    327327          (incorporate (%logical-pathname-version key)))
    328328        (incorporate (%physical-pathname-device key)))
  • trunk/source/level-0/l0-pred.lisp

    r15597 r15601  
    282282    (equal (cdr x) (cdr y))))
    283283
     284(defun %pathname-equal (x y logical-p)
     285  (if (or (not logical-p)
     286          (and (equalp (%logical-pathname-host x) (%logical-pathname-host y))
     287               (eql (%logical-pathname-version x) (%logical-pathname-version y))))
     288    (cond (*case-sensitive-filesystem*
     289           (and (equal (%pathname-name x) (%pathname-name y))
     290                (equal (%pathname-type x) (%pathname-type y))
     291                (do* ((xdir (%pathname-directory x) (cdr xdir))
     292                      (ydir (%pathname-directory y) (cdr ydir)))
     293                     ((null xdir) (null ydir))
     294                  (unless (equal (car xdir) (car ydir))
     295                    (return)))))
     296          (t
     297           (and (equalp (%pathname-name x) (%pathname-name y))
     298                (equalp (%pathname-type x) (%pathname-type y))
     299                (do* ((xdir (%pathname-directory x) (cdr xdir))
     300                      (ydir (%pathname-directory y) (cdr ydir)))
     301                     ((null xdir) (null ydir))
     302                  (unless (equalp (car xdir) (car ydir))
     303                    (return))))))))
     304           
    284305(defun hairy-equal (x y)
    285306  (declare (optimize (speed 3)))
     
    345366      (if (= x-type y-type)
    346367        (if (= x-type target::subtag-istruct)
    347           (and (let* ((structname (istruct-cell-name (%svref x 0))))
    348                  (and (eq structname  (istruct-cell-name (%svref y 0)))
    349                       (or (eq structname 'pathname)
    350                           (eq structname 'logical-pathname))
    351                       (locally
    352                           (declare (optimize (speed 3) (safety 0)))
    353                         (let* ((x-size (uvsize x))
    354                                (skip (if (eq structname 'pathname)
    355                                        %physical-pathname-version
    356                                        -1)))
    357                           (declare (fixnum x-size skip))
    358                           (when (= x-size (the fixnum (uvsize y)))
    359                             (if *case-sensitive-filesystem*
    360                               (do* ((i 1 (1+ i)))
    361                                    ((= i x-size) t)
    362                                 (declare (fixnum i))
    363                                 (unless (or (= i skip)
    364                                             (equal (%svref x i) (%svref y i)))
    365                                   (return)))
    366                               (do* ((i 1 (1+ i)))
    367                                    ((= i x-size) t)
    368                                 (declare (fixnum i))
    369                                 (unless (or (= i skip)
    370                                             (equalp (%svref x i) (%svref y i)))
    371                                   (return)))))))))))))))
     368          (let* ((structname (istruct-cell-name (%svref x 0))))
     369            (if (eq structname (istruct-cell-name (%svref y 0)))
     370              (if (eq structname 'pathname)
     371                (%pathname-equal x y nil)
     372                (if (eq structname 'logical-pathname)
     373                  (%pathname-equal x y t))))))))))
    372374
    373375#+(or ppc32-target arm-target)
Note: See TracChangeset for help on using the changeset viewer.