Raymond Toy pushed to branch issue-266-b-tilde-pathname-support at cmucl / cmucl Commits: e0ae2ea6 by Raymond Toy at 2023-12-07T14:49:30-08:00 Update release notes - - - - - 7ab1964d by Raymond Toy at 2023-12-07T14:49:48-08:00 Add tests for ~user in pathnames - - - - - 4f64fc56 by Raymond Toy at 2023-12-07T14:50:04-08:00 Update tests for changes in get-user-homedir-namestring The function name has changed and we return a namestring instead of a pathname. - - - - - 3 changed files: - src/general-info/release-21f.md - tests/os.lisp - tests/pathname.lisp Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -39,6 +39,7 @@ public domain. * ~~#253~~ Block-compile list-to-hashtable and callers * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory + * ~~#266~~ Support "~user" in namestrings * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/os.lisp ===================================== @@ -7,7 +7,7 @@ (define-test user-homedir.1 "Test user-homedir" (:tag :issues) - ;; Simple test to see if get-user-homedir-pathname returns the + ;; Simple test to see if get-user-homedir-namestring returns the ;; expected value. Use getuid and getpwuid to figure out what the ;; name and home directory should be. (let* ((uid (unix:unix-getuid)) @@ -15,15 +15,13 @@ (assert-true uid) (assert-true user-info) (let* ((info-dir (unix:user-info-dir user-info)) - (info-name (unix:user-info-name user-info)) - (expected-home-pathname (pathname - (concatenate 'string info-dir "/")))) - (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname info-name) + (info-name (unix:user-info-name user-info))) + (multiple-value-bind (home-namestring status) + (system:get-user-homedir-namestring info-name) (assert-true info-dir) (assert-true info-name) - (assert-equal home-pathname expected-home-pathname) + (assert-equal home-namestring info-dir) (assert-eql status 0))))) (define-test user-homedir.2 @@ -33,6 +31,6 @@ ;; value for a user that does not exist. Well, we assume such a ;; user doesn't exist. (multiple-value-bind (home-pathname status) - (system:get-user-homedir-pathname "zotuserunknown") + (system:get-user-homedir-namestring "zotuserunknown") (assert-eql home-pathname nil) (assert-eql status 0))) ===================================== tests/pathname.lisp ===================================== @@ -111,3 +111,34 @@ test (assert-equal printed-value (output pathname)) (assert-equal namestring (namestring pathname)))))) + +(define-test issue.266.pathname-tilde.unknown-user + (:tag :issues) + ;; This assumes that there's no user named "zotunknown". + (assert-error 'simple-error (parse-namestring "~zotunknown/*.*"))) + +(define-test issue.266.pathname-tilde.1 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". + (let ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + (dir-tilde (directory #p"~/*.*" :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home))) + +(define-test issue.266.pathname-tilde.2 + (:tag :issues) + ;; Simple test for ~ in pathnames. Get a directory list using + ;; #P"~user/*.*". This should produce exactly the same list as the + ;; #search-list P"home:*.*". We determine the user name via getuid + ;; #and getpwuid. + (let ((user-name (unix:user-info-name (unix:unix-getpwuid (unix:unix-getuid))))) + (assert-true user-name) + (let* ((dir-home (directory #p"home:*.*" :truenamep nil :follow-links nil)) + + (dir-tilde (directory (concatenate 'string + "~" + user-name + "/*.*") + :truenamep nil :follow-links nil))) + (assert-equal dir-tilde dir-home)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1cd91a3d39ab5e69f405e27... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1cd91a3d39ab5e69f405e27... You're receiving this email because of your account on gitlab.common-lisp.net.