November 2023 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] 2 commits: Update release notes
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] Use new system:get-user-homedir-pathname
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] 3 commits: Fix #269: Add function to get user's home directory
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #269: Add function to get user's home directory
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] 2 commits: Revert changes to match master branch
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] Rewrite because os_get_user_homedir returns a new string
by Raymond Toy (＠rtoy) 30 Nov '23

30 Nov '23

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.

1 0

[Git][cmucl/cmucl][issue-266-tilde-pathname-support] 7 commits: Fix #265: Broken CI on Mac OS X
by Raymond Toy (＠rtoy) 29 Nov '23

29 Nov '23

Raymond Toy pushed to branch issue-266-tilde-pathname-support at cmucl / cmucl Commits: 24fd8012 by Raymond Toy at 2023-11-14T23:44:10+00:00 Fix #265: Broken CI on Mac OS X - - - - - cdaa5def by Raymond Toy at 2023-11-14T23:44:44+00:00 Merge branch 'issue-265-ci-broken-on-mac-os' into 'master' Fix #265: Broken CI on Mac OS X Closes #265 See merge request cmucl/cmucl!176 - - - - - fb29f7d9 by Raymond Toy at 2023-11-24T17:43:34+00:00 Fix #259: Move *software-version* from LISP to SYSTEM package - - - - - 1af08245 by Raymond Toy at 2023-11-24T17:43:45+00:00 Merge branch 'issue-259-b-use-right-software-version' into 'master' Fix #259: Move *software-version* from LISP to SYSTEM package Closes #259 See merge request cmucl/cmucl!175 - - - - - 6b9f32f5 by Tarn Burton at 2023-11-29T22:39:39+00:00 Add support for Gray stream implementation of file-length - - - - - b218d29c by Raymond Toy at 2023-11-29T22:39:54+00:00 Merge branch 'gray-file-length' into 'master' Add support for Gray stream implementation of file-length See merge request cmucl/cmucl!179 - - - - - 95368634 by Raymond Toy at 2023-11-29T15:44:53-08:00 Merge branch 'master' into issue-266-tilde-pathname-support - - - - - 9 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21e/boot-2023-08.lisp - src/code/exports.lisp - src/code/misc.lisp - src/code/stream.lisp - src/general-info/release-21f.md - src/pcl/gray-compat.lisp - src/pcl/gray-streams.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,8 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "" + bootstrap: "-B boot-2023-08" + stages: - install @@ -127,8 +128,9 @@ osx:build: #- bin/create-target.sh xtarget x86_darwin #- bin/create-target.sh xcross x86_darwin #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp - # Regular build using the cross-compiled result or snapshot - - bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp + # Regular build using the cross-compiled result or snapshot. + # Need /opt/local/bin to get msgmerge and msgfmt programs. + - PATH=/opt/local/bin:$PATH bin/build.sh $bootstrap -R -C "" -o snapshot/bin/lisp - bin/make-dist.sh -I dist darwin-4 osx:test: @@ -137,12 +139,14 @@ osx:test: - osx artifacts: paths: + - ansi-test/test.out - test.log needs: # Needs artifacts from build (dist/) - job: osx:build artifacts: true script: + - echo LANG = $LANG - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log osx:ansi-test: @@ -157,6 +161,9 @@ osx:ansi-test: - job: osx:build artifacts: true script: + # NB: sometimes we can't clone the ansi-test repo (bad cert!?!). + # Manually cloning it in the gitlab build dir helps with this + # issue until we can figure out what's going on. - bin/run-ansi-tests.sh -l dist/bin/lisp osx:benchmark: ===================================== bin/build.sh ===================================== @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21d +version=21e SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21e/boot-2023-08.lisp ===================================== @@ -0,0 +1,4 @@ +;; Build with -B boot-2023-08 from the 2023-08 snapshot. We're moving +;; *SOFTWARE-VERSION* from the LISP package to the SYSTEM package. +(ext:without-package-locks + (unintern 'lisp::*software-version* "LISP")) ===================================== src/code/exports.lisp ===================================== @@ -1620,6 +1620,7 @@ "STREAM-ADVANCE-TO-COLUMN" "STREAM-CLEAR-INPUT" "STREAM-CLEAR-OUTPUT" "STREAM-FILE-POSITION" + "STREAM-FILE-LENGTH" "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT" "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH" "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE" @@ -2057,7 +2058,9 @@ "%SP-REVERSE-FIND-CHARACTER-WITH-ATTRIBUTE" "%STANDARD-CHAR-P" "*BEEP-FUNCTION*" "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*" - "*SOFTWARE-TYPE*" "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*" + "*SOFTWARE-TYPE*" + "*SOFTWARE-VERSION*" + "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*" "*TASK-NOTIFY*" "*TASK-SELF*" "*TTY*" "*TYPESCRIPTPORT*" "*XWINDOW-TABLE*" "ADD-FD-HANDLER" "ADD-PORT-DEATH-HANDLER" "ADD-PORT-OBJECT" ===================================== src/code/misc.lisp ===================================== @@ -23,7 +23,7 @@ short-site-name long-site-name dribble compiler-macro)) (in-package "SYSTEM") -(export '(*software-type* *short-site-name* *long-site-name*)) +(export '(*software-type* *software-version* *short-site-name* *long-site-name*)) (in-package "EXT") (export 'featurep) ===================================== src/code/stream.lisp ===================================== @@ -397,7 +397,9 @@ ;; simple-stream (stream::%file-length stream) ;; lisp-stream - (funcall (lisp-stream-misc stream) stream :file-length))) + (funcall (lisp-stream-misc stream) stream :file-length) + ;; fundamental-stream + (stream-file-length stream))) ;;; Input functions: ===================================== src/general-info/release-21f.md ===================================== @@ -20,6 +20,8 @@ public domain. ## New in this release: * Known issues: * Feature enhancements: + * Add support for Gray streams implementation of file-length via + `ext:stream-file-length` generic function. * Changes: * ANSI compliance fixes: * Bug fixes: ===================================== src/pcl/gray-compat.lisp ===================================== @@ -39,6 +39,9 @@ (file-position stream position) (file-position stream))) +(define-gray-stream-method ext:stream-file-length ((stream simple-stream)) + (file-length stream)) + (define-gray-stream-method ext:stream-clear-output ((stream simple-stream)) (clear-output stream)) ===================================== src/pcl/gray-streams.lisp ===================================== @@ -376,6 +376,13 @@ (defmethod (setf stream-file-position) (position (stream character-output-stream)) (file-position (character-output-stream-lisp-stream stream) position)) +(defgeneric stream-file-length (stream) + (:documentation + _N"Implements FILE-LENGTH for the stream.")) + +(defmethod stream-file-length (stream) + (error 'type-error :datum stream :expected-type 'file-stream)) + ;;; Binary streams. ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/dfb351cd269fbb7023fa54… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/dfb351cd269fbb7023fa54… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] 5 commits: Fix #259: Move *software-version* from LISP to SYSTEM package
by Raymond Toy (＠rtoy) 29 Nov '23

