Raymond Toy pushed to branch master at cmucl / cmucl Commits: 3154df47 by Raymond Toy at 2023-04-30T13:54:45+00:00 Fix #193: Treat NIL and :UNSPECIFIC as equivalent in pathnames - - - - - 9eec4ee5 by Raymond Toy at 2023-04-30T13:55:56+00:00 Merge branch 'issue-193-nil-unspecific-equivalent' into 'master' Fix #193: Treat NIL and :UNSPECIFIC as equivalent in pathnames Closes #193 See merge request cmucl/cmucl!144 - - - - - 2 changed files: - src/code/pathname.lisp - tests/issues.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -496,14 +496,22 @@ (cons (and (consp that) (compare-component (car this) (car that)) - (compare-component (cdr this) (cdr that))))))) + (compare-component (cdr this) (cdr that)))) + (symbol + ;; Handle NIL and :UNSPECIFIC as being equivalent + (or (and (eq this :unspecific) + (null that)) + (and (null this) + (eq that :unspecific))))))) ;; Compare the version component. We treat NIL to be EQUAL to -;; :NEWEST. +;; :NEWEST or :UNSPECIFIC. (defun compare-version-component (this that) (or (eql this that) - (and (null this) (eq that :newest)) - (and (null that) (eq this :newest)))) + (if (and (member this '(nil :newest :unspecific) :test #'eq) + (member that '(nil :newest :unspecific) :test #'eq)) + t + nil)))  ;;;; Pathname functions. ===================================== tests/issues.lisp ===================================== @@ -944,3 +944,36 @@ (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent)) (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent)) (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent)))) + +(define-test issue.192.device + (assert-true (equal (make-pathname :device :unspecific) + (make-pathname :device nil))) + (assert-true (equal (make-pathname :device nil) + (make-pathname :device :unspecific)))) + +(define-test issue.192.name + (assert-true (equal (make-pathname :name :unspecific) + (make-pathname :name nil))) + (assert-true (equal (make-pathname :name nil) + (make-pathname :name :unspecific)))) + +(define-test issue.192.type + (assert-true (equal (make-pathname :type :unspecific) + (make-pathname :type nil))) + (assert-true (equal (make-pathname :type nil) + (make-pathname :type :unspecific)))) + +(define-test issue.192.version + (assert-true (equal (make-pathname :version :newest) + (make-pathname :version nil))) + (assert-true (equal (make-pathname :version nil) + (make-pathname :version :newest))) + (assert-true (equal (make-pathname :version :unspecific) + (make-pathname :version nil))) + (assert-true (equal (make-pathname :version nil) + (make-pathname :version :unspecific))) + (assert-true (equal (make-pathname :version :unspecific) + (make-pathname :version :newest))) + (assert-true (equal (make-pathname :version :newest) + (make-pathname :version :unspecific))) +) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/48aa21e0b2ff64c1db1688b... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/48aa21e0b2ff64c1db1688b... You're receiving this email because of your account on gitlab.common-lisp.net.