cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[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

[Git][cmucl/cmucl][issue-269-unix-get-user-homedir] Update release notes for fixing #269.
by Raymond Toy (＠rtoy) 27 Nov '23

27 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 3ce881eb by Raymond Toy at 2023-11-27T13:35:29-08:00 Update release notes for fixing #269. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -36,6 +36,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: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3ce881eb5e8a45e617953fe… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3ce881eb5e8a45e617953fe… 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: Remove debugging script lines from CI
by Raymond Toy (＠rtoy) 27 Nov '23

27 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 2f767eed by Raymond Toy at 2023-11-27T11:04:00-08:00 Remove debugging script lines from CI - - - - - 3d955819 by Raymond Toy at 2023-11-27T11:04:59-08:00 Slightly rewrite os_get_user_homedir and fix some bugs * Don't set errno * We didn't free buf when returning in some cases - - - - - c6a9f865 by Raymond Toy at 2023-11-27T11:06:34-08:00 Move function to filesys and rename it As hinted by @cshapiro, move the function for the UNIX package. Let's put it in filesys.lisp where `user-homedir-pathname` is defined, and name it `get-user-homedir-pathname`. This is exported from the EXT package. Update tests appropriately for the new name and package. - - - - - 637a5d78 by Raymond Toy at 2023-11-27T11:08:51-08:00 Remove unneeded file The tests for get-user-homedir-pathname have been moved to tests/filesys.lisp. - - - - - d7a3d533 by Raymond Toy at 2023-11-27T11:09:46-08:00 Update pot files because the function has moved. - - - - - 9 changed files: - .gitlab-ci.yml - src/code/exports.lisp - src/code/filesys.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/os-common.c - tests/filesys.lisp - − tests/os.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -62,7 +62,6 @@ linux:test: - job: linux:build artifacts: true script: - - printenv - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log linux:ansi-test: @@ -147,7 +146,6 @@ osx:test: artifacts: true script: - echo LANG = $LANG - - printenv - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log osx:ansi-test: ===================================== src/code/exports.lisp ===================================== @@ -227,7 +227,6 @@ "UNIX-MKDIR" "UNIX-RMDIR" "UNIX-UNLINK" - "UNIX-GET-USER-HOMEDIR" "TIMEZONE" "TIMEVAL" "SIZE-T" @@ -1713,7 +1712,9 @@ "DESCRIBE-EXTERNAL-FORMAT" "LIST-ALL-EXTERNAL-FORMATS" "STRING-ENCODE" "STRING-DECODE" - "SET-SYSTEM-EXTERNAL-FORMAT")) + "SET-SYSTEM-EXTERNAL-FORMAT") + ;; File sys items + (:export "GET-USER-HOMEDIR-PATHNAME")) (defpackage "STREAM" (:import-from "SYSTEM" "LISP-STREAM") ===================================== src/code/filesys.lisp ===================================== @@ -27,7 +27,8 @@ (in-package "EXTENSIONS") (export '(print-directory complete-file ambiguous-files default-directory - purge-backup-files file-writable unix-namestring)) + purge-backup-files file-writable unix-namestring + get-user-homedir-pathname)) (in-package "LISP") @@ -1483,3 +1484,28 @@ 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/unix.lisp ===================================== @@ -2900,27 +2900,3 @@ (extern-alien "os_get_locale_codeset" (function (* char)))) c-string)) - -(defun unix-get-user-homedir (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." - (with-alien ((status c-call:int)) - (let ((result - (alien-funcall - (extern-alien "os_get_user_homedir" - (function c-call:c-string - c-call:c-string - (* c-call:int))) - name - (addr status)))) - (if (and (zerop status) result) - (values (pathname - (concatenate 'string - result - "/")) - status) - (values result status))))) - ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1432,12 +1432,3 @@ msgstr "" msgid "Get the codeset from the locale" msgstr "" -#: src/code/unix.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,6 +10207,15 @@ 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 "" ===================================== src/lisp/os-common.c ===================================== @@ -864,17 +864,24 @@ 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; + 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 sysconf failed, just try some possibly large enough value. */ if (buflen == -1) { buflen = 1024; @@ -886,8 +893,7 @@ os_get_user_homedir(const char* name, int *status) * upper limit and give up. */ while (buflen <= (1 << 20)) { - errno = 0; - buf = malloc(buflen); + buf = realloc(buf, buflen); if (buf == NULL) { *status = -1; @@ -898,23 +904,24 @@ os_get_user_homedir(const char* name, int *status) if (*status == 0) { /* - * Success, or entry was not found. If found the result + * Success, or entry was not found. If found, the result * is not NULL. Return the result or NULL */ - fprintf(stderr, "dir = %s\n", pwd.pw_dir); - return result ? strdup(pwd.pw_dir) : 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) { - free(buf); buflen *= 2; } else { /* * Some other error. Just return NULL */ + free(buf); return NULL; } } @@ -922,6 +929,7 @@ os_get_user_homedir(const char* name, int *status) /* * Ran out of space. Just return NULL and set status to -1. */ + free(buf); *status = -1; return NULL; } ===================================== tests/filesys.lisp ===================================== @@ -55,6 +55,36 @@ (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 deleted ===================================== @@ -1,37 +0,0 @@ -(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 unix-get-user-homedir 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) - (unix:unix-get-user-homedir 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 unix-get-user-homedir 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) - (unix:unix-get-user-homedir "zotuserunknown") - (assert-eql home-pathname nil) - (assert-eql status 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b26975f6a41a59d036cf7c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b26975f6a41a59d036cf7c… 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: Address review comments.
by Raymond Toy (＠rtoy) 26 Nov '23

26 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: c78a982f by Raymond Toy at 2023-11-26T14:32:34-08:00 Address review comments. In `os_get_user_homedir`, use a loop to grow the buffer for `getpwnam_r` if needed. The API is changed so that we return a string (or NULL) for the home directory, and a second arg is the return code which is 0 if getpwnam_r succeeded (returning the home directory or NULL if the name does not exist). Update `unix-get-user-homedir` to use the new API and return two values: the pathname (or nil) and the return code. - - - - - 089574ef by Raymond Toy at 2023-11-26T14:51:49-08:00 Add test for non-existent user - - - - - b26975f6 by Raymond Toy at 2023-11-26T14:52:03-08:00 Update POT file for new docstring. - - - - - 4 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c - tests/os.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2902,22 +2902,25 @@ c-string)) (defun unix-get-user-homedir (name) - _N"Get the user home directory for user named NAME. If there's no such - user or if we don't have enough space to store the path, return NIL." - (with-alien ((homedir (array c-call:char 1024))) + _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." + (with-alien ((status c-call:int)) (let ((result (alien-funcall (extern-alien "os_get_user_homedir" - (function c-call:int + (function c-call:c-string c-call:c-string - (* char) - c-call:int)) + (* c-call:int))) name - (cast homedir (* c-call:char)) - 1024))) - (when (zerop result) - (pathname - (concatenate 'string - (cast homedir c-call:c-string) - "/")))))) + (addr status)))) + (if (and (zerop status) result) + (values (pathname + (concatenate 'string + result + "/")) + status) + (values result status))))) ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1434,7 +1434,10 @@ msgstr "" #: src/code/unix.lisp msgid "" -"Get the user home directory for user named NAME. If there's no such\n" -" user or if we don't have enough space to store the path, return NIL." +"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 ===================================== @@ -864,43 +864,65 @@ os_software_version(void) return result; } -int -os_get_user_homedir(const char* name, char* homedir, int len) +char * +os_get_user_homedir(const char* name, int *status) { - int rc; int buflen; char * buf; 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; + } - buf = malloc(buflen); + /* + * 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)) { + errno = 0; + buf = malloc(buflen); - if (buf == NULL) { - return -1; - } + if (buf == NULL) { + *status = -1; + return NULL; + } + + *status = getpwnam_r(name, &pwd, buf, buflen, &result); - rc = 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 + */ + fprintf(stderr, "dir = %s\n", pwd.pw_dir); + return result ? strdup(pwd.pw_dir) : NULL; + } - if ((rc == 0) && result != NULL) { /* - * Found a matching entry. Copy it to the output buffer if we - * have room. If not, set code to -1 + * Check errno for ERANGE. If so, the buffer was too small, so grow it. */ - if (strlen(pwd.pw_dir) < len) { - strcpy(homedir, pwd.pw_dir); + if (errno == ERANGE) { + free(buf); + buflen *= 2; } else { - rc = -1; + /* + * Some other error. Just return NULL + */ + return NULL; } - } else { - rc = -1; } - if (buf) { - free(buf); - } - - return rc; + /* + * Ran out of space. Just return NULL and set status to -1. + */ + *status = -1; + return NULL; } ===================================== tests/os.lisp ===================================== @@ -3,7 +3,7 @@ (in-package "OS-TESTS") -(define-test user-homedir +(define-test user-homedir.1 "Test user-homedir" (:tag :issues) ;; Simple test to see if unix-get-user-homedir returns the expected @@ -16,9 +16,22 @@ (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 "/"))) - (home-pathname (unix:unix-get-user-homedir info-name))) - (assert-true info-dir) - (assert-true info-name) + (concatenate 'string info-dir "/")))) + (multiple-value-bind (home-pathname status) + (unix:unix-get-user-homedir info-name) + (assert-true info-dir) + (assert-true info-name) - (assert-equal home-pathname expected-home-pathname)))) + (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 unix-get-user-homedir 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) + (unix:unix-get-user-homedir "zotuserunknown") + (assert-eql home-pathname nil) + (assert-eql status 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6066da35b2229646412b5b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6066da35b2229646412b5b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #259: Move *software-version* from LISP to SYSTEM package
by Raymond Toy (＠rtoy) 24 Nov '23

24 Nov '23

Raymond Toy pushed to branch master 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 - - - - - 5 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21e/boot-2023-08.lisp - src/code/exports.lisp - src/code/misc.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 ===================================== @@ -2057,7 +2057,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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cdaa5def165bdc2b15c5b2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cdaa5def165bdc2b15c5b2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-259-b-use-right-software-version] 4 commits: Use snapshot 2023-08 for running CI.
by Raymond Toy (＠rtoy) 22 Nov '23

