X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-sxhash.lisp;h=953160b33049dc57da29ea689aa229c18f79e35c;hb=0c08cc954cc0910079bdcf153cccf9a95ef11d67;hp=943ed0c62c8e18c0a24a3a919ac74231abc31e51;hpb=08917ec0d00a781a1089922a5419b7f136cdf08f;p=sbcl.git

diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp
index 943ed0c..953160b 100644
--- a/src/code/target-sxhash.lisp
+++ b/src/code/target-sxhash.lisp
@@ -183,12 +183,27 @@
                              (sxhash-recurse (cdr x) (1- depthoid)))
                         261835505)))
                (instance
-                (if (or (typep x 'structure-object) (typep x 'condition))
-                    (logxor 422371266
-                            (sxhash ; through DEFTRANSFORM
-                             (classoid-name
-                              (layout-classoid (%instance-layout x)))))
-                    (sxhash-instance x)))
+                (if (pathnamep x)
+                    ;; Pathnames are EQUAL if all the components are EQUAL, so
+                    ;; we hash all of the components of a pathname together.
+                    (let ((hash (sxhash-recurse (pathname-host x) depthoid)))
+                      (mixf hash (sxhash-recurse (pathname-device x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-directory x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-name x) depthoid))
+                      (mixf hash (sxhash-recurse (pathname-type x) depthoid))
+                      ;; Hash :NEWEST the same as NIL because EQUAL for
+                      ;; pathnames assumes that :newest and nil are equal.
+                      (let ((version (%pathname-version x)))
+                        (mixf hash (sxhash-recurse (if (eq version :newest)
+                                                       nil
+                                                       version)
+                                                   depthoid))))
+                    (if (or (typep x 'structure-object) (typep x 'condition))
+                        (logxor 422371266
+                                (sxhash ; through DEFTRANSFORM
+                                 (classoid-name
+                                  (layout-classoid (%instance-layout x)))))
+                        (sxhash-instance x))))
                (symbol (sxhash x)) ; through DEFTRANSFORM
                (array
                 (typecase x