29 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: fb29f7d9 by Raymond Toy at 2023-11-24T17:43:34+00:00 Fix #259: Move *software-version* from LISP to SYSTEM package - - - - - 1af08245 by Raymond Toy at 2023-11-24T17:43:45+00:00 Merge branch 'issue-259-b-use-right-software-version' into 'master' Fix #259: Move *software-version* from LISP to SYSTEM package Closes #259 See merge request cmucl/cmucl!175 - - - - - 6b9f32f5 by Tarn Burton at 2023-11-29T22:39:39+00:00 Add support for Gray stream implementation of file-length - - - - - b218d29c by Raymond Toy at 2023-11-29T22:39:54+00:00 Merge branch 'gray-file-length' into 'master' Add support for Gray stream implementation of file-length See merge request cmucl/cmucl!179 - - - - - ed1c38a1 by Raymond Toy at 2023-11-29T14:41:33-08:00 Merge branch 'master' into issue-269-unix-get-user-homedir - - - - - 9 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21e/boot-2023-08.lisp - src/code/exports.lisp - src/code/misc.lisp - src/code/stream.lisp - src/general-info/release-21f.md - src/pcl/gray-compat.lisp - src/pcl/gray-streams.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,8 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" version: "2023-08-x86" - bootstrap: "" + bootstrap: "-B boot-2023-08" + stages: - install ===================================== bin/build.sh ===================================== @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21d +version=21e SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21e/boot-2023-08.lisp ===================================== @@ -0,0 +1,4 @@ +;; Build with -B boot-2023-08 from the 2023-08 snapshot. We're moving +;; *SOFTWARE-VERSION* from the LISP package to the SYSTEM package. +(ext:without-package-locks + (unintern 'lisp::*software-version* "LISP")) ===================================== src/code/exports.lisp ===================================== @@ -1620,6 +1620,7 @@ "STREAM-ADVANCE-TO-COLUMN" "STREAM-CLEAR-INPUT" "STREAM-CLEAR-OUTPUT" "STREAM-FILE-POSITION" + "STREAM-FILE-LENGTH" "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT" "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH" "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE" @@ -2057,7 +2058,9 @@ "%SP-REVERSE-FIND-CHARACTER-WITH-ATTRIBUTE" "%STANDARD-CHAR-P" "*BEEP-FUNCTION*" "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*" - "*SOFTWARE-TYPE*" "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*" + "*SOFTWARE-TYPE*" + "*SOFTWARE-VERSION*" + "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*" "*TASK-NOTIFY*" "*TASK-SELF*" "*TTY*" "*TYPESCRIPTPORT*" "*XWINDOW-TABLE*" "ADD-FD-HANDLER" "ADD-PORT-DEATH-HANDLER" "ADD-PORT-OBJECT" ===================================== src/code/misc.lisp ===================================== @@ -23,7 +23,7 @@ short-site-name long-site-name dribble compiler-macro)) (in-package "SYSTEM") -(export '(*software-type* *short-site-name* *long-site-name*)) +(export '(*software-type* *software-version* *short-site-name* *long-site-name*)) (in-package "EXT") (export 'featurep) ===================================== src/code/stream.lisp ===================================== @@ -397,7 +397,9 @@ ;; simple-stream (stream::%file-length stream) ;; lisp-stream - (funcall (lisp-stream-misc stream) stream :file-length))) + (funcall (lisp-stream-misc stream) stream :file-length) + ;; fundamental-stream + (stream-file-length stream))) ;;; Input functions: ===================================== src/general-info/release-21f.md ===================================== @@ -20,6 +20,8 @@ public domain. ## New in this release: * Known issues: * Feature enhancements: + * Add support for Gray streams implementation of file-length via + `ext:stream-file-length` generic function. * Changes: * ANSI compliance fixes: * Bug fixes: ===================================== src/pcl/gray-compat.lisp ===================================== @@ -39,6 +39,9 @@ (file-position stream position) (file-position stream))) +(define-gray-stream-method ext:stream-file-length ((stream simple-stream)) + (file-length stream)) + (define-gray-stream-method ext:stream-clear-output ((stream simple-stream)) (clear-output stream)) ===================================== src/pcl/gray-streams.lisp ===================================== @@ -376,6 +376,13 @@ (defmethod (setf stream-file-position) (position (stream character-output-stream)) (file-position (character-output-stream-lisp-stream stream) position)) +(defgeneric stream-file-length (stream) + (:documentation + _N"Implements FILE-LENGTH for the stream.")) + +(defmethod stream-file-length (stream) + (error 'type-error :datum stream :expected-type 'file-stream)) + ;;; Binary streams. ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/03965083710758630032f1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/03965083710758630032f1… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Add support for Gray stream implementation of file-length
by Raymond Toy (＠rtoy) 29 Nov '23