22 Nov '23

Raymond Toy pushed to branch issue-259-b-use-right-software-version at cmucl / cmucl Commits: c7d29a31 by Raymond Toy at 2023-10-14T06:57:56-07:00 Use snapshot 2023-08 for running CI. - - - - - 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 - - - - - 9fb975db by Raymond Toy at 2023-11-22T09:26:43-08:00 Merge branch 'master' into issue-259-b-use-right-software-version - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,8 +1,9 @@ variables: - download_url: "https://common-lisp.net/project/cmucl/downloads/release/21e" - version: "21e-x86" + download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08" + version: "2023-08-x86" bootstrap: "-B boot-2023-08" + stages: - install - build @@ -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: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e8a2b489c5481b71c2eb1… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e8a2b489c5481b71c2eb1… 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] Fix typos in test.
by Raymond Toy (＠rtoy) 17 Nov '23

17 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 6066da35 by Raymond Toy at 2023-11-17T09:10:44-08:00 Fix typos in test. It should be `LET*` instead of `LET` and it's `info-name` instead of `user-name`. - - - - - 1 changed file: - tests/os.lisp Changes: ===================================== tests/os.lisp ===================================== @@ -13,11 +13,11 @@ (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 "/"))) - (home-pathname (unix:unix-get-user-homedir user-name))) + (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 "/"))) + (home-pathname (unix:unix-get-user-homedir info-name))) (assert-true info-dir) (assert-true info-name) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6066da35b2229646412b5be… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6066da35b2229646412b5be… 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 test to use getuid/getpwuid to get expected values.
by Raymond Toy (＠rtoy) 17 Nov '23

