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

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Fixed typo and remove extra closing brace
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 196dd6cf by Raymond Toy at 2025-11-13T08:08:42-08:00 Fixed typo and remove extra closing brace - - - - - f544c481 by Raymond Toy at 2025-11-13T08:09:02-08:00 Update these files to match Linux These OSes use the same method as used on Linux to get the temp directory so update them to match what Linux is doing now. - - - - - 5 changed files: - src/lisp/FreeBSD-os.c - src/lisp/Linux-os.c - src/lisp/NetBSD-os.c - src/lisp/OpenBSD-os.c - src/lisp/solaris-os.c Changes: ===================================== src/lisp/FreeBSD-os.c ===================================== @@ -365,9 +365,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -378,11 +378,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/Linux-os.c ===================================== @@ -631,9 +631,9 @@ os_support_sse2(void) /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -662,4 +662,3 @@ os_temporary_directory(void) } return result; } -} ===================================== src/lisp/NetBSD-os.c ===================================== @@ -430,9 +430,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -443,11 +443,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/OpenBSD-os.c ===================================== @@ -193,9 +193,9 @@ os_install_interrupt_handlers(void) /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -206,11 +206,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } ===================================== src/lisp/solaris-os.c ===================================== @@ -646,9 +646,9 @@ os_support_sse2() /* * Return a new string containing the path to an OS-dependent location - * where temporary files/directories can be stored. If NULL is - * returned, such a location could not be found or some other error - * happened. + * where temporary files/directories can be stored. The string must + * end with a slash. If NULL is returned, such a location could not + * be found or some other error happened. * * Caller must call free() on the string returned. */ @@ -659,11 +659,21 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; + char *result; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - return strdup(tmp_path); + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); + if (result) { + sprintf(result, "%s/", tmp); + } + return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/19dec394ac637e3090500a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/19dec394ac637e3090500a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Remove old function recursive-delete-directory
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 19dec394 by Raymond Toy at 2025-11-13T07:25:30-08:00 Remove old function recursive-delete-directory This was replaced by `delete-directory`. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -670,23 +670,6 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) -#+nil -(defun recursive-delete-directory (dir) - _N"Recursively delete the directory DIR. All files and subdirectories of - DIR are removed. DIR must be a pathname to a directory. Any NAME - or TYPE components in DIR are ignored." - (declare (type pathname dir)) - ;; Find all the files or directories in DIR. - (dolist (path (directory (merge-pathnames "*.*" dir))) - ;; If the path is a directory, recursively delete the directory. - ;; Otherwise delete the file. We do not follow any symlinks. - (if (eq (unix:unix-file-kind (namestring path)) :directory) - (recursive-delete-directory path) - (delete-file path))) - ;; Finally delete the directory. - (unix:unix-rmdir (namestring dir)) - (values)) - (defun delete-directory (dirname &key recursive) _N"Delete the directory Dirname. If the Recursive is non-NIL, recursively delete the directory Dirname including all files and View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/19dec394ac637e3090500a6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/19dec394ac637e3090500a6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Apply 3 suggestion(s) to 3 file(s)
by Raymond Toy (＠rtoy) 13 Nov '25

13 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: a96bdc2e by Raymond Toy at 2025-11-13T07:24:54-08:00 Apply 3 suggestion(s) to 3 file(s) Co-authored-by: Carl Shapiro <cshapiro(a)panix.com> - - - - - 3 changed files: - src/code/extensions.lisp - src/lisp/Darwin-os.c - src/lisp/Linux-os.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -702,7 +702,7 @@ (delete-directory path :recursive t) (delete-file path)))) ;; Finally delete the directory. - (unix:unix-rmdir (namestring dir)) + (unix:unix-rmdir (namestring dirname)) (values)) ===================================== src/lisp/Darwin-os.c ===================================== @@ -588,27 +588,14 @@ os_temporary_directory(void) * macosx has a secure per-user temporary directory. * Don't cache the result as this is only called once. */ - int len; - char *result; + size_t len; char path[PATH_MAX]; - int path_size = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); - if (path_size == 0 || path_size > PATH_MAX) { - strlcpy(path, "/tmp", sizeof(path)); - } - - /* Append a slash if needed */ - len = strlen(path); - result = malloc(len + 1); - - /* If malloc fails, just return NULL. */ - if (result) { - strcpy(result, path); - - if (path[len] != '/') { - strcat(result, "/"); - } + len = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); + if (len == 0 || len > PATH_MAX || (len == PATH_MAX && path[len - 1] != '/')) { + strlcpy(path, "/tmp/"); + } else if (path[len - 1] != '/') { + strcat(path, "/"); } - - return result; + return strdup(path); } ===================================== src/lisp/Linux-os.c ===================================== @@ -644,26 +644,22 @@ os_temporary_directory(void) * If the TMP envvar is set, use that as the temporary directory. * Otherwise, just assume "/tmp" will work. */ - char *tmp_path = getenv("TMP"); + char *tmp; + size_t len; char *result; - int len; - if (tmp_path == NULL) { - tmp_path = "/tmp"; + tmp = getenv("TMP"); + if (tmp == NULL) { + return strdup("/tmp/"); } - - /* Append a slash if needed */ - len = strlen(tmp_path); - result = malloc(len + 1); - - /* If malloc fails, just return NULL. */ + len = strlen(tmp); + if (tmp[len] == '/') { + return strdup(tmp); + } + result = malloc(len + 2); if (result) { - strcpy(result, tmp_path); - - if (tmp_path[len] != '/') { - strcat(result, "/"); - } + sprintf(result, "%s/", tmp); } - return result; } +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a96bdc2e50c473356862a8d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a96bdc2e50c473356862a8d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Let os_temporary_directory append a slash if needed.
by Raymond Toy (＠rtoy) 12 Nov '25

12 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 71b5e795 by Raymond Toy at 2025-11-11T18:37:08-08:00 Let os_temporary_directory append a slash if needed. Update ext::get-os-temp-path so that it doesn't append a slash since os_temporary_directory does. Update pot file for new docstring too. - - - - - 4 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - src/lisp/Darwin-os.c - src/lisp/Linux-os.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -624,11 +624,7 @@ (error "Unable to find path to temporary directory")) (unwind-protect - (let* ((string (unix::%file->name (cast path c-call:c-string))) - (len (length string))) - (if (char= #\/ (aref string (1- len))) - string - (concatenate 'string string "/"))) + (unix::%file->name (cast path c-call:c-string)) (unless (alien:null-alien path) (alien:free-alien path))))) @@ -674,6 +670,7 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +#+nil (defun recursive-delete-directory (dir) _N"Recursively delete the directory DIR. All files and subdirectories of DIR are removed. DIR must be a pathname to a directory. Any NAME @@ -690,6 +687,25 @@ (unix:unix-rmdir (namestring dir)) (values)) +(defun delete-directory (dirname &key recursive) + _N"Delete the directory Dirname. If the Recursive is non-NIL, + recursively delete the directory Dirname including all files and + subdirectories. Dirname must be a pathname to a directory. Any NAME + or TYPE components in Dirname are ignored." + (declare (type pathname dirname)) + (when recusive + ;; Find all the files or directories in DIRNAME. + (dolist (path (directory (merge-pathnames "*.*" dirname))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (delete-directory path :recursive t) + (delete-file path)))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + + ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) @@ -717,4 +733,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (recursive-delete-directory ,dirname)))))) + (delete-directory ,dirname :recursive t)))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6014,6 +6014,14 @@ msgid "" " or TYPE components in DIR are ignored." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Delete the directory Dirname. If the Recursive is non-NIL,\n" +" recursively delete the directory Dirname including all files and\n" +" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" +" or TYPE components in Dirname are ignored." +msgstr "" + #: src/code/extensions.lisp msgid "" "Return a namestring to a temporary directory. If Directory is not\n" ===================================== src/lisp/Darwin-os.c ===================================== @@ -588,6 +588,8 @@ os_temporary_directory(void) * macosx has a secure per-user temporary directory. * Don't cache the result as this is only called once. */ + int len; + char *result; char path[PATH_MAX]; int path_size = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); @@ -595,5 +597,18 @@ os_temporary_directory(void) strlcpy(path, "/tmp", sizeof(path)); } - return strdup(path); + /* Append a slash if needed */ + len = strlen(path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, path); + + if (path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } ===================================== src/lisp/Linux-os.c ===================================== @@ -645,10 +645,25 @@ os_temporary_directory(void) * Otherwise, just assume "/tmp" will work. */ char *tmp_path = getenv("TMP"); + char *result; + int len; if (tmp_path == NULL) { tmp_path = "/tmp"; } - return strdup(tmp_path); + /* Append a slash if needed */ + len = strlen(tmp_path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, tmp_path); + + if (tmp_path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Minor tweak to with-temporary-directory
by Raymond Toy (＠rtoy) 11 Nov '25

11 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: def9886b by Raymond Toy at 2025-11-10T11:25:06-08:00 Minor tweak to with-temporary-directory Call `recursive-delete-directory` with the temp directory pathname object instead of the namestring. Update pot file for new docstrings. - - - - - 78dc0983 by Raymond Toy at 2025-11-10T16:37:11-08:00 Remove old nil'ed out tests Really remove these old tests that were updated to use with-temporary-file to get a temp file for testing. - - - - - 3 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - tests/trac.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -717,4 +717,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (recursive-delete-directory (namestring ,dirname))))))) + (recursive-delete-directory ,dirname)))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6007,6 +6007,13 @@ msgid "" " On completion, the file is automatically removed." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Recursively delete the directory DIR. All files and subdirectories of\n" +" DIR are removed. DIR must be a pathname to a directory. Any NAME\n" +" or TYPE components in DIR are ignored." +msgstr "" + #: src/code/extensions.lisp msgid "" "Return a namestring to a temporary directory. If Directory is not\n" ===================================== tests/trac.lisp ===================================== @@ -103,78 +103,24 @@ (assert-equal '(:absolute "TMP" "Foo" "bar") (pathname-directory "/tmp/Foo/BAR/" :case :common))) -#+nil (define-test trac.36 - (:tag :trac) - (let ((path "/tmp/trac.36.bom.txt")) - (flet ((bug (&optional (format :utf16)) + (:tag :trac) + (flet ((bug (&optional (format :utf16)) + (ext:with-temporary-file (path) (with-open-file (s path :direction :output - :if-exists :supersede :external-format format) (format s "Hello~%")) (with-open-file (s path :direction :input :external-format format) (let ((ch (read-char s))) - (values ch (file-position s)))))) - (assert-equal (values #\H 4) - (bug :utf16)) - (assert-equal (values #\H 8) - (bug :utf32))))) - -#+nil -(define-test trac.36 - (:tag :trac) - (flet ((bug (&optional (format :utf16)) - (ext:with-temporary-stream (s :direction :io :external-format format) - (format s "Hello~%") - (file-position s 0) - (let ((ch (read-char s))) - (values ch (file-position s)))))) + (values ch (file-position s))))))) (assert-equal (values #\H 4) (bug :utf16)) (assert-equal (values #\H 8) (bug :utf32)))) -(define-test trac.36 - (:tag :trac) - (flet ((bug (&optional (format :utf16)) - (ext:with-temporary-file (path) - (with-open-file (s path - :direction :output - :external-format format) - (format s "Hello~%")) - (with-open-file (s path - :direction :input - :external-format format) - (let ((ch (read-char s))) - (values ch (file-position s))))))) - (assert-equal (values #\H 4) - (bug :utf16)) - (assert-equal (values #\H 8) - (bug :utf32))))) - -#+nil -(define-test trac.43 - (:tag :trac) - (assert-true - (let ((path "/tmp/trac.43.txt")) - (unwind-protect - (progn - (with-open-file (ostream path :direction :output - :external-format :utf-8) - (dotimes (i 1000) - (write-char (code-char #x1234) ostream))) - - (with-open-file (stream path :direction :input - :external-format :utf-8) - (let ((p0 (file-position stream)) - (ch (read-char stream))) - (unread-char ch stream) - (let ((p0* (file-position stream))) - (eql p0* p0))))))))) - (define-test trac.43 (:tag :trac) (assert-true @@ -197,26 +143,6 @@ (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" (princ-to-string (make-pathname :directory '(:absolute "tmp" "" "a" "" "b"))))) -#+nil -(define-test trac.58 - (:tag :trac) - (assert-false - (let ((path "/tmp/trac.58.txt") - failures) - (unwind-protect - (progn - (with-open-file (s path :direction :output :external-format :utf-16) - (dotimes (i 300) - (write-char (code-char i) s))) - - (with-open-file (s path :direction :input :external-format :utf-16) - (dotimes (i 300) - (let ((ch (read-char s nil nil))) - (unless (= i (char-code ch)) - (push (list i ch (char-code ch)) failures))))) - failures) - (delete-file path))))) - (define-test trac.58 (:tag :trac) (assert-false @@ -318,26 +244,6 @@ (assert-equal "A1234AAAA" (subseq (trac.70-test *trac.70* "a12345") 0 9))) -#+nil -(define-test trac.79 - (:tag :trac) - ;; Create a temp file full of latin1 characters. - (assert-equal - '(0 1) - (let ((path "/tmp/trac.70.txt")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (dotimes (k 255) - (write-char (code-char k) s))) - (with-open-file (s path :direction :input :external-format :latin1) - (list (file-position s) - (progn - (read-char s) - (file-position s))))) - (delete-file path))))) - (define-test trac.79 (:tag :trac) ;; Create a temp file full of latin1 characters. @@ -360,30 +266,6 @@ (assert-true (ignore-errors (format nil "~ve" 21 5d-234))) (assert-true (ignore-errors (format nil "~ve" 100 5d-234)))) -#+nil -(define-test trac.87.output - (:tag :trac) - ;; Test that run-program accepts :element-type and produces the - ;; correct output. - (let ((path "/tmp/trac.87.output") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (write-string string s)) - (let* ((expected (stream:string-to-octets string :external-format :latin1)) - (octets (make-array (length expected) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :output :stream - :element-type '(unsigned-byte 8)))) - (read-sequence octets (ext:process-output proc)) - (assert-equalp - expected - octets))) - (delete-file path)))) - (define-test trac.87.output (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -404,32 +286,6 @@ expected octets))))) -#+nil -(define-test trac.87.input - (:tag :trac) - ;; Test that run-program accepts :element-type and produces the - ;; correct input (and output). - (let ((path "/tmp/trac.87.input") - (string "Hello")) - (unwind-protect - (progn - (with-open-file (s path :direction :output :if-exists :supersede - :external-format :latin1) - (write-string string s)) - (let ((octets (stream:string-to-octets string :external-format :latin1)) - (output (make-array (length string) - :element-type '(unsigned-byte 8))) - (proc (ext:run-program "/bin/cat" (list path) - :input :stream - :output :stream - :element-type '(unsigned-byte 8)))) - (write-sequence octets (ext:process-input proc)) - (read-sequence output (ext:process-output proc)) - (assert-equalp - octets - output))) - (delete-file path)))) - (define-test trac.87.input (:tag :trac) ;; Test that run-program accepts :element-type and produces the @@ -510,24 +366,6 @@ ;; Not quite what ticket 101 is about, but it came up in investigating ;; CLEAR-OUTPUT on a Gray stream. Verify CLEAR-OUTPUT actually ;; does. Previously, it did nothing. -#+nil -(define-test trac.101 - (:tag :trac) - (assert-eql - 0 - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - (unwind-protect - (progn - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (close s) - (delete-file *test-file*))))) - (define-test trac.101 (:tag :trac) (assert-eql View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fef970d55aac584f24ed2c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fef970d55aac584f24ed2c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Remove nil'ed out test code.
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: fef970d5 by Raymond Toy at 2025-11-10T10:14:36-08:00 Remove nil'ed out test code. The original clear-output-1 test has been replaced with a version that uses with-temporary-file. - - - - - 1 changed file: - tests/fd-streams.lisp Changes: ===================================== tests/fd-streams.lisp ===================================== @@ -17,25 +17,6 @@ (eval-when (:load-toplevel) (ensure-directories-exist *test-path* :verbose t)) -#+nil -(define-test clear-output-1 - (:tag :trac) - (assert-eql - 0 - (unwind-protect - (let ((s (open *test-file* - :direction :output - :if-exists :supersede))) - ;; Write a character to the (fully buffered) output - ;; stream. Clear the output and close the file. Nothing - ;; should have been written to the file. - (write-char #\a s) - (clear-output s) - (close s) - (setf s (open *test-file*)) - (file-length s)) - (delete-file *test-file*)))) - (define-test clear-output-1 (:tag :trac) (assert-eql View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fef970d55aac584f24ed2cc… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/fef970d55aac584f24ed2cc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Allow specifying a directory for the temp file or directory
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 32f4adb8 by Raymond Toy at 2025-11-10T09:32:05-08:00 Allow specifying a directory for the temp file or directory Add a new keyword arg :directory that specifies a directory where the temporary file or directory is. If not provided an OS-dependent directory is used. This applies to both `with-temporary-file` and `with-temporary-directory`. - - - - - 14902acd by Raymond Toy at 2025-11-10T10:09:12-08:00 Implement "rm -r" in Lisp Instead of using "rm -rf" to delete the temporary directory produced by `with-temporary-directory`, do the deletion in lisp so we don't have to fork/exec. The new function `recursively-delete-directory` recursively deletes a directory and all its contents. - - - - - 2 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/extensions.lisp ===================================== @@ -632,30 +632,31 @@ (unless (alien:null-alien path) (alien:free-alien path))))) -;; Create a template suitable for mkstemp and mkdtemp. PREFIX is -;; string (or NIL) provided by the macros and is used as is as the -;; template prefix. If PREFIX is NIL, the prefix is obtained by -;; appending DEFAULT-NAME to the OS-dependent temporary path. In all -;; cases, we append exactly 6 X's to create the finale template. -(defun create-template (prefix default-name) +;; Create a template suitable for mkstemp and mkdtemp. DIRECTORY is +;; the directory for the template. If DIRECTORY is NIL, an +;; OS-dependent location is used. PREFIX is string that is the prefix +;; for the filename for the template. In all cases, we append exactly +;; 6 X's to create the finale template. +(defun create-template (directory prefix) (concatenate 'string - (or prefix - (concatenate 'string - (get-os-temp-path) - default-name)) + (or directory + (get-os-temp-path)) + "/" + prefix "XXXXXX")) ;;; WITH-TEMPORARY-FILE -- Public -(defmacro with-temporary-file ((filename &key prefix) +(defmacro with-temporary-file ((filename &key directory (prefix "cmucl-temp-file-")) &parse-body (forms decls)) _N"Creates a temporary file with a name bound to Filename which a - namestring. If Prefix is not provided, the temporary file is created - in a OS-dependent location. Otherwise the prefix is used as a prefix - for the name. On completion, the file is automatically removed." + namestring. If Directory is not provided, the temporary file is created + in a OS-dependent location. The Prefix is a prefix to the file name + to be created. If not provided a default prefix is used. + On completion, the file is automatically removed." (let ((fd (gensym "FD-")) (file-template (gensym "TEMP-PATH-")) (unique-filename (gensym "UNIQUE-FILENAME-"))) - `(let ((,file-template (create-template ,prefix "cmucl-temp-file-")) + `(let ((,file-template (create-template ,directory ,prefix)) ,unique-filename) (unwind-protect (let (,fd) @@ -673,17 +674,34 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +(defun recursive-delete-directory (dir) + _N"Recursively delete the directory DIR. All files and subdirectories of + DIR are removed. DIR must be a pathname to a directory. Any NAME + or TYPE components in DIR are ignored." + (declare (type pathname dir)) + ;; Find all the files or directories in DIR. + (dolist (path (directory (merge-pathnames "*.*" dir))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (recursive-delete-directory path) + (delete-file path))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + ;;; WITH-TEMPORARY-DIRECTORY -- Public -(defmacro with-temporary-directory ((dirname &key prefix) +(defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) - _N"Return a namestring to a temporary directory. If Prefix is not - provided, the directory is created in an OS-dependent location. - Otherwise, the Prefix is a string that is used as a prefix for the - name of the temporary directory. The directory and all its contents - are automatically removed afterward." + _N"Return a namestring to a temporary directory. If Directory is not + provided, the directory is created in an OS-dependent location. The + Prefix is a string that is used as a prefix for the name of the + temporary directory. If Prefix is not given, a default prefix is + used. The directory and all its contents are automatically removed + afterward." (let ((err (gensym "ERR-")) (dir-template (gensym "DIR-TEMPLATE-"))) - `(let ((,dir-template (create-template ,prefix "cmucl-temp-dir-")) + `(let ((,dir-template (create-template ,directory ,prefix)) ,dirname ,err) (unwind-protect (progn @@ -699,4 +717,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (ext:run-program "/bin/rm" (list "-rf" (namestring ,dirname)))))))) + (recursive-delete-directory (namestring ,dirname))))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5998,25 +5998,23 @@ msgid "" " is returned to that path. The path ends with a \"/\" character." msgstr "" -#: src/code/extensions.lisp -msgid "Return a stream to a temporary file that is automatically created." -msgstr "" - #: src/code/extensions.lisp msgid "" "Creates a temporary file with a name bound to Filename which a\n" -" namestring. If Prefix is not provided, the temporary file is created\n" -" in a OS-dependent location. Otherwise the prefix is used as a prefix\n" -" for the name. On completion, the file is automatically removed." +" namestring. If Directory is not provided, the temporary file is created\n" +" in a OS-dependent location. The Prefix is a prefix to the file name\n" +" to be created. If not provided a default prefix is used.\n" +" On completion, the file is automatically removed." msgstr "" #: src/code/extensions.lisp msgid "" -"Return a namestring to a temporary directory. If Prefix is not\n" -" provided, the directory is created in an OS-dependent location.\n" -" Otherwise, the Prefix is a string that is used as a prefix for the\n" -" name of the temporary directory. The directory and all its contents\n" -" are automatically removed afterward." +"Return a namestring to a temporary directory. If Directory is not\n" +" provided, the directory is created in an OS-dependent location. The\n" +" Prefix is a string that is used as a prefix for the name of the\n" +" temporary directory. If Prefix is not given, a default prefix is\n" +" used. The directory and all its contents are automatically removed\n" +" afterward." msgstr "" #: src/code/commandline.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] Address more review comments
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: ee5676a5 by Raymond Toy at 2025-11-10T08:53:26-08:00 Address more review comments Rename `os_get_username` to `os_get_user_name`. Remove on extraneous newline at the ned of os-common.c - - - - - 2 changed files: - src/code/unix.lisp - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -2552,7 +2552,7 @@ (progn (setf result (alien-funcall - (extern-alien "os_get_username" + (extern-alien "os_get_user_name" (function (* c-call:c-string) uid-t (* c-call:int))) ===================================== src/lisp/os-common.c ===================================== @@ -779,7 +779,7 @@ again: * returned. */ char * -os_get_username(uid_t uid, int *status) +os_get_user_name(uid_t uid, int *status) { char *buf; char *name; @@ -821,7 +821,7 @@ os_file_author(const char *path) return NULL; } - return os_get_username(sb.st_uid, &status); + return os_get_user_name(sb.st_uid, &status); } int @@ -1037,4 +1037,3 @@ os_getcwd(void) { return getcwd(NULL, 0); } - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee5676a5bfbaec3699fd353… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee5676a5bfbaec3699fd353… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-408-get-user-name-and-homedir] 5 commits: Implement os_getpwuid per review comments
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch issue-408-get-user-name-and-homedir at cmucl / cmucl Commits: e6e80bd0 by Raymond Toy at 2025-11-10T07:02:47-08:00 Implement os_getpwuid per review comments We implement os_getpwuid and use it as needed to get the user name and/or user directory. This requires updating os_get_username and get_homedir_from_uid and their callers of course. unix::unix-get-username needs updating too. - - - - - 1b2bbe7b by Raymond Toy at 2025-11-10T07:07:13-08:00 Remove old code that we've replaced. - - - - - ec1a3722 by Raymond Toy at 2025-11-10T07:13:11-08:00 Slightly simplify logic in get_homedir_from_uid - - - - - 9d281610 by Raymond Toy at 2025-11-10T08:31:29-08:00 Change API of os_get_username look like other functions Make os_get_username use the same API as used by get_homedir_from_name, get_homedir_from_uid, and os_get_user_homedir. Update unix-get-username implementation appropriately. - - - - - d076e577 by Raymond Toy at 2025-11-10T08:34:44-08:00 Remove old version of unix-get-username - - - - - 3 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c Changes: ===================================== src/code/unix.lisp ===================================== @@ -2543,15 +2543,26 @@ (string-decode (cast result c-string) :default))) (defun unix-get-username (uid) - (let (name) - (unwind-protect - (progn - (setf name - (alien-funcall - (extern-alien "os_get_username" - (function (* char) uid-t)) - uid)) - (unless (null-alien name) - (cast name c-call:c-string))) - (unless (null-alien name) + _N"Returns a string that is the user name corresponding to the given UID. + If no such uid exists or if the user name does not exist, NIL is + returned." + (with-alien ((status c-call:int)) + (let (result) + (unwind-protect + (progn + (setf result + (alien-funcall + (extern-alien "os_get_username" + (function (* c-call:c-string) + uid-t + (* c-call:int))) + uid + (addr status))) + (values + (if (and (zerop status) + (not (null-alien result))) + (cast result c-call:c-string) + nil) + status)) (free-alien name))))) + ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -810,3 +810,10 @@ msgstr "" msgid "Returns a string that describes the error code Errno" msgstr "" +#: src/code/unix.lisp +msgid "" +"Returns a string that is the user name corresponding to the given UID.\n" +" If no such uid exists or if the user name does not exist, NIL is\n" +" returned." +msgstr "" + ===================================== src/lisp/os-common.c ===================================== @@ -731,56 +731,37 @@ os_lstat(const char* path, uint64_t *dev, uint64_t *ino, unsigned int *mode, uin } /* - * From the given UID, find the corresponding user name and home - * directory. - * - * NAME and DIR are set to the user name and home directory. The - * caller must free these. If no such uid exists, NAME and DIR are - * set to NULL. - * - * Returns the status of getpwuid. Zero indicates success. Otherwise - * the errno is returned. + * Basic interface to getpwuid, except we will automatically retry if + * the given buffer is too small. To support this |buffer| is a + * pointer to a char buffer. This will be updated with a new buffer + * if we needed to retry getpwuid with a larger buffer. The remaining + * parameters are the same as for getpwuid. */ int -os_get_user_info(uid_t uid, char **name, char **dir) +os_getpwuid(uid_t uid, struct passwd *pwd, char **buffer, size_t buflen, struct passwd **result) { - char initial[1024]; - char *buffer, *obuffer; - size_t size; - struct passwd pwd; - struct passwd *ppwd; int status; - - *name = NULL; - *dir = NULL; - - buffer = initial; - obuffer = NULL; - size = sizeof(initial) / sizeof(initial[0]); + char *obuffer = NULL; /* * Keep trying with larger buffers until a maximum is reached. We * assume (1 << 20) is large enough for any OS. */ again: - switch (status = getpwuid_r(uid, &pwd, buffer, size, &ppwd)) { + switch (status = getpwuid_r(uid, pwd, *buffer, buflen, result)) { case 0: /* Success, though we might not have a matching entry */ - if (ppwd) { - *name = strdup(pwd.pw_name); - *dir = strdup(pwd.pw_dir); - } break; case ERANGE: /* Buffer is too small, double its size and try again */ - size *= 2; - if (size > (1 << 20)) { + buflen *= 2; + if (buflen > (1 << 20)) { break; } - if ((buffer = realloc(obuffer, size)) == NULL) { + if ((*buffer = realloc(obuffer, buflen)) == NULL) { break; } - obuffer = buffer; + obuffer = *buffer; goto again; default: /* All other errors */ @@ -791,23 +772,38 @@ again: return status; } + /* * Given the UID, return the user name. If the uid does not exist, * returns NULL. The caller must call free on the string that is * returned. */ char * -os_get_username(uid_t uid) +os_get_username(uid_t uid, int *status) { - int status; + char *buf; char *name; - char *dir; + struct passwd pwd; + struct passwd *result; + char buffer[1024]; - status = os_get_user_info(uid, &name, &dir); + buf = buffer; - free(dir); + *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); - return (status == 0) ? name : NULL; + if (*status != 0 || result == NULL || result->pw_name == NULL) { + name = NULL; + } else { + name = strdup(result->pw_name); + if (name == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return name; } /* @@ -818,13 +814,14 @@ os_get_username(uid_t uid) char * os_file_author(const char *path) { + int status; struct stat sb; if (stat(path, &sb) != 0) { return NULL; } - return os_get_username(sb.st_uid); + return os_get_username(sb.st_uid, &status); } int @@ -986,16 +983,29 @@ get_homedir_from_name(const char* name, int *status) static char * get_homedir_from_uid(uid_t uid, int *status) { - char *name; + char buffer[1024]; + char *buf; char *dir; - - *status = os_get_user_info(uid, &name, &dir); + struct passwd pwd; + struct passwd *result; - free(name); - - return (*status == 0) ? dir : NULL; -} + buf = buffer; + dir = NULL; + *status = os_getpwuid(uid, &pwd, &buf, 1024, &result); + + if (*status == 0 && result != NULL && result->pw_dir != NULL) { + dir = strdup(result->pw_dir); + if (dir == NULL) { + *status = errno; + } + if (buf != buffer) { + free(buf); + } + } + + return dir; +} /* * Return the home directory of the user named NAME. If NAME is the View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5da6959fd78d7c663dc188… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5da6959fd78d7c663dc188… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #453: Use correct flags when running the analyzer
by Raymond Toy (＠rtoy) 10 Nov '25

10 Nov '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 2072ca19 by Raymond Toy at 2025-11-10T05:07:47-08:00 Fix #453: Use correct flags when running the analyzer - - - - - 671d8973 by Raymond Toy at 2025-11-10T05:07:47-08:00 Merge branch 'issue-453-update-make-options-for-analyzer' into 'master' Fix #453: Use correct flags when running the analyzer Closes #453 See merge request cmucl/cmucl!332 - - - - - 2 changed files: - .gitlab-ci.yml - src/lisp/Config.x86_linux Changes: ===================================== .gitlab-ci.yml ===================================== @@ -301,6 +301,7 @@ linux:static-analyzer: tags: - linux artifacts: + when: always paths: - analyzer.log needs: @@ -312,15 +313,7 @@ linux:static-analyzer: # console. If someday there's less or no output, we can consider # having the logs go to the console too. - make -C build-4/lisp clean - # From - # https://docs.gitlab.com/ci/yaml/script/#ignore-non-zero-exit-codes - # - # If the analyzer fails, we still want the logs to be saved. So - # ignore the failure, but also print a message so we know - # something happened. - - exit_code=0 - - make -C build-4/lisp CFLAGS=-fanalyzer > analyzer.log 2>&1 || exit_code=$? - - if [ $exit_code -ne 0 ]; then echo "Analyzer failed with code $exit_code"; fi; + - make -C build-4/lisp ANALYZER=-fanalyzer > analyzer.log 2>&1 #### OpenSUSE jobs #### opensuse:install: ===================================== src/lisp/Config.x86_linux ===================================== @@ -4,7 +4,9 @@ include Config.x86_common CFLAGS += $(COPT) CPPFLAGS += -m32 CFLAGS += -rdynamic -march=pentium4 -mfpmath=sse -mtune=generic -CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 +# ANALYZER flag should be set to -fanalyzer when doing the CI builds +# for the C static analyzer. +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 $(ANALYZER) UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC += linux-stubs.S View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/23ef5ca72e86eaf148cdb5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/23ef5ca72e86eaf148cdb5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0