29 Nov '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 6b9f32f5 by Tarn Burton at 2023-11-29T22:39:39+00:00 Add support for Gray stream implementation of file-length - - - - - b218d29c by Raymond Toy at 2023-11-29T22:39:54+00:00 Merge branch 'gray-file-length' into 'master' Add support for Gray stream implementation of file-length See merge request cmucl/cmucl!179 - - - - - 5 changed files: - src/code/exports.lisp - src/code/stream.lisp - src/general-info/release-21f.md - src/pcl/gray-compat.lisp - src/pcl/gray-streams.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1620,6 +1620,7 @@ "STREAM-ADVANCE-TO-COLUMN" "STREAM-CLEAR-INPUT" "STREAM-CLEAR-OUTPUT" "STREAM-FILE-POSITION" + "STREAM-FILE-LENGTH" "STREAM-FINISH-OUTPUT" "STREAM-FORCE-OUTPUT" "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH" "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE" ===================================== src/code/stream.lisp ===================================== @@ -397,7 +397,9 @@ ;; simple-stream (stream::%file-length stream) ;; lisp-stream - (funcall (lisp-stream-misc stream) stream :file-length))) + (funcall (lisp-stream-misc stream) stream :file-length) + ;; fundamental-stream + (stream-file-length stream))) ;;; Input functions: ===================================== src/general-info/release-21f.md ===================================== @@ -20,6 +20,8 @@ public domain. ## New in this release: * Known issues: * Feature enhancements: + * Add support for Gray streams implementation of file-length via + `ext:stream-file-length` generic function. * Changes: * ANSI compliance fixes: * Bug fixes: ===================================== src/pcl/gray-compat.lisp ===================================== @@ -39,6 +39,9 @@ (file-position stream position) (file-position stream))) +(define-gray-stream-method ext:stream-file-length ((stream simple-stream)) + (file-length stream)) + (define-gray-stream-method ext:stream-clear-output ((stream simple-stream)) (clear-output stream)) ===================================== src/pcl/gray-streams.lisp ===================================== @@ -376,6 +376,13 @@ (defmethod (setf stream-file-position) (position (stream character-output-stream)) (file-position (character-output-stream-lisp-stream stream) position)) +(defgeneric stream-file-length (stream) + (:documentation + _N"Implements FILE-LENGTH for the stream.")) + +(defmethod stream-file-length (stream) + (error 'type-error :datum stream :expected-type 'file-stream)) + ;;; Binary streams. ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1af08245e0418f61157891… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1af08245e0418f61157891… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] 3 commits: Move get-user-homedir-pathname to SYSTEM package in os.lisp
by Raymond Toy (＠rtoy) 29 Nov '23

29 Nov '23

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.

1 0