[Git][cmucl/cmucl][master] 2 commits: Fix #193: Treat NIL and :UNSPECIFIC as equivalent in pathnames

[Raymond Toy (@rtoy)]

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/48aa21e0b2ff64c1db1688b5831833367d869c25...9eec4ee51e7a61af074f546ac0ff8727a2d71155

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/48aa21e0b2ff64c1db1688b5831833367d869c25...9eec4ee51e7a61af074f546ac0ff8727a2d71155
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230430/9be40ff3/attachment-0001.html>