Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl Commits: 9e279ba7 by Raymond Toy at 2025-11-15T07:20:05-08:00 Signal error not cerror for make-pathname errors - - - - - b2c51c98 by Raymond Toy at 2025-11-15T07:20:39-08:00 Add tests for make-pathname errors - - - - - 2 changed files: - src/code/pathname.lisp - tests/pathname.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -843,8 +843,11 @@ a host-structure or string." (flet ((check-component-validity (name name-or-type) (when (stringp name) (when (eq host (%pathname-host *default-pathname-defaults*)) - (when (or (find #\/ name :test #'char=) - (find #\nul name :test #'char=)) + (when (find-if #'(lambda (c) + ;; Illegal characters are a slash or NUL. + (or (char= c #\/) + (char= c #\nul))) + name) (cerror _"Continue anyway" _"Pathname component ~A cannot contain a slash or nul character: ~S" name-or-type name)))))) ===================================== tests/pathname.lisp ===================================== @@ -142,3 +142,28 @@ "/*.*") :truenamep nil :follow-links nil))) (assert-equal dir-tilde dir-home)))) + +(define-test issue.454.illegal-pathname-chars + (:tag :issues) + ;; A slash (Unix directory separater) is not allowed. + (assert-error 'simple-error + (make-pathname :name "a/b")) + (assert-error 'simple-error + (make-pathname :type "a/b")) + (assert-error 'simple-error + (make-pathname :directory '(:relative "a/b"))) + ;; ASCII NUL characters are not allowed in Unix pathnames. + (let ((string-with-nul (concatenate 'string "a" (string #\nul) "b"))) + (assert-error 'simple-error + (make-pathname :name string-with-nul)) + (assert-error 'simple-error + (make-pathname :type string-with-nul)) + (assert-error 'simple-error + (make-pathname :directory (list :relative string-with-nul))))) + +(define-test issue.454.illegal-pathname-dot + (:tag :issues) + (assert-error 'simple-error + (make-pathname :name ".")) + (assert-error 'simple-error + (make-pathname :name ".."))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a8805... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a8805... You're receiving this email because of your account on gitlab.common-lisp.net.