17 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 16eae5a2 by Raymond Toy at 2023-11-17T08:59:30-08:00 Rewrite test to use getuid/getpwuid to get expected values. The envvar `USERNAME` isn't defined when running CI, so we can't use that. Use getuid and getpwuid to get the user name and home directory to use with `unix-get-user-homedir`. - - - - - 1 changed file: - tests/os.lisp Changes: ===================================== tests/os.lisp ===================================== @@ -7,15 +7,18 @@ "Test user-homedir" (:tag :issues) ;; Simple test to see if unix-get-user-homedir returns the expected - ;; value. We assume the envvar USERNAME and HOME exist and are - ;; correctly set up for the user running this test. - (let ((user-name (unix:unix-getenv "USERNAME"))) - (assert-true user-name) - (when user-name - (let ((expected-homedir (pathname - (concatenate 'string - (unix:unix-getenv "HOME") - "/"))) - (homedir (unix:unix-get-user-homedir user-name))) - (assert-true expected-homedir) - (assert-equal homedir expected-homedir))))) + ;; 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 "/"))) + (home-pathname (unix:unix-get-user-homedir user-name))) + (assert-true info-dir) + (assert-true info-name) + + (assert-equal home-pathname expected-home-pathname)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/16eae5a214dbdb92c6ba1e7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/16eae5a214dbdb92c6ba1e7… 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] Debugging: printenv to see what envvars are avaliabie during CI
by Raymond Toy (＠rtoy) 17 Nov '23

17 Nov '23

Raymond Toy pushed to branch issue-269-unix-get-user-homedir at cmucl / cmucl Commits: 2ec0a02c by Raymond Toy at 2023-11-17T08:14:24-08:00 Debugging: printenv to see what envvars are avaliabie during CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -62,6 +62,7 @@ linux:test: - job: linux:build artifacts: true script: + - printenv - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log linux:ansi-test: @@ -146,6 +147,7 @@ osx:test: artifacts: true script: - echo LANG = $LANG + - printenv - bin/run-unit-tests.sh -l dist/bin/lisp 2>&1 | tee test.log osx:ansi-test: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ec0a02c060153335a88bb9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ec0a02c060153335a88bb9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs