Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • src/code/pathname.lisp
    ... ... @@ -843,8 +843,11 @@ a host-structure or string."
    843 843
         (flet ((check-component-validity (name name-or-type)
    
    844 844
     	     (when (stringp name)
    
    845 845
     	       (when (eq host (%pathname-host *default-pathname-defaults*))
    
    846
    -		 (when (or (find #\/ name :test #'char=)
    
    847
    -			   (find #\nul name :test #'char=))
    
    846
    +		 (when (find-if #'(lambda (c)
    
    847
    +				    ;; Illegal characters are a slash or NUL.
    
    848
    +				    (or (char= c #\/)
    
    849
    +					(char= c #\nul)))
    
    850
    +				name)
    
    848 851
     		   (cerror _"Continue anyway"
    
    849 852
     			   _"Pathname component ~A cannot contain a slash or nul character: ~S"
    
    850 853
     			   name-or-type name))))))
    

  • tests/pathname.lisp
    ... ... @@ -142,3 +142,28 @@
    142 142
                                                   "/*.*")
    
    143 143
                                      :truenamep nil :follow-links nil)))
    
    144 144
           (assert-equal dir-tilde dir-home))))
    
    145
    +
    
    146
    +(define-test issue.454.illegal-pathname-chars
    
    147
    +    (:tag :issues)
    
    148
    +  ;; A slash (Unix directory separater) is not allowed.
    
    149
    +  (assert-error 'simple-error
    
    150
    +		(make-pathname :name "a/b"))
    
    151
    +  (assert-error 'simple-error
    
    152
    +		(make-pathname :type "a/b"))
    
    153
    +  (assert-error 'simple-error
    
    154
    +		(make-pathname :directory '(:relative "a/b")))
    
    155
    +  ;; ASCII NUL characters are not allowed in Unix pathnames.
    
    156
    +  (let ((string-with-nul (concatenate 'string "a" (string #\nul) "b")))
    
    157
    +    (assert-error 'simple-error
    
    158
    +		  (make-pathname :name string-with-nul))
    
    159
    +    (assert-error 'simple-error
    
    160
    +		  (make-pathname :type string-with-nul))
    
    161
    +    (assert-error 'simple-error
    
    162
    +		  (make-pathname :directory (list :relative string-with-nul)))))
    
    163
    +  
    
    164
    +(define-test issue.454.illegal-pathname-dot
    
    165
    +    (:tag :issues)
    
    166
    +  (assert-error 'simple-error
    
    167
    +		(make-pathname :name "."))
    
    168
    +  (assert-error 'simple-error
    
    169
    +		(make-pathname :name "..")))