GitLab

at 2026-01-02T14:27:25-08:00

Fix #454 and #138:  Signal errors for bad components for make-pathname

Merge branch 'issue-454-signal-error-for-bad-pathname-parts' into 'master'

Fix #454 and #138:  Signal errors for bad components for make-pathname

Closes #454 and #138

See merge request cmucl/cmucl!333
 			       (%pathname-directory defaults)

 			       diddle-defaults)))

 

-    ;; A bit of sanity checking on user arguments.

+    ;; A bit of sanity checking on user arguments.  We don't allow a

+    ;; "/" or NUL in any string that's part of a pathname object.

     (flet ((check-component-validity (name name-or-type)

 	     (when (stringp name)

-	       (let ((unix-directory-separator #\/))

-		 (when (eq host (%pathname-host *default-pathname-defaults*))

-		   (when (find unix-directory-separator name)

-		     (warn (intl:gettext "Silly argument for a unix ~A: ~S")

-			   name-or-type name)))))))

+	       (when (eq host (%pathname-host *default-pathname-defaults*))

+		 (when (some #'(lambda (c)

+				 ;; Illegal characters are a slash or NUL.

+				 (case c

+				   ((#\/ #\null) t)))

+				name)

+		   (error _"Pathname component ~A cannot contain a slash or nul character: ~S"

+			   name-or-type name))))))

       (check-component-validity name :pathname-name)

       (check-component-validity type :pathname-type)

       (mapc #'(lambda (d)

 			  (not type))

 		     (and (string= name ".")

 			  (not type))))

-	;; 

-	(warn (intl:gettext "Silly argument for a unix PATHNAME-NAME: ~S") name)))

+	;;

+	(cerror _"Continue anyway"

+		_"PATHNAME-NAME cannot be \".\" or \"..\"")))

 

     ;; More sanity checking

     (when dir

 msgid ", type="

 msgstr ""

 

-#: src/code/print.lisp

+#: src/code/pathname.lisp src/code/print.lisp

 msgid "Continue anyway"

 msgstr ""

 

 msgstr ""

 

 #: src/code/pathname.lisp

-msgid ""

-"Makes a new pathname from the component arguments.  Note that host is\n"

-"a host-structure or string."

+msgid "Pathname component ~A cannot contain a slash or nul character: ~S"

 msgstr ""

 

 #: src/code/pathname.lisp

-msgid "Silly argument for a unix ~A: ~S"

+msgid "PATHNAME-NAME cannot be \".\" or \"..\""

 msgstr ""

 

 #: src/code/pathname.lisp

-msgid "Silly argument for a unix PATHNAME-NAME: ~S"

+msgid ""

+"Makes a new pathname from the component arguments.  Note that host is\n"

+"a host-structure or string."

 msgstr ""

 

 #: src/code/pathname.lisp

       ;; Now recursively delete the directory.

       (assert-true (ext:delete-directory (merge-pathnames "tmp/" path)

 					 :recursive t))

-      (assert-false (directory "tmp/")))))
+      (assert-false (directory (merge-pathnames "tmp/" path))))))

+

+(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 "..")))

+

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

3 changed files:

Changes: