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

[Git][cmucl/cmucl][issue-373-handle-temp-files] 2 commits: Remove unused variable.
by Raymond Toy (＠rtoy) 20 Feb '25

20 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 19b21612 by Raymond Toy at 2025-02-19T19:10:27-08:00 Remove unused variable. - - - - - 1a051ff3 by Raymond Toy at 2025-02-19T19:10:44-08:00 Update get-os-temp-path to call os_temp_path Directly call os_temp_path in get-os-temp-path. We take care to free the string that was returned. We also throw an error if NULL is returned. The path returned is made to end with a slash so that creating a CL pathname from it only has directory components. - - - - - 2 changed files: - src/code/extensions.lisp - src/lisp/os-common.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -613,11 +613,24 @@ course) change at arbitary times." `(lisp::pointer-hash ,x)) -(alien:def-alien-routine os-temp-path c-call:c-string) (defun get-os-temp-path () - "Get a path to an appropriate temporary location from the OS" - "/tmp/") + "Get a path to an appropriate temporary location from the OS. A string + is returned to that path. The path ends with a \"/\" character." + (let ((path (alien:alien-funcall + (alien:extern-alien "os_temp_path" + (function (alien:* c-call:char)))))) + (when (alien:null-alien path) + (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 "/"))) + (unless (alien:null-alien path) + (alien:free-alien path))))) ;;; WITH-TEMPORARY-STREAM -- Public ;;; ===================================== src/lisp/os-common.c ===================================== @@ -946,7 +946,6 @@ os_temp_path() // macosx has a secure per-user temporary directory. // Don't cache the result as this is only called once. char path[PATH_MAX]; - char *result; int pathSize = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); if (pathSize == 0 || pathSize > PATH_MAX) { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1f465c570bf655599cf5cf… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1f465c570bf655599cf5cf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Use limits.h instead
by Raymond Toy (＠rtoy) 20 Feb '25

20 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 1f465c57 by Raymond Toy at 2025-02-19T18:32:19-08:00 Use limits.h instead - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -22,7 +22,7 @@ #include <unistd.h> #include <time.h> #if defined(DARWIN) -#include <sys/syslimits.h> +#include <limits.h> #endif #include "os.h" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f465c570bf655599cf5cfd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f465c570bf655599cf5cfd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Define PATH_MAX on Macos
by Raymond Toy (＠rtoy) 20 Feb '25

20 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: aef4de54 by Raymond Toy at 2025-02-19T18:30:00-08:00 Define PATH_MAX on Macos - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -21,6 +21,9 @@ #include <sys/utsname.h> #include <unistd.h> #include <time.h> +#if defined(DARWIN) +#include <sys/syslimits.h> +#endif #include "os.h" #include "internals.h" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/aef4de542dbedde35088c14… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/aef4de542dbedde35088c14… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] First cut at adding os_temp_path
by Raymond Toy (＠rtoy) 19 Feb '25

19 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: ade0813f by Raymond Toy at 2025-02-19T13:24:19-08:00 First cut at adding os_temp_path Add os_temp_path to os-common.c to return an appropriate location where temporary files can be placed, depending on the OS. Currently, MacOS, has a special method to return a secure per-user temp directory. For everywhere else, we look at the TMP envvar. If it's not set, we just use "/tmp". Add get-os-temp-path in extensions.lisp to get the temporary path. This is used in the macros, but get-os-temp-path doesn't yet call `os_temp_path`. - - - - - 2 changed files: - src/code/extensions.lisp - src/lisp/os-common.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -613,6 +613,12 @@ course) change at arbitary times." `(lisp::pointer-hash ,x)) +(alien:def-alien-routine os-temp-path c-call:c-string) + +(defun get-os-temp-path () + "Get a path to an appropriate temporary location from the OS" + "/tmp/") + ;;; WITH-TEMPORARY-STREAM -- Public ;;; (defmacro with-temporary-stream ((s &key @@ -634,7 +640,8 @@ (error ":direction must be one of :output or :io, not ~S" ,direction)) (let ((,file-template (concatenate 'string - "/tmp/cmucl-temp-stream-" + (get-os-temp-path) + "cmucl-temp-stream-" "XXXXXX")) ,fd ,filename ,s) (unwind-protect @@ -673,7 +680,8 @@ (file-template (gensym "TEMP-PATH-"))) `(let ((,file-template (concatenate 'string (or ,prefix - "/tmp/cmucl-temp-file-") + (get-os-temp-path) + "cmucl-temp-file-") "XXXXXX")) ,filename) (unwind-protect @@ -702,7 +710,8 @@ (dir-template (gensym "DIR-TEMPLATE-"))) `(let ((,dir-template (concatenate 'string (or ,prefix - "/tmp/cmucl-temp-dir") + (get-os-temp-path) + "cmucl-temp-dir-") "XXXXXX")) ,dirname ,err) (unwind-protect ===================================== src/lisp/os-common.c ===================================== @@ -936,3 +936,29 @@ os_get_user_homedir(const char* name, int *status) return NULL; } +char * +os_temp_path() +{ +#if defined(DARWIN) + // macosx has a secure per-user temporary directory. + // Don't cache the result as this is only called once. + char path[PATH_MAX]; + char *result; + + int pathSize = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); + if (pathSize == 0 || pathSize > PATH_MAX) { + strlcpy(path, "/tmp", sizeof(path)); + } + + return strdup(path); +#else + char *result; + char *tmp_path = getenv("TMP"); + + if (tmp_path == NULL) { + tmp_path = "/tmp"; + } + + return strdup(tmp_path); +#endif +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ade0813f05419c46aad1590… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ade0813f05419c46aad1590… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 3 commits: Export the new temp file/stream/dir macros
by Raymond Toy (＠rtoy) 19 Feb '25

