Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl
Commits:
2575887d by Raymond Toy at 2023-11-30T15:16:43-08:00
Update release notes
- - - - -
3561af64 by Raymond Toy at 2023-11-30T15:16:52-08:00
Add test for ~ in pathnames.
Just get the directory list for #P"~/*.*" and #P"home:". They should
be identical.
- - - - -
2 changed files:
- src/general-info/release-21f.md
- 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 ~ in pathnames like a shell
* Other changes:
* Improvements to the PCL implementation of CLOS:
* Changes to building procedure:
=====================================
tests/pathname.lisp
=====================================
@@ -111,3 +111,12 @@
test
(assert-equal printed-value (output pathname))
(assert-equal namestring (namestring pathname))))))
+
+(define-test issue.266.pathname-tilde
+ (:tag :issues)
+ ;; Simple test for ~ in pathnames. Get the directory list using
+ ;; #P"~/*.*". This should be equal to the directory using the
+ ;; search-list #P"home:*.*".
+ (let ((dir-home (directory #P"home:*.*"))
+ (dir-tilde (directory #P"~/*.*")))
+ (assert-equal dir-tilde dir-home)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/efc75c10eb0e38f38b997f…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/efc75c10eb0e38f38b997f…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl
Commits:
efc75c10 by Raymond Toy at 2023-11-30T06:38:57-08:00
Use new system:get-user-homedir-pathname
Update `user-homedir-namestring` to use
`system:get-user-homedir-pathname`. This also means removing
`unix:unix-getpwnam-tmp` from filesys.lisp.
- - - - -
3 changed files:
- src/code/filesys.lisp
- src/code/unix.lisp
- src/i18n/locale/cmucl.pot
Changes:
=====================================
src/code/filesys.lisp
=====================================
@@ -1085,12 +1085,16 @@ optionally keeping some of the most recent old versions."
hash))))
(defun user-homedir-namestring (&optional username)
+ "Returns the namestring for the user's home directory. If Username is
+ not specified, then use the current user."
(flet ((unix-user-homedir (username)
- (let ((user-info (unix::unix-getpwnam-tmp username)))
- (if user-info (unix:user-info-dir user-info))))
+ (let ((user-homedir (system:get-user-homedir-pathname username)))
+ (when user-homedir
+ (namestring user-homedir))))
(unix-uid-homedir (uid)
(let ((user-info (unix::unix-getpwuid uid)))
- (if user-info (unix:user-info-dir user-info)))))
+ (when user-info
+ (unix:user-info-dir user-info)))))
(if username
(unix-user-homedir username)
(let ((env-home (unix:unix-getenv "HOME")))
=====================================
src/code/unix.lisp
=====================================
@@ -2644,37 +2644,6 @@
:shell (string (cast (slot result 'pw-shell) c-call:c-string)))
(values nil returned)))))
-#+linux
-(defun unix-getpwnam-tmp (login)
- "Return a USER-INFO structure for the user identified by LOGIN, or NIL if not found."
- (declare (type simple-string login))
- (with-alien ((buf (array c-call:char 1024))
- (user-info (struct passwd))
- (result (* (struct passwd))))
- (let ((returned
- (alien-funcall
- (extern-alien "getpwnam_r"
- (function c-call:int
- c-call:c-string
- (* (struct passwd))
- (* c-call:char)
- c-call:unsigned-int
- (* (* (struct passwd)))))
- login
- (addr user-info)
- (cast buf (* c-call:char))
- 1024
- (addr result))))
- (when (zerop returned)
- (make-user-info
- :name (string (cast (slot result 'pw-name) c-call:c-string))
- :password (string (cast (slot result 'pw-passwd) c-call:c-string))
- :uid (slot result 'pw-uid)
- :gid (slot result 'pw-gid)
- :gecos (string (cast (slot result 'pw-gecos) c-call:c-string))
- :dir (string (cast (slot result 'pw-dir) c-call:c-string))
- :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))))
-
;;; Getrusage is not provided in the C library on Solaris 2.4, and is
;;; rather slow on later versions so the "times" system call is
;;; provided.
=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -10120,6 +10120,12 @@ msgid ""
"optionally keeping some of the most recent old versions."
msgstr ""
+#: src/code/filesys.lisp
+msgid ""
+"Returns the namestring for the user's home directory. If Username is\n"
+" not specified, then use the current user."
+msgstr ""
+
#: src/code/filesys.lisp
msgid ""
"Returns the home directory of the logged in user as a pathname.\n"
@@ -21329,6 +21335,10 @@ msgstr ""
msgid "Implements FILE-POSITION for the stream for setting the position."
msgstr ""
+#: src/pcl/gray-streams.lisp
+msgid "Implements FILE-LENGTH for the stream."
+msgstr ""
+
#: src/pcl/gray-streams.lisp
msgid ""
"Used by READ-BYTE; returns either an integer, or the symbol :EOF\n"
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f6…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/efc75c10eb0e38f38b997f6…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl
Commits:
a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00
Fix #269: Add function to get user's home directory
- - - - -
8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00
Merge branch 'issue-269-unix-get-user-homedir' into 'master'
Fix #269: Add function to get user's home directory
Closes #269
See merge request cmucl/cmucl!178
- - - - -
8fe17e76 by Raymond Toy at 2023-11-30T05:48:49-08:00
Merge branch 'master' into issue-266-tilde-pathname-support
- - - - -
6 changed files:
- src/code/exports.lisp
- src/code/os.lisp
- src/general-info/release-21f.md
- src/i18n/locale/cmucl-os.pot
- src/lisp/os-common.c
- + tests/os.lisp
Changes:
=====================================
src/code/exports.lisp
=====================================
@@ -2074,6 +2074,7 @@
"FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS"
"FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS"
"GET-PAGE-SIZE" "GET-SYSTEM-INFO"
+ "GET-USER-HOMEDIR-PATHNAME"
"IGNORE-INTERRUPT"
"INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"
"LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
=====================================
src/code/os.lisp
=====================================
@@ -57,3 +57,33 @@
(error (intl:gettext "Unix system call getrusage failed: ~A.")
(unix:get-unix-error-msg utime)))
(values utime stime major-fault))))
+
+;;; GET-USER-HOMEDIR-PATHNAME -- Public
+;;;
+(defun get-user-homedir-pathname (name)
+ _N"Get the user home directory for user named NAME. Two values are
+ returned: the pathname of the home directory and a status code. If
+ the home directory does not exist NIL is returned. The status is 0
+ if no errors occurred. Otherwise a non-zero value is returned.
+ Examining errno may give information about what failed."
+ (alien:with-alien ((status c-call:int))
+ (let (result)
+ (unwind-protect
+ (progn
+ (setf result
+ (alien:alien-funcall
+ (alien:extern-alien "os_get_user_homedir"
+ (function (alien:* c-call:c-string)
+ c-call:c-string
+ (* c-call:int)))
+ name
+ (alien:addr status)))
+ (if (and (zerop status)
+ (not (alien:null-alien result)))
+ (values (pathname
+ (concatenate 'string
+ (alien:cast result c-call:c-string)
+ "/"))
+ status)
+ (values nil status)))
+ (alien:free-alien result)))))
=====================================
src/general-info/release-21f.md
=====================================
@@ -38,6 +38,7 @@ public domain.
* ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86
* ~~#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
* Other changes:
* Improvements to the PCL implementation of CLOS:
* Changes to building procedure:
=====================================
src/i18n/locale/cmucl-os.pot
=====================================
@@ -33,3 +33,12 @@ msgstr ""
msgid "Unix system call getrusage failed: ~A."
msgstr ""
+#: src/code/os.lisp
+msgid ""
+"Get the user home directory for user named NAME. Two values are\n"
+" returned: the pathname of the home directory and a status code. If\n"
+" the home directory does not exist NIL is returned. The status is 0\n"
+" if no errors occurred. Otherwise a non-zero value is returned.\n"
+" Examining errno may give information about what failed."
+msgstr ""
+
=====================================
src/lisp/os-common.c
=====================================
@@ -863,3 +863,74 @@ os_software_version(void)
return result;
}
+
+/*
+ * Return the home directory of the user named NAME. If the user does
+ * not exist, returns NULL. Also returns NULL if the home directory
+ * cannot be determined for any reason. The parameter STATUS is 0 if
+ * getpwnam_r was successful. Otherwise it is the return value from
+ * getpwnam_r or -1 if we ran out of memory for the buffer.
+ */
+char *
+os_get_user_homedir(const char* name, int *status)
+{
+ int buflen;
+ char *buf = NULL;
+ struct passwd pwd;
+ struct passwd *result;
+
+ buflen = sysconf(_SC_GETPW_R_SIZE_MAX);
+ /*
+ * If sysconf failed, just try some possibly large enough value.
+ */
+ if (buflen == -1) {
+ buflen = 1024;
+ }
+
+ /*
+ * sysconf may return a value that is not large enough, so start
+ * with the given value and keep increasing it until we reach some
+ * upper limit and give up.
+ */
+ while (buflen <= (1 << 20)) {
+ buf = realloc(buf, buflen);
+
+ if (buf == NULL) {
+ *status = -1;
+ return NULL;
+ }
+
+ *status = getpwnam_r(name, &pwd, buf, buflen, &result);
+
+ if (*status == 0) {
+ /*
+ * Success, or entry was not found. If found, the result
+ * is not NULL. Return the result or NULL
+ */
+ char* path = result ? strdup(pwd.pw_dir) : NULL;
+ free(buf);
+ return path;
+ }
+
+ /*
+ * Check errno for ERANGE. If so, the buffer was too small, so grow it.
+ */
+ if (errno == ERANGE) {
+ buflen *= 2;
+ } else {
+ /*
+ * Some other error. Just return NULL
+ */
+ free(buf);
+ return NULL;
+ }
+ }
+
+ /*
+ * Ran out of space. Just return NULL and set status to -1.
+ */
+ free(buf);
+ *status = -1;
+ return NULL;
+}
+
=====================================
tests/os.lisp
=====================================
@@ -0,0 +1,38 @@
+(defpackage :os-tests
+ (:use :cl :lisp-unit))
+
+(in-package "OS-TESTS")
+
+
+(define-test user-homedir.1
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the
+ ;; expected value. Use getuid and getpwuid to figure out what the
+ ;; name and home directory should be.
+ (let* ((uid (unix:unix-getuid))
+ (user-info (unix:unix-getpwuid uid)))
+ (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)
+ (assert-true info-dir)
+ (assert-true info-name)
+
+ (assert-equal home-pathname expected-home-pathname)
+ (assert-eql status 0)))))
+
+(define-test user-homedir.2
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the expected
+ ;; 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")
+ (assert-eql home-pathname nil)
+ (assert-eql status 0)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9536863458f79ca9d12810…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9536863458f79ca9d12810…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
a6854bb6 by Raymond Toy at 2023-11-30T13:47:10+00:00
Fix #269: Add function to get user's home directory
- - - - -
8e067da9 by Raymond Toy at 2023-11-30T13:47:20+00:00
Merge branch 'issue-269-unix-get-user-homedir' into 'master'
Fix #269: Add function to get user's home directory
Closes #269
See merge request cmucl/cmucl!178
- - - - -
6 changed files:
- src/code/exports.lisp
- src/code/os.lisp
- src/general-info/release-21f.md
- src/i18n/locale/cmucl-os.pot
- src/lisp/os-common.c
- + tests/os.lisp
Changes:
=====================================
src/code/exports.lisp
=====================================
@@ -2074,6 +2074,7 @@
"FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS"
"FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS"
"GET-PAGE-SIZE" "GET-SYSTEM-INFO"
+ "GET-USER-HOMEDIR-PATHNAME"
"IGNORE-INTERRUPT"
"INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"
"LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
=====================================
src/code/os.lisp
=====================================
@@ -57,3 +57,33 @@
(error (intl:gettext "Unix system call getrusage failed: ~A.")
(unix:get-unix-error-msg utime)))
(values utime stime major-fault))))
+
+;;; GET-USER-HOMEDIR-PATHNAME -- Public
+;;;
+(defun get-user-homedir-pathname (name)
+ _N"Get the user home directory for user named NAME. Two values are
+ returned: the pathname of the home directory and a status code. If
+ the home directory does not exist NIL is returned. The status is 0
+ if no errors occurred. Otherwise a non-zero value is returned.
+ Examining errno may give information about what failed."
+ (alien:with-alien ((status c-call:int))
+ (let (result)
+ (unwind-protect
+ (progn
+ (setf result
+ (alien:alien-funcall
+ (alien:extern-alien "os_get_user_homedir"
+ (function (alien:* c-call:c-string)
+ c-call:c-string
+ (* c-call:int)))
+ name
+ (alien:addr status)))
+ (if (and (zerop status)
+ (not (alien:null-alien result)))
+ (values (pathname
+ (concatenate 'string
+ (alien:cast result c-call:c-string)
+ "/"))
+ status)
+ (values nil status)))
+ (alien:free-alien result)))))
=====================================
src/general-info/release-21f.md
=====================================
@@ -38,6 +38,7 @@ public domain.
* ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86
* ~~#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
* Other changes:
* Improvements to the PCL implementation of CLOS:
* Changes to building procedure:
=====================================
src/i18n/locale/cmucl-os.pot
=====================================
@@ -33,3 +33,12 @@ msgstr ""
msgid "Unix system call getrusage failed: ~A."
msgstr ""
+#: src/code/os.lisp
+msgid ""
+"Get the user home directory for user named NAME. Two values are\n"
+" returned: the pathname of the home directory and a status code. If\n"
+" the home directory does not exist NIL is returned. The status is 0\n"
+" if no errors occurred. Otherwise a non-zero value is returned.\n"
+" Examining errno may give information about what failed."
+msgstr ""
+
=====================================
src/lisp/os-common.c
=====================================
@@ -863,3 +863,74 @@ os_software_version(void)
return result;
}
+
+/*
+ * Return the home directory of the user named NAME. If the user does
+ * not exist, returns NULL. Also returns NULL if the home directory
+ * cannot be determined for any reason. The parameter STATUS is 0 if
+ * getpwnam_r was successful. Otherwise it is the return value from
+ * getpwnam_r or -1 if we ran out of memory for the buffer.
+ */
+char *
+os_get_user_homedir(const char* name, int *status)
+{
+ int buflen;
+ char *buf = NULL;
+ struct passwd pwd;
+ struct passwd *result;
+
+ buflen = sysconf(_SC_GETPW_R_SIZE_MAX);
+ /*
+ * If sysconf failed, just try some possibly large enough value.
+ */
+ if (buflen == -1) {
+ buflen = 1024;
+ }
+
+ /*
+ * sysconf may return a value that is not large enough, so start
+ * with the given value and keep increasing it until we reach some
+ * upper limit and give up.
+ */
+ while (buflen <= (1 << 20)) {
+ buf = realloc(buf, buflen);
+
+ if (buf == NULL) {
+ *status = -1;
+ return NULL;
+ }
+
+ *status = getpwnam_r(name, &pwd, buf, buflen, &result);
+
+ if (*status == 0) {
+ /*
+ * Success, or entry was not found. If found, the result
+ * is not NULL. Return the result or NULL
+ */
+ char* path = result ? strdup(pwd.pw_dir) : NULL;
+ free(buf);
+ return path;
+ }
+
+ /*
+ * Check errno for ERANGE. If so, the buffer was too small, so grow it.
+ */
+ if (errno == ERANGE) {
+ buflen *= 2;
+ } else {
+ /*
+ * Some other error. Just return NULL
+ */
+ free(buf);
+ return NULL;
+ }
+ }
+
+ /*
+ * Ran out of space. Just return NULL and set status to -1.
+ */
+ free(buf);
+ *status = -1;
+ return NULL;
+}
+
=====================================
tests/os.lisp
=====================================
@@ -0,0 +1,38 @@
+(defpackage :os-tests
+ (:use :cl :lisp-unit))
+
+(in-package "OS-TESTS")
+
+
+(define-test user-homedir.1
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the
+ ;; expected value. Use getuid and getpwuid to figure out what the
+ ;; name and home directory should be.
+ (let* ((uid (unix:unix-getuid))
+ (user-info (unix:unix-getpwuid uid)))
+ (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)
+ (assert-true info-dir)
+ (assert-true info-name)
+
+ (assert-equal home-pathname expected-home-pathname)
+ (assert-eql status 0)))))
+
+(define-test user-homedir.2
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the expected
+ ;; 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")
+ (assert-eql home-pathname nil)
+ (assert-eql status 0)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b218d29ce4fdc4529f2dbe…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b218d29ce4fdc4529f2dbe…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl
Commits:
121966b8 by Raymond Toy at 2023-11-30T05:26:11-08:00
Revert changes to match master branch
- - - - -
e295afde by Raymond Toy at 2023-11-30T05:26:28-08:00
Address review comments
Remove incorrect export symbol because it's not in EXTENSIONS anymore.
- - - - -
2 changed files:
- src/code/filesys.lisp
- tests/filesys.lisp
Changes:
=====================================
src/code/filesys.lisp
=====================================
@@ -27,8 +27,7 @@
(in-package "EXTENSIONS")
(export '(print-directory complete-file ambiguous-files default-directory
- purge-backup-files file-writable unix-namestring
- get-user-homedir-pathname))
+ purge-backup-files file-writable unix-namestring))
(in-package "LISP")
=====================================
tests/filesys.lisp
=====================================
@@ -54,3 +54,7 @@
(assert-equal "/tmp/foo/bar/symlink"
(ext:unix-namestring "/tmp/foo/bar/symlink" nil)))
(unix:unix-unlink "/tmp/foo/bar/symlink")))
+
+
+
+
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a24b478ffed5ec6585bc6b…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a24b478ffed5ec6585bc6b…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl
Commits:
a24b478f by Raymond Toy at 2023-11-29T16:15:10-08:00
Rewrite because os_get_user_homedir returns a new string
os_get_user_homedir returns a newly-allocated string as the result.
The interface needs to free this space, so rewrite the caller
appropiately so that we can free the space.
- - - - -
1 changed file:
- src/code/os.lisp
Changes:
=====================================
src/code/os.lisp
=====================================
@@ -67,18 +67,23 @@
if no errors occurred. Otherwise a non-zero value is returned.
Examining errno may give information about what failed."
(alien:with-alien ((status c-call:int))
- (let ((result
- (alien:alien-funcall
- (alien:extern-alien "os_get_user_homedir"
- (function c-call:c-string
- c-call:c-string
- (* c-call:int)))
- name
- (alien:addr status))))
- (if (and (zerop status) result)
- (values (pathname
- (concatenate 'string
- result
- "/"))
- status)
- (values result status)))))
+ (let (result)
+ (unwind-protect
+ (progn
+ (setf result
+ (alien:alien-funcall
+ (alien:extern-alien "os_get_user_homedir"
+ (function (alien:* c-call:c-string)
+ c-call:c-string
+ (* c-call:int)))
+ name
+ (alien:addr status)))
+ (if (and (zerop status)
+ (not (alien:null-alien result)))
+ (values (pathname
+ (concatenate 'string
+ (alien:cast result c-call:c-string)
+ "/"))
+ status)
+ (values nil status)))
+ (alien:free-alien result)))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a24b478ffed5ec6585bc6b4…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a24b478ffed5ec6585bc6b4…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl
Commits:
bed9958f by Raymond Toy at 2023-11-29T07:54:12-08:00
Move get-user-homedir-pathname to SYSTEM package in os.lisp
Update exports.lisp, filesys.lisp, and os.lisp appropriately.
Move the unit tests from tests/filesys.lisp to tests/os.lisp.
- - - - -
2b3512cd by Raymond Toy at 2023-11-29T07:56:17-08:00
Remove some trailing blanks
- - - - -
03965083 by Raymond Toy at 2023-11-29T07:56:38-08:00
Update pot files due to the refactoring.
- - - - -
7 changed files:
- src/code/exports.lisp
- src/code/filesys.lisp
- src/code/os.lisp
- src/i18n/locale/cmucl-os.pot
- src/i18n/locale/cmucl.pot
- tests/filesys.lisp
- + tests/os.lisp
Changes:
=====================================
src/code/exports.lisp
=====================================
@@ -1712,9 +1712,7 @@
"DESCRIBE-EXTERNAL-FORMAT"
"LIST-ALL-EXTERNAL-FORMATS"
"STRING-ENCODE" "STRING-DECODE"
- "SET-SYSTEM-EXTERNAL-FORMAT")
- ;; File sys items
- (:export "GET-USER-HOMEDIR-PATHNAME"))
+ "SET-SYSTEM-EXTERNAL-FORMAT"))
(defpackage "STREAM"
(:import-from "SYSTEM" "LISP-STREAM")
@@ -2073,6 +2071,7 @@
"FD-STREAM-P" "FIND-IF-IN-CLOSURE" "FOREIGN-SYMBOL-ADDRESS"
"FOREIGN-SYMBOL-CODE-ADDRESS" "FOREIGN-SYMBOL-DATA-ADDRESS"
"GET-PAGE-SIZE" "GET-SYSTEM-INFO"
+ "GET-USER-HOMEDIR-PATHNAME"
"IGNORE-INTERRUPT"
"INT-SAP" "INVALIDATE-DESCRIPTOR" "IO-TIMEOUT"
"LISP-STREAM" "LONG-FLOAT-RADIX" "LONG-WORDS"
=====================================
src/code/filesys.lisp
=====================================
@@ -1484,28 +1484,3 @@ optionally keeping some of the most recent old versions."
(go retry))))))
;; Only the first path in a search-list is considered.
(return (values pathspec created-p))))))
-
-;;; GET-USER-HOMEDIR-PATHNAME -- Public
-;;;
-(defun get-user-homedir-pathname (name)
- _N"Get the user home directory for user named NAME. Two values are
- returned: the pathname of the home directory and a status code. If
- the home directory does not exist NIL is returned. The status is 0
- if no errors occurred. Otherwise a non-zero value is returned.
- Examining errno may give information about what failed."
- (alien:with-alien ((status c-call:int))
- (let ((result
- (alien:alien-funcall
- (alien:extern-alien "os_get_user_homedir"
- (function c-call:c-string
- c-call:c-string
- (* c-call:int)))
- name
- (alien:addr status))))
- (if (and (zerop status) result)
- (values (pathname
- (concatenate 'string
- result
- "/"))
- status)
- (values result status)))))
=====================================
src/code/os.lisp
=====================================
@@ -57,3 +57,28 @@
(error (intl:gettext "Unix system call getrusage failed: ~A.")
(unix:get-unix-error-msg utime)))
(values utime stime major-fault))))
+
+;;; GET-USER-HOMEDIR-PATHNAME -- Public
+;;;
+(defun get-user-homedir-pathname (name)
+ _N"Get the user home directory for user named NAME. Two values are
+ returned: the pathname of the home directory and a status code. If
+ the home directory does not exist NIL is returned. The status is 0
+ if no errors occurred. Otherwise a non-zero value is returned.
+ Examining errno may give information about what failed."
+ (alien:with-alien ((status c-call:int))
+ (let ((result
+ (alien:alien-funcall
+ (alien:extern-alien "os_get_user_homedir"
+ (function c-call:c-string
+ c-call:c-string
+ (* c-call:int)))
+ name
+ (alien:addr status))))
+ (if (and (zerop status) result)
+ (values (pathname
+ (concatenate 'string
+ result
+ "/"))
+ status)
+ (values result status)))))
=====================================
src/i18n/locale/cmucl-os.pot
=====================================
@@ -33,3 +33,12 @@ msgstr ""
msgid "Unix system call getrusage failed: ~A."
msgstr ""
+#: src/code/os.lisp
+msgid ""
+"Get the user home directory for user named NAME. Two values are\n"
+" returned: the pathname of the home directory and a status code. If\n"
+" the home directory does not exist NIL is returned. The status is 0\n"
+" if no errors occurred. Otherwise a non-zero value is returned.\n"
+" Examining errno may give information about what failed."
+msgstr ""
+
=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -10207,15 +10207,6 @@ msgstr ""
msgid "Can't create directory ~A."
msgstr ""
-#: src/code/filesys.lisp
-msgid ""
-"Get the user home directory for user named NAME. Two values are\n"
-" returned: the pathname of the home directory and a status code. If\n"
-" the home directory does not exist NIL is returned. The status is 0\n"
-" if no errors occurred. Otherwise a non-zero value is returned.\n"
-" Examining errno may give information about what failed."
-msgstr ""
-
#: src/code/load.lisp
msgid "The default for the :IF-SOURCE-NEWER argument to load."
msgstr ""
=====================================
tests/filesys.lisp
=====================================
@@ -54,37 +54,3 @@
(assert-equal "/tmp/foo/bar/symlink"
(ext:unix-namestring "/tmp/foo/bar/symlink" nil)))
(unix:unix-unlink "/tmp/foo/bar/symlink")))
-
-(define-test user-homedir.1
- "Test user-homedir"
- (:tag :issues)
- ;; Simple test to see if get-user-homedir-pathname returns the
- ;; expected value. Use getuid and getpwuid to figure out what the
- ;; name and home directory should be.
- (let* ((uid (unix:unix-getuid))
- (user-info (unix:unix-getpwuid uid)))
- (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)
- (ext:get-user-homedir-pathname info-name)
- (assert-true info-dir)
- (assert-true info-name)
-
- (assert-equal home-pathname expected-home-pathname)
- (assert-eql status 0)))))
-
-(define-test user-homedir.2
- "Test user-homedir"
- (:tag :issues)
- ;; Simple test to see if get-user-homedir-pathname returns the expected
- ;; value for a user that does not exist. Well, we assume such a
- ;; user doesn't exist.
- (multiple-value-bind (home-pathname status)
- (ext:get-user-homedir-pathname "zotuserunknown")
- (assert-eql home-pathname nil)
- (assert-eql status 0)))
-
=====================================
tests/os.lisp
=====================================
@@ -0,0 +1,38 @@
+(defpackage :os-tests
+ (:use :cl :lisp-unit))
+
+(in-package "OS-TESTS")
+
+
+(define-test user-homedir.1
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the
+ ;; expected value. Use getuid and getpwuid to figure out what the
+ ;; name and home directory should be.
+ (let* ((uid (unix:unix-getuid))
+ (user-info (unix:unix-getpwuid uid)))
+ (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)
+ (assert-true info-dir)
+ (assert-true info-name)
+
+ (assert-equal home-pathname expected-home-pathname)
+ (assert-eql status 0)))))
+
+(define-test user-homedir.2
+ "Test user-homedir"
+ (:tag :issues)
+ ;; Simple test to see if get-user-homedir-pathname returns the expected
+ ;; 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")
+ (assert-eql home-pathname nil)
+ (assert-eql status 0)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3ce881eb5e8a45e617953f…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3ce881eb5e8a45e617953f…
You're receiving this email because of your account on gitlab.common-lisp.net.