19 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 7a2eeb73 by Raymond Toy at 2025-02-19T07:16:22-08:00 Export the new temp file/stream/dir macros These are public interfaces. - - - - - 4411d4ef by Raymond Toy at 2025-02-19T07:16:53-08:00 Add :prefix keyword arg and more error checking For `with-temporary-{file,directory}`, add a `:prefix` keyword arg to allow the user to specify a prefix for the name of the temporary file or directory. Add sume error checking if `mkstemp` or `mkdtemp` fail to create the requested object. We just throw an error with a message with the template and the reason (from errno). Finally, in for the temporary stream, don't add the name of the file to the fd-stream object. The name, by default, ends up being "descriptor n" where n is the fd used. - - - - - 823351a2 by Raymond Toy at 2025-02-19T07:21:27-08:00 Change test trac.43 to use with-temporary-file Tests still passes. - - - - - 3 changed files: - src/code/exports.lisp - src/code/extensions.lisp - tests/trac.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1569,7 +1569,10 @@ "*TRUST-DYNAMIC-EXTENT-DECLARATIONS*" - "INVALID-FASL") + "INVALID-FASL" + "WITH-TEMPORARY-DIRECTORY" + "WITH-TEMPORARY-FILE" + "WITH-TEMPORARY-STREAM") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/extensions.lisp ===================================== @@ -627,22 +627,29 @@ (filename (gensym "FILENAME-")) (dir (gensym "DIRECTION-")) (okay (gensym "OKAY-")) - (err (gensym "ERR-"))) + (err (gensym "ERR-")) + (file-template (gensym "FILE-TEMPLATE-"))) `(progn (unless (member ,direction '(:output :io)) (error ":direction must be one of :output or :io, not ~S" ,direction)) - (let (,fd ,filename ,s) + (let ((,file-template (concatenate 'string + "/tmp/cmucl-temp-stream-" + "XXXXXX")) + ,fd ,filename ,s) (unwind-protect (progn (multiple-value-setq (,fd ,filename) - (unix::unix-mkstemp "/tmp/temp-stream-XXXXXX")) + (unix::unix-mkstemp ,file-template)) + (unless ,fd + (error "Unable to create temporary stream at ~S: ~A~%" + ,file-template + (unix:get-unix-error-msg ,filename))) (let* ((,dir ,direction)) (setf ,s (make-fd-stream ,fd :input (member ,dir '(:input :io)) :output (member ,dir '(:output :io)) :element-type ',element-type - :name ,filename :external-format ,external-format :decoding-error ,decoding-error :encoding-error ,encoding-error))) @@ -654,47 +661,62 @@ ,filename (unix:get-unix-error-msg ,err)))) (locally ,@decls ,@forms)) - ;; Close the stream and the fd now that we're done. - (close ,s) - (unix:unix-close ,fd)))))) + ;; Close the stream which will close the fd now that we're + ;; done. + (when ,s + (close ,s))))))) ;;; WITH-TEMPORARY-FILE -- Public -(defmacro with-temporary-file ((filename) +(defmacro with-temporary-file ((filename &key prefix) &parse-body (forms decls)) - (let ((fd (gensym "FD-"))) - `(let (,filename) + (let ((fd (gensym "FD-")) + (file-template (gensym "TEMP-PATH-"))) + `(let ((,file-template (concatenate 'string + (or ,prefix + "/tmp/cmucl-temp-file-") + "XXXXXX")) + ,filename) (unwind-protect (let (,fd) (multiple-value-setq (,fd ,filename) - (unix::unix-mkstemp "/tmp/cmucl-temp-file-XXXXXX")) + (unix::unix-mkstemp ,file-template)) + (unless ,fd + (error "Unable to create temporary file with template ~S: ~A~%" + ,file-template + (unix:get-unix-error-msg ,filename))) (unix:unix-close ,fd) (locally ,@decls ,@forms)) - (delete-file ,filename))))) - + ;; We're done so delete the temp file, if one was created. + (when (stringp ,filename) + (delete-file ,filename)))))) ;;; WITH-TEMPORARY-DIRECTORY -- Public -(defmacro with-temporary-directory ((dirname template) +(defmacro with-temporary-directory ((dirname &key prefix) &parse-body (forms decls)) "Return a pathname to a temporary directory. TEMPLATE 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." - (let ((err (gensym "ERR-"))) - `(let (,dirname ,err) + (let ((err (gensym "ERR-")) + (dir-path (gensym "DIR-PATH")) + (dir-template (gensym "DIR-TEMPLATE-"))) + `(let ((,dir-template (concatenate 'string + (or ,prefix + "/tmp/cmucl-temp-dir") + "XXXXXX")) + ,dirname ,err) (unwind-protect (progn (multiple-value-setq (,dirname ,err) - (unix::unix-mkdtemp (concatenate 'string ,template - "XXXXXX"))) + (unix::unix-mkdtemp ,dir-template)) (unless ,dirname - (error "Unable to create temporary directory: ~A" + (error "Unable to create temporary directory at ~S: ~A" + ,dir-template (unix:get-unix-error-msg ,err))) (setf ,dirname (concatenate 'string ,dirname "/")) (locally ,@decls ,@forms)) - ;; Remove the temp directory and all its contents. Is there a - ;; better way? + ;; 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" ,dirname))))))) - - ===================================== tests/trac.lisp ===================================== @@ -127,16 +127,17 @@ (:tag :trac) (flet ((bug (&optional (format :utf16)) (ext::with-temporary-stream (s :direction :io :external-format format) - (format s "Hello~%") - (format t "posn = ~A~%" (file-position s)) - (file-position s 0) - (let ((ch (read-char s))) - (values ch (file-position s)))))) + (format s "Hello~%") + (format t "posn = ~A~%" (file-position s)) + (file-position s 0) + (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 @@ -156,6 +157,23 @@ (let ((p0* (file-position stream))) (eql p0* p0))))))))) +(define-test trac.43 + (:tag :trac) + (assert-true + (ext:with-temporary-file (path) + (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.50 (:tag :trac) (assert-equal "#P(:DIRECTORY (:ABSOLUTE \"tmp\" \"\" \"a\" \"\" \"b\"))" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9da10f582cd173e1569f3e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9da10f582cd173e1569f3e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Document sap-ref-64 and signed-sap-ref-64
by Carl Shapiro (＠cshapiro) 19 Feb '25

19 Feb '25

Carl Shapiro pushed to branch master at cmucl / cmucl Commits: ef48eb2a by Carl Shapiro at 2025-02-18T22:46:55-08:00 Document sap-ref-64 and signed-sap-ref-64 These functions have existed on almost all targets for many years now. - - - - - 1 changed file: - src/docs/cmu-user/unix.tex Changes: ===================================== src/docs/cmu-user/unix.tex ===================================== @@ -244,9 +244,10 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{sap-ref-16}{\args{\var{sap} \var{offset}}} - \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}}} - - These functions return the 8, 16 or 32 bit unsigned integer at + \defunx[system:]{sap-ref-32}{\args{\var{sap} \var{offset}} + \defunx[system:]{sap-ref-64}{\args{\var{sap} \var{offset}}} + + These functions return the 8, 16, 32 or 64 bit unsigned integer at \var{offset} from \var{sap}. The \var{offset} is always a byte offset, regardless of the number of bits accessed. \code{setf} may be used with the these functions to deposit values into virtual @@ -256,7 +257,8 @@ for SAPs when possible, so the consing overhead is generally minimal. \begin{defun}{system:}{signed-sap-ref-8}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-16}{\args{\var{sap} \var{offset}}} \defunx[system:]{signed-sap-ref-32}{\args{\var{sap} \var{offset}}} - + \defunx[system:]{signed-sap-ref-64}{\args{\var{sap} \var{offset}}} + These functions are the same as the above unsigned operations, except that they sign-extend, returning a negative number if the high bit is set. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef48eb2a5fd47915030fc7e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ef48eb2a5fd47915030fc7e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Update from HEAD to fix incorrect merge
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 9da10f58 by Raymond Toy at 2025-02-18T05:54:18-08:00 Update from HEAD to fix incorrect merge Just update tests/unix.lisp from HEAD because we messed up the merge previously and left some unmerged diffs in by accident. - - - - - 1 changed file: - tests/unix.lisp Changes: ===================================== tests/unix.lisp ===================================== @@ -7,19 +7,6 @@ (define-test mkstemp.name-returned (:tag :issues) -<<<<<<< HEAD - (let (fd name) - (unwind-protect - (progn - (multiple-value-setq (fd name) - (unix::unix-mkstemp "test-XXXXXX")) - (assert-true fd) - (assert-false (search "XXXXXX" name))) - (when fd - (unix:unix-unlink name))))) - -(define-test mkstemp.name-returned.2 -======= (let (fd filename) (unwind-protect (progn @@ -34,7 +21,6 @@ (unix:unix-unlink filename))))) (define-test mkstemp.non-ascii-name-returned ->>>>>>> master (:tag :issues) (let ((unix::*filename-encoding* :utf-8) fd name) @@ -76,7 +62,7 @@ (when name (unix:unix-rmdir name))))) -(define-test mkdtemp.name-returned.2 +(define-test mkdtemp.non-ascii-name-returned (:tag :issues) (let ((unix::*filename-encoding* :utf-8) name) @@ -101,3 +87,5 @@ (unix::unix-mkdtemp "random-dir/dir-XXXXXX") (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9da10f582cd173e1569f3e8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9da10f582cd173e1569f3e8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] 7 commits: Fix #379: Support GNU-style command line option names
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 67cb15e6 by Raymond Toy at 2025-02-15T15:34:50+00:00 Fix #379: Support GNU-style command line option names - - - - - 38da65c4 by Raymond Toy at 2025-02-15T15:34:50+00:00 Merge branch 'issue-379-gnu-style-options' into 'master' Fix #379: Support GNU-style command line option names Closes #379 See merge request cmucl/cmucl!266 - - - - - 03081eeb by Raymond Toy at 2025-02-17T01:52:03+00:00 Fix #382: Make command-line options be case-sensitive instead of case-insenstive - - - - - ee669070 by Raymond Toy at 2025-02-17T01:52:04+00:00 Merge branch 'issue-382-command-line-options-case-sensitive' into 'master' Fix #382: Make command-line options be case-sensitive instead of case-insenstive Closes #382 See merge request cmucl/cmucl!267 - - - - - 459c91bc by Raymond Toy at 2025-02-18T02:53:23+00:00 Fix #375: Return the name of the temp file or directory - - - - - daf83c84 by Raymond Toy at 2025-02-18T02:53:23+00:00 Merge branch 'issue-375-mkstemp-return-filename' into 'master' Fix #375: Return the name of the temp file or directory Closes #375 See merge request cmucl/cmucl!265 - - - - - b7ca3635 by Raymond Toy at 2025-02-17T18:55:33-08:00 Merge branch 'master' into issue-373-handle-temp-files - - - - - 7 changed files: - src/code/commandline.lisp - src/code/unix.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - src/lisp/lisp.c - tests/unix.lisp Changes: ===================================== src/code/commandline.lisp ===================================== @@ -109,7 +109,13 @@ (return (setf *command-line-switches* (nreverse *command-line-switches*)))) (let* ((position (position #\= (the simple-string str) :test #'char=)) - (switch (subseq (the simple-string str) 1 position)) + ;; Extract the name of the switch. The actual arg can be + ;; "-switch" or "--switch". + (switch (subseq (the simple-string str) + (position-if-not #'(lambda (c) + (char= c #\-)) + str) + position)) (value (if position (subseq (the simple-string str) (1+ position) (length (the simple-string str)))))) @@ -143,7 +149,14 @@ the switch. If no value was specified, then any following words are returned. If there are no following words, then t is returned. If the switch was not specified, then nil is returned." - (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname)) + (let* ((posn (position-if-not #'(lambda (ch) + (char= ch #\-)) + sname)) + ;; Strip up to 2 leading "-" to get the switch name. + ;; Otherwise, return the entire switch name. + (name (if (and posn (<= posn 2)) + (subseq sname posn) + sname)) (switch (find name *command-line-switches* :test #'string-equal :key #'cmd-switch-name))) @@ -177,17 +190,17 @@ (demons *command-switch-demons*)) (flet ((invoke-demon (switch) (let* ((name (cmd-switch-name switch)) - (demon (cdr (assoc name demons :test #'string-equal)))) + (demon (cdr (assoc name demons :test #'string=)))) (cond (demon (funcall demon switch)) - ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car) + ((or (member name *legal-cmd-line-switches* :test #'string= :key #'car) (not *complain-about-illegal-switches*))) (t (warn (intl:gettext "~S is an illegal switch") switch))) (lisp::finish-standard-output-streams)))) ;; We want to process -help (or --help) first, if it's given. ;; Since we're asking for help, we don't want to process any of ;; the other switches. - (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal) - (find "-help" switches :key #'cmd-switch-name :test #'string-equal)))) + (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string=) + (find "-help" switches :key #'cmd-switch-name :test #'string=)))) (if maybe-help (invoke-demon maybe-help) (dolist (switch switches t) @@ -230,12 +243,12 @@ (lisp::finish-standard-output-streams) (setf start next))))) -;; Docstrings should have lines longer than 72 characters so that we -;; can print out the docstrings nicely on one line for help. -;; | <-- char 72 +;; Docstrings MUST consist of simple text and punctuation and +;; newlines; no special markup is allowed. When help is printed, the +;; help string is automatically filled and wrapped to 80 columns. (defswitch "eval" #'eval-switch-demon "Evaluate the specified Lisp expression during the start up - sequence. the value of the form will not be printed unless it is + sequence. The value of the form will not be printed unless it is wrapped in a form that does output." "expression") @@ -325,7 +338,7 @@ (defswitch "quiet" nil "Causes Lisp to start up silently, disabling printing of the herald - and causing most unnecessary noise, like GC messages,load messages, + and causing most unnecessary noise, like GC messages, load messages, etc. to be suppressed.") (defswitch "debug-lisp-search" nil @@ -338,7 +351,8 @@ (defun help-switch-demon (switch) (declare (ignore switch)) - (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*) + (format t (intl:gettext "~&Usage: ~A <options> [-- [app-args]*]~2%") + *command-line-utility-name*) (flet ((get-words (s) (declare (string s)) @@ -366,7 +380,12 @@ :key #'car)) (destructuring-bind (name doc arg) s - (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg))) + ;; Print both -switch and --switch, and the optional arg + ;; value. + (format t " -~A|--~A ~@[~A~]~%" + name name + (if arg (intl:gettext arg))) + ;; Poor man's formatting of the help string (let ((*print-right-margin* 80)) ;; Extract all the words from the string and print them out @@ -392,9 +411,6 @@ (defswitch "help" #'help-switch-demon "Print out the command line options and exit") -(defswitch "-help" #'help-switch-demon - "Same as -help.") - (defun version-switch-demon (switch) (declare (ignore switch)) (format t "~A~%" (lisp-implementation-version)) @@ -406,8 +422,3 @@ ;; it out so the user knows about it. (defswitch "version" #'version-switch-demon "Prints the cmucl version and exits, without loading the lisp core.") - -;; Make --version work for the benefit of those who are accustomed to -;; GNU software. -(defswitch "-version" #'version-switch-demon - "Prints the cmucl version and exits; same as -version") ===================================== src/code/unix.lisp ===================================== @@ -2921,8 +2921,10 @@ (with-alien ((buffer (* c-call:unsigned-char))) (setf buffer (make-alien c-call:unsigned-char (1+ length))) ;; Copy the octets from OCTETS to the null-terminated array BUFFER. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) (setf (deref buffer length) 0) (syscall ("mkstemp" (* c-call:char)) @@ -2930,8 +2932,10 @@ (progn ;; Copy out the alien bytes and convert back ;; to a lisp string. - (dotimes (k length) - (setf (aref octets k) (deref buffer k))) + (system:without-gcing + (kernel:system-area-copy (alien-sap buffer) 0 + (vector-sap octets) 0 + (* length vm:byte-bits))) (stream:octets-to-string octets :external-format format))) (cast buffer (* c-call:char)))))) @@ -2955,8 +2959,12 @@ (with-alien ((buffer (* c-call:unsigned-char))) (setf buffer (make-alien c-call:unsigned-char (1+ length))) ;; Copy the octets from OCTETS to the null-terminated array BUFFER. - (dotimes (k length) - (setf (deref buffer k) (aref octets k))) + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + (let ((result (alien-funcall (extern-alien "mkdtemp" (function (* char) ===================================== src/general-info/release-21f.md ===================================== @@ -119,6 +119,7 @@ public domain. * ~~#364~~ Add interface to `mkdtemp` and `mkstemp` * ~~#367~~ Add stream:string-count-octets to count octets in a string * ~~#369~~ Improve docstring for `unix::unix-setlocale` + * ~~#379~~ Support GNU-style command-line option names * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1440,16 +1440,17 @@ msgstr "" msgid "" "Generates a unique temporary file name from TEMPLATE, and creates\n" " and opens the file. On success, the corresponding file descriptor\n" -" and name of the file is returned.\n" -"\n" -" The last six characters of the template must be \"XXXXXX\"." +" and name of the file is returned. Otherwise, NIL and the UNIX error\n" +" code is returned." msgstr "" #: src/code/unix.lisp msgid "" -"Generate a uniquely named temporary directory from Template,\n" -" which must have \"XXXXXX\" as the last six characters. The\n" +"Generate a uniquely named temporary directory from Template. The\n" " directory is created with permissions 0700. The name of the\n" -" directory is returned." +" directory is returned.\n" +"\n" +" If the directory cannot be created NIL and the UNIX error code is\n" +" returned." msgstr "" ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6060,7 +6060,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Evaluate the specified Lisp expression during the start up\n" -" sequence. the value of the form will not be printed unless it is\n" +" sequence. The value of the form will not be printed unless it is\n" " wrapped in a form that does output." msgstr "" @@ -6182,7 +6182,7 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Causes Lisp to start up silently, disabling printing of the herald\n" -" and causing most unnecessary noise, like GC messages,load messages,\n" +" and causing most unnecessary noise, like GC messages, load messages,\n" " etc. to be suppressed." msgstr "" @@ -6197,25 +6197,17 @@ msgid "Specify the unidata.bin file to be used." msgstr "" #: src/code/commandline.lisp -msgid "~&Usage: ~A <options>~2%" +msgid "~&Usage: ~A <options> [-- [app-args]*]~2%" msgstr "" #: src/code/commandline.lisp msgid "Print out the command line options and exit" msgstr "" -#: src/code/commandline.lisp -msgid "Same as -help." -msgstr "" - #: src/code/commandline.lisp msgid "Prints the cmucl version and exits, without loading the lisp core." msgstr "" -#: src/code/commandline.lisp -msgid "Prints the cmucl version and exits; same as -version" -msgstr "" - #: src/code/env-access.lisp msgid "" "Returns information about the symbol VAR in the lexical environment ENV.\n" ===================================== src/lisp/lisp.c ===================================== @@ -460,6 +460,41 @@ core_failure(const char* core, const char* argv[]) exit(1); } +/* + * Match the actual command line option "arg" with the arg name in + * "argname". The option matches if it is exacty the arg name + * prefixed by either one or two "-" characters. + * + * Returns non-zero if it matches. + */ +int match_option(const char* arg, const char* argname) +{ + if ((strlen(arg) < 2) || strlen(argname) < 1) { + /* + * The actual arg must be at least 2 characters. The argname + * must have at least 1. + */ + return 0; + } + + /* Must start with a "-" */ + if (arg[0] != '-') { + return 0; + } + + if (strcmp(arg + 1, argname) == 0) { + /* We have "-" followed by the argname. That's a match. */ + return 1; + } + + if ((arg[1] == '-') && (strcmp(arg + 2, argname) == 0)) { + /* We have "--" followed by the argname. That's a match. */ + return 1; + } + + return 0; +} + int main(int argc, const char *argv[], const char *envp[]) { @@ -529,7 +564,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-core") == 0) { + if (match_option(arg, "core")) { if (builtin_image_flag) { fprintf(stderr, "Warning: specifying a core file with an executable image is unusual,\nbut should work.\n"); @@ -543,87 +578,98 @@ main(int argc, const char *argv[], const char *envp[]) core = *++argptr; if (core == NULL) { fprintf(stderr, - "-core must be followed by the name of the core file to use.\n"); + "%s must be followed by the name of the core file to use.\n", + arg); exit(1); } - } else if (strcmp(arg, "-lib") == 0) { + } else if (match_option(arg, "lib")) { lib = *++argptr; if (lib == NULL) { fprintf(stderr, - "-lib must be followed by a string denoting the CMUCL library path.\n"); + "%s must be followed by a string denoting the CMUCL library path.\n", + arg); exit(1); } - } else if (strcmp(arg, "-read-only-space-size") == 0) { + } else if (match_option(arg, "read-only-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-read-only-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } read_only_space_size = atoi(str) * 1024 * 1024; if (read_only_space_size > READ_ONLY_SPACE_SIZE) { fprintf(stderr, - "-read-only-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, READ_ONLY_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); read_only_space_size = READ_ONLY_SPACE_SIZE; } - } else if (strcmp(arg, "-static-space-size") == 0) { + } else if (match_option(arg, "static-space-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-static-space-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } static_space_size = atoi(str) * 1024 * 1024; if (static_space_size > STATIC_SPACE_SIZE) { fprintf(stderr, - "-static-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, STATIC_SPACE_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); static_space_size = STATIC_SPACE_SIZE; } - } else if (strcmp(arg, "-binding-stack-size") == 0) { + } else if (match_option(arg, "binding-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-binding-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } binding_stack_size = atoi(str) * 1024 * 1024; if (binding_stack_size > BINDING_STACK_SIZE) { fprintf(stderr, - "-binding-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, BINDING_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); binding_stack_size = BINDING_STACK_SIZE; } - } else if (strcmp(arg, "-control-stack-size") == 0) { + } else if (match_option(arg, "control-stack-size")) { const char *str = *++argptr; if (str == NULL) { fprintf(stderr, - "-control-stack-size must be followed by the size in MBytes.\n"); + "%s must be followed by the size in MBytes.\n", + arg); exit(1); } control_stack_size = atoi(str) * 1024 * 1024; if (control_stack_size > CONTROL_STACK_SIZE) { fprintf(stderr, - "-control-stack-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, CONTROL_STACK_SIZE / (1024 * 1024UL)); fprintf(stderr, " Continuing with default size.\n"); control_stack_size = CONTROL_STACK_SIZE; } - } else if (strcmp(arg, "-dynamic-space-size") == 0) { + } else if (match_option(arg, "dynamic-space-size")) { const char *str; str = *++argptr; if (str == NULL) { fprintf(stderr, - "-dynamic-space-size must be followed by the size to use in MBytes.\n"); + "%s must be followed by the size to use in MBytes.\n", + arg); exit(1); } #ifndef sparc @@ -669,15 +715,16 @@ main(int argc, const char *argv[], const char *envp[]) #endif if (dynamic_space_size > DYNAMIC_SPACE_SIZE) { fprintf(stderr, - "-dynamic-space-size must be no greater than %lu MBytes.\n", + "%s must be no greater than %lu MBytes.\n", + arg, DYNAMIC_SPACE_SIZE / (1024 * 1024UL)); exit(1); } - } else if (strcmp(arg, "-monitor") == 0) { + } else if (match_option(arg, "monitor")) { monitor = TRUE; - } else if (strcmp(arg, "-debug-lisp-search") == 0) { + } else if (match_option(arg, "debug-lisp-search")) { debug_lisp_search = TRUE; - } else if (strcmp(arg, "-unidata") == 0) { + } else if (match_option(arg, "unidata")) { unidata = *++argptr; } else if ((strcmp(arg, "-version") == 0) || (strcmp(arg, "--version") == 0)) { @@ -904,7 +951,7 @@ main(int argc, const char *argv[], const char *envp[]) argptr = argv; while ((arg = *++argptr) != NULL) { - if (strcmp(arg, "-batch") == 0) + if (match_option(arg, "batch")) SetSymbolValue(BATCH_MODE, T); } ===================================== tests/unix.lisp ===================================== @@ -7,6 +7,7 @@ (define-test mkstemp.name-returned (:tag :issues) +<<<<<<< HEAD (let (fd name) (unwind-protect (progn @@ -18,6 +19,22 @@ (unix:unix-unlink name))))) (define-test mkstemp.name-returned.2 +======= + (let (fd filename) + (unwind-protect + (progn + (let ((template "test-XXXXXX")) + (multiple-value-setq (fd filename) + (unix::unix-mkstemp (copy-seq template))) + (assert-true fd) + (assert-true (equalp (length filename) (length template))) + (assert-false (equalp filename template)) + (assert-true (>= 5 (mismatch filename template)))))) + (when fd + (unix:unix-unlink filename))))) + +(define-test mkstemp.non-ascii-name-returned +>>>>>>> master (:tag :issues) (let ((unix::*filename-encoding* :utf-8) fd name) @@ -47,28 +64,6 @@ (assert-false fd) (assert-true (and (integerp errno) (plusp errno))))) -;; Darwin accepts this template. It creates the file "test-". -#-darwin -(define-test mkstemp.bad-template - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-") - ;; The template doesn't have enough X's so the FD should be NIL, - ;; and a positive Unix errno value should be returned. - (assert-false fd) - (assert-true (and (integerp errno) (plusp errno))))) - -;; Darwin accepts this template and just creates the file -;; "test-XXXXXXa". (The next call would return an error.) -#-darwin -(define-test mkstemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (fd errno) - (unix::unix-mkstemp "test-XXXXXXa") - ;; The template doesn't end in X's - (assert-false fd) - (assert-true (and (integerp errno) (plusp errno))))) - (define-test mkdtemp.name-returned (:tag :issues) (let (name) @@ -106,23 +101,3 @@ (unix::unix-mkdtemp "random-dir/dir-XXXXXX") (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) - -;; Darwin allows any number of X's. -#-darwin -(define-test mkdtemp.bad-template - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-") - ;; No X's in template, like for mkstemp.bad-template test. - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) - -;; Same issue with mkdtemp as with mkstemp above on Darwin. -#-darwin -(define-test mkdtemp.bad-template.2 - (:tag :issues) - (multiple-value-bind (result errno) - (unix::unix-mkdtemp "dir-XXXXXXa") - ;; Template doesn't end in X's - (assert-false result) - (assert-true (and (integerp errno) (plusp errno))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/578efc93eb195def77a847… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/578efc93eb195def77a847… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #375: Return the name of the temp file or directory
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 459c91bc by Raymond Toy at 2025-02-18T02:53:23+00:00 Fix #375: Return the name of the temp file or directory - - - - - daf83c84 by Raymond Toy at 2025-02-18T02:53:23+00:00 Merge branch 'issue-375-mkstemp-return-filename' into 'master' Fix #375: Return the name of the temp file or directory Closes #375 See merge request cmucl/cmucl!265 - - - - - 3 changed files: - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - + tests/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2907,28 +2907,71 @@ (defun unix-mkstemp (template) _N"Generates a unique temporary file name from TEMPLATE, and creates and opens the file. On success, the corresponding file descriptor - and name of the file is returned. - - The last six characters of the template must be \"XXXXXX\"." - ;; Hope this buffer is large enough! - (let ((octets (%name->file template))) - (syscall ("mkstemp" c-call:c-string) + and name of the file is returned. Otherwise, NIL and the UNIX error + code is returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Convert the string to octets using the + ;; *FILENAME-ENCODING*. Should we signal an error if the + ;; string can't be encoded? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (syscall ("mkstemp" (* c-call:char)) (values result - ;; Convert the file name back to a Lisp string. - (%file->name octets)) - octets))) + (progn + ;; Copy out the alien bytes and convert back + ;; to a lisp string. + (system:without-gcing + (kernel:system-area-copy (alien-sap buffer) 0 + (vector-sap octets) 0 + (* length vm:byte-bits))) + (stream:octets-to-string octets + :external-format format))) + (cast buffer (* c-call:char)))))) (defun unix-mkdtemp (template) - _N"Generate a uniquely named temporary directory from Template, - which must have \"XXXXXX\" as the last six characters. The + _N"Generate a uniquely named temporary directory from Template. The directory is created with permissions 0700. The name of the - directory is returned." - (let* ((octets (%name->file template)) - (result (alien-funcall - (extern-alien "mkdtemp" - (function (* char) - c-call:c-string)) - octets))) - (if (null-alien result) - (values nil (unix-errno)) - (%file->name octets)))) + directory is returned. + + If the directory cannot be created NIL and the UNIX error code is + returned." + (let* ((format (if (eql *filename-encoding* :null) + :iso8859-1 + *filename-encoding*)) + ;; Encode the string using the appropriate + ;; *filename-encoding*. Should we signal an error if the + ;; string can't be encoded in that format? + (octets (stream:string-to-octets template + :external-format format)) + (length (length octets))) + (with-alien ((buffer (* c-call:unsigned-char))) + (setf buffer (make-alien c-call:unsigned-char (1+ length))) + ;; Copy the octets from OCTETS to the null-terminated array BUFFER. + (system:without-gcing + (kernel:system-area-copy (vector-sap octets) 0 + (alien-sap buffer) 0 + (* length vm:byte-bits))) + (setf (deref buffer length) 0) + + (let ((result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + (* char))) + (cast buffer (* char))))) + ;; If mkdtemp worked, a non-NIL value is returned, return the + ;; resulting name. Otherwise, return NIL and the errno. + (if (null-alien result) + (values nil (unix-errno)) + (%file->name (cast result c-call:c-string))))))) ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1440,16 +1440,17 @@ msgstr "" msgid "" "Generates a unique temporary file name from TEMPLATE, and creates\n" " and opens the file. On success, the corresponding file descriptor\n" -" and name of the file is returned.\n" -"\n" -" The last six characters of the template must be \"XXXXXX\"." +" and name of the file is returned. Otherwise, NIL and the UNIX error\n" +" code is returned." msgstr "" #: src/code/unix.lisp msgid "" -"Generate a uniquely named temporary directory from Template,\n" -" which must have \"XXXXXX\" as the last six characters. The\n" +"Generate a uniquely named temporary directory from Template. The\n" " directory is created with permissions 0700. The name of the\n" -" directory is returned." +" directory is returned.\n" +"\n" +" If the directory cannot be created NIL and the UNIX error code is\n" +" returned." msgstr "" ===================================== tests/unix.lisp ===================================== @@ -0,0 +1,91 @@ +;;; Tests for the unix interface + +(defpackage :unix-tests + (:use :cl :lisp-unit)) + +(in-package "UNIX-TESTS") + +(define-test mkstemp.name-returned + (:tag :issues) + (let (fd filename) + (unwind-protect + (progn + (let ((template "test-XXXXXX")) + (multiple-value-setq (fd filename) + (unix::unix-mkstemp (copy-seq template))) + (assert-true fd) + (assert-true (equalp (length filename) (length template))) + (assert-false (equalp filename template)) + (assert-true (>= 5 (mismatch filename template)))))) + (when fd + (unix:unix-unlink filename))))) + +(define-test mkstemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + fd name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "test-XXXXXX")) + (x-posn (position #\X template))) + (multiple-value-setq (fd name) + (unix::unix-mkstemp template)) + (assert-true fd) + (assert-false (search "XXXXXX" name) + name) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name))) + (when fd + (unix:unix-unlink name))))) + +(define-test mkstemp.bad-path + (:tag :issues) + (multiple-value-bind (fd errno) + ;; Assumes that the directory "random-dir" doesn't exist + (unix::unix-mkstemp "random-dir/test-XXXXXX") + ;; Can't create and open the file so the FD should be NIL, and a + ;; positive Unix errno value should be returned. + (assert-false fd) + (assert-true (and (integerp errno) (plusp errno))))) + +(define-test mkdtemp.name-returned + (:tag :issues) + (let (name) + (unwind-protect + (progn + (setf name (unix::unix-mkdtemp "dir-XXXXXX")) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.non-ascii-name-returned + (:tag :issues) + (let ((unix::*filename-encoding* :utf-8) + name) + (unwind-protect + (progn + ;; Temp name starts with a lower case alpha character. + (let* ((template (concatenate 'string (string #\u+3b1) + "dir-XXXXXX")) + (x-posn (position #\X template))) + (setf name (unix::unix-mkdtemp template)) + ;; Verify that the dir name no longer has X's. + (assert-true (stringp name)) + (assert-false (search "XXXXXX" name)) + (assert-true (string= name template :end1 x-posn :end2 x-posn) + name x-posn))) + (when name + (unix:unix-rmdir name))))) + +(define-test mkdtemp.bad-path + (:tag :issues) + (multiple-value-bind (result errno) + (unix::unix-mkdtemp "random-dir/dir-XXXXXX") + (assert-false result) + (assert-true (and (integerp errno) (plusp errno))))) + + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ee6690706cab10fa066030… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ee6690706cab10fa066030… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-373-handle-temp-files] Add with-temporary-file to create a temporary file
by Raymond Toy (＠rtoy) 18 Feb '25

18 Feb '25

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 578efc93 by Raymond Toy at 2025-02-17T17:48:37-08:00 Add with-temporary-file to create a temporary file Use mkstemp to create a file and return the file name. On completion, the file is deleted. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -658,6 +658,21 @@ (close ,s) (unix:unix-close ,fd)))))) +;;; WITH-TEMPORARY-FILE -- Public +(defmacro with-temporary-file ((filename) + &parse-body (forms decls)) + (let ((fd (gensym "FD-"))) + `(let (,filename) + (unwind-protect + (let (,fd) + (multiple-value-setq (,fd ,filename) + (unix::unix-mkstemp "/tmp/cmucl-temp-file-XXXXXX")) + (unix:unix-close ,fd) + (locally ,@decls + ,@forms)) + (delete-file ,filename))))) + + ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname template) &parse-body (forms decls)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/578efc93eb195def77a847a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/578efc93eb195def77a847a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0