cmucl-cvs January 2025

cmucl-cvs@common-lisp.net

1 participants
9 discussions

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] mkdtemp needs to encode/decode Lisp strings
by Raymond Toy (＠rtoy) 03 Jan '25

03 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 3d4af597 by Raymond Toy at 2025-01-03T13:35:21-08:00 mkdtemp needs to encode/decode Lisp strings Before calling `mkdtemp`, we need to convert the Lisp string to octets. On return, the octets that were passed to `mkdtemp` have been modified to hold the directory name. These octets need to be converted back to a Lisp string. Tested with the template "/tmp/α-dir-XXXXXX". The result was "/tmp/α-dir-jSt2SC". I verified that this directory was actually created. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2932,27 +2932,12 @@ which must have \"XXXXXX\" as the last six characters. The directory is created with permissions 0700. The name of the directory is returned." - (let* ((new-template (copy-seq template)) + (let* ((octets (%name->file template)) (result (alien-funcall (extern-alien "mkdtemp" (function (* char) c-call:c-string)) - new-template))) - (if (zerop (deref result 0)) - (values nil (unix-errno)) - (cast result c-call:c-string)))) - -(defun unix-mkdtemp (template) - _N"Generate a uniquely named temporary directory from Template, - which must have \"XXXXXX\" as the last six characters. The - directory is created with permissions 0700. The name of the - directory is returned." - (let* ((new-template (copy-seq template)) - (result (alien-funcall - (extern-alien "mkdtemp" - (function (* char) - c-call:c-string)) - new-template))) + octets))) (if (zerop (sap-int (alien-sap result))) (values nil (unix-errno)) - (cast result c-string)))) + (%file->name octets)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3d4af597c0f721644199648… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3d4af597c0f721644199648… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] unix-mkstemp returns the file descriptor and the file name
by Raymond Toy (＠rtoy) 03 Jan '25

03 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 1beae8cb by Raymond Toy at 2025-01-03T12:00:26-08:00 unix-mkstemp returns the file descriptor and the file name Previously, we only returned the file descriptor. Now we return the descriptor and the file name associated with the file. This is available to us because `mkstemp` modifies the template with the actual file name. Also, we use %name->file to encode the Lisp string into a set of octets to pass to `mkstemp`. This means we need to convert updated template to a Lisp string. Tested this using the template "/tmp/α-XXXXXX" (alpha character followed by "-XXXXXX"). The resulting file name was "/tmp/α-L2egJE" whith the X's appropriately replaced. - - - - - 1 changed file: - src/code/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== @@ -2902,13 +2902,30 @@ c-string)) (defun unix-mkstemp (template) - _N"Generates a unique temporary file name from TEMPLATE, creates and - opens the file and returns a file stream for the file. + _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\"." - (syscall ("mkstemp" c-call:c-string) - result - (copy-seq template))) + ;; Hope this buffer is large enough! + (let ((octets (%name->file template))) + (unless (< (length octets) 8192) + (error "Internal buffer is too small for encoded file name of ~D octets" + (length octets))) + (with-alien ((buf (array c-call:unsigned-char 8192))) + ;; Convert the Lisp string and copy it to the alien buffer, being + ;; sure to zero-terminate the buffer. + (loop for k from 0 + for c across octets + do + (setf (deref buf k) (char-code c)) + finally (setf (deref buf k) 0)) + + (syscall ("mkstemp" (* c-call:unsigned-char)) + (values result + ;; Convert the file name back to a Lisp string. + (%file->name (cast buf c-call:c-string))) + (cast buf (* c-call:unsigned-char)))))) (defun unix-mkdtemp (template) _N"Generate a uniquely named temporary directory from Template, View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1beae8cbd0a126b59d7fab9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1beae8cbd0a126b59d7fab9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] Error out if mkstemp fails
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 2ea25988 by Raymond Toy at 2025-01-01T14:17:46-08:00 Error out if mkstemp fails If `mkstemp` can't create a temp file, signal an error about it. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -637,29 +637,34 @@ :decoding-error - How to handle decoding errors. See OPEN :encoding-error - How to handle encoding errors. See OPEN" (let ((abortp (gensym)) - (template (gensym "TEMPLATE-"))) + (template (gensym "TEMPLATE-")) + (fd (gensym "FD-"))) `(let* ((,template (concatenate 'string ,template-prefix "XXXXXX")) - (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) - :auto-close t - :file ,template - :output t - :input t - :element-type ',element-type - :external-format ,external-format - :decoding-error ,decoding-error - :encoding-error ,encoding-error - :buffering ,buffering)) - (,abortp t)) - ,@decls - (unwind-protect - (multiple-value-prog1 - (progn ,@forms) - (setq ,abortp nil)) - (when ,var - (close ,var :abort ,abortp)))))) + (,fd (unix::unix-mkstemp ,template))) + (unless ,fd + (error "Could not create temporary file using template ~A" + ,template)) + (let ((,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) + :auto-close t + :file ,template + :output t + :input t + :element-type ',element-type + :external-format ,external-format + :decoding-error ,decoding-error + :encoding-error ,encoding-error + :buffering ,buffering)) + (,abortp t)) + ,@decls + (unwind-protect + (multiple-value-prog1 + (progn ,@forms) + (setq ,abortp nil)) + (when ,var + (close ,var :abort ,abortp))))))) ;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((var template-prefix) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ea25988f79909ada0f0206… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2ea25988f79909ada0f0206… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] Fix typo in exporting with-temporary-file/directory stuff
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 2c0e07e6 by Raymond Toy at 2025-01-01T13:44:19-08:00 Fix typo in exporting with-temporary-file/directory stuff - - - - - 1 changed file: - src/code/exports.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1719,8 +1719,9 @@ "STRING-ENCODE" "STRING-DECODE" "SET-SYSTEM-EXTERNAL-FORMAT") ;; Temporary files/directories - "WITH-TEMPORARY-FILE" - "WITH-TEMPORARY-DIRECTORY") + (:export + "WITH-TEMPORARY-FILE" + "WITH-TEMPORARY-DIRECTORY")) (defpackage "STREAM" (:import-from "SYSTEM" "LISP-STREAM") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c0e07e6eb887375b62270a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c0e07e6eb887375b62270a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] Export with-temporary-{file,directory}
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 14c6f722 by Raymond Toy at 2025-01-01T11:29:01-08:00 Export with-temporary-{file,directory} - - - - - 1 changed file: - src/code/exports.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1717,7 +1717,10 @@ "DESCRIBE-EXTERNAL-FORMAT" "LIST-ALL-EXTERNAL-FORMATS" "STRING-ENCODE" "STRING-DECODE" - "SET-SYSTEM-EXTERNAL-FORMAT")) + "SET-SYSTEM-EXTERNAL-FORMAT") + ;; Temporary files/directories + "WITH-TEMPORARY-FILE" + "WITH-TEMPORARY-DIRECTORY") (defpackage "STREAM" (:import-from "SYSTEM" "LISP-STREAM") View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/14c6f72214d97ef1a38b658… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/14c6f72214d97ef1a38b658… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] Add unix-mkdtemp and with-temporary-directory
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 146b616f by Raymond Toy at 2025-01-01T11:24:46-08:00 Add unix-mkdtemp and with-temporary-directory Add `unix-mkdtemp` as a very basic interface to `mkdtemp` that returns the name of the directory. The macro `ext:with-temporary-directory` creates a temporary directory with the given prefix and executes the body with the name of the directory. On completion, the directory is removed. - - - - - 2 changed files: - src/code/extensions.lisp - src/code/unix.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -22,7 +22,8 @@ read-char-no-edit listen-skip-whitespace concat-pnames iterate once-only collect do-anonymous undefined-value required-argument define-hash-cache defun-cached - cache-hash-eq do-hash)) + cache-hash-eq do-hash + with-temporary-file)) (import 'lisp::whitespace-char-p) @@ -622,7 +623,7 @@ decoding-error encoding-error) &parse-body (forms decls)) - "A temporary file is opened using the Open-args and bound to the + _N"A temporary file is opened using the Open-args and bound to the variable Var. The name of the temporary file uses Template-prefix for the name. If the temporary file cannot be opened, the forms are not evaluated. The Forms are executed, and when they terminate, @@ -639,19 +640,19 @@ (template (gensym "TEMPLATE-"))) `(let* ((,template (concatenate 'string - ,template-prefix - "XXXXXX")) - (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) - :auto-close t - :file ,template - :output t - :input t - :element-type ',element-type - :external-format ,external-format - :decoding-error ,decoding-error - :encoding-error ,encoding-error - :buffering ,buffering)) - (,abortp t)) + ,template-prefix + "XXXXXX")) + (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) + :auto-close t + :file ,template + :output t + :input t + :element-type ',element-type + :external-format ,external-format + :decoding-error ,decoding-error + :encoding-error ,encoding-error + :buffering ,buffering)) + (,abortp t)) ,@decls (unwind-protect (multiple-value-prog1 @@ -659,3 +660,21 @@ (setq ,abortp nil)) (when ,var (close ,var :abort ,abortp)))))) + +;; WITH-TEMPORARY-DIRECTORY -- Public +(defmacro with-temporary-directory ((var template-prefix) + &parse-body (forms decls)) + _N"Create a temporary directory using Template-prefix as the name of the directory." + (let ((template (gensym "TEMPLATE-"))) + `(let ((,template (concatenate 'string ,template-prefix + "XXXXXX"))) + ,@decls + (let ((,var (unix::unix-mkdtemp ,template))) + (unless ,var + (error "Could not create temporary directory using template ~A" + ,template)) + (unwind-protect + (multiple-value-prog1 + (progn ,@forms))) + ;; Remove the directory + (unix:unix-rmdir ,var))))) ===================================== src/code/unix.lisp ===================================== @@ -2909,3 +2909,33 @@ (syscall ("mkstemp" c-call:c-string) result (copy-seq template))) + +(defun unix-mkdtemp (template) + _N"Generate a uniquely named temporary directory from Template, + which must have \"XXXXXX\" as the last six characters. The + directory is created with permissions 0700. The name of the + directory is returned." + (let* ((new-template (copy-seq template)) + (result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + c-call:c-string)) + new-template))) + (if (zerop (deref result 0)) + (values nil (unix-errno)) + (cast result c-call:c-string)))) + +(defun unix-mkdtemp (template) + _N"Generate a uniquely named temporary directory from Template, + which must have \"XXXXXX\" as the last six characters. The + directory is created with permissions 0700. The name of the + directory is returned." + (let* ((new-template (copy-seq template)) + (result (alien-funcall + (extern-alien "mkdtemp" + (function (* char) + c-call:c-string)) + new-template))) + (if (zerop (sap-int (alien-sap result))) + (values nil (unix-errno)) + (cast result c-string)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/146b616fc2a125d60205534… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/146b616fc2a125d60205534… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-364-add-mkstemp-mkdtemp] Clean up interface and implementation of with-temporary-file
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed to branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl Commits: 0f8de51f by Raymond Toy at 2025-01-01T10:37:58-08:00 Clean up interface and implementation of with-temporary-file Explicitly define the allowed keyword args. Update docstring accordingly. - - - - - 1 changed file: - src/code/extensions.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -614,20 +614,43 @@ `(lisp::pointer-hash ,x)) ;;; WITH-TEMPORARY-FILE -- Public -(defmacro with-temporary-file ((var template-prefix &rest open-args) &parse-body (forms decls)) +(defmacro with-temporary-file ((var template-prefix + &key + (element-type 'base-char) + (external-format :default) + (buffering :full) + decoding-error + encoding-error) + &parse-body (forms decls)) "A temporary file is opened using the Open-args and bound to the variable Var. The name of the temporary file uses Template-prefix for the name. If the temporary file cannot be opened, the forms are not evaluated. The Forms are executed, and when they terminate, - normally or otherwise, the file is closed and deleted." + normally or otherwise, the file is closed. + + Defined keywords: + :element-type - Type of object to read or write. Default BASE-CHAR + :external-format - An external format name + :buffering - Buffering to use for the file. Must be one of + :NONE, :LINE, :FULL + :decoding-error - How to handle decoding errors. See OPEN + :encoding-error - How to handle encoding errors. See OPEN" (let ((abortp (gensym)) (template (gensym "TEMPLATE-"))) + `(let* ((,template (concatenate 'string ,template-prefix "XXXXXX")) (,var (lisp::make-fd-stream (unix::unix-mkstemp ,template) + :auto-close t :file ,template - ,@open-args)) + :output t + :input t + :element-type ',element-type + :external-format ,external-format + :decoding-error ,decoding-error + :encoding-error ,encoding-error + :buffering ,buffering)) (,abortp t)) ,@decls (unwind-protect View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0f8de51f7cb454d13a87218… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0f8de51f7cb454d13a87218… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-364-add-mkstemp-mkdtemp
by Raymond Toy (＠rtoy) 01 Jan '25

01 Jan '25

Raymond Toy pushed new branch issue-364-add-mkstemp-mkdtemp at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-364-add-mkstemp-mkd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #135: (unix-namestring ".") should be "./"
by Raymond Toy (＠rtoy) 31 Dec '24

31 Dec '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0a51daf2 by Raymond Toy at 2025-01-01T04:58:21+00:00 Fix #135: (unix-namestring ".") should be "./" - - - - - fbe6f2d6 by Raymond Toy at 2025-01-01T04:58:21+00:00 Merge branch 'issue-135-unix-namestring-dot' into 'master' Fix #135: (unix-namestring ".") should be "./" Closes #135 See merge request cmucl/cmucl!94 - - - - - 2 changed files: - src/code/filesys.lisp - tests/issues.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -721,7 +721,7 @@ verify-existence follow-links nil function)) (:relative - (%enumerate-directories "" (cdr directory) pathname + (%enumerate-directories "./" (cdr directory) pathname verify-existence follow-links nil function))) (%enumerate-files "" pathname verify-existence function)))) @@ -1110,11 +1110,6 @@ optionally keeping some of the most recent old versions." :pathname file :format-control (intl:gettext "~S doesn't exist.") :format-arguments (list file))) - ;; unix-namestring converts "." to "". Convert it back to - ;; "." so we can stat the current directory. (Perhaps - ;; that's a bug in unix-namestring?) - (when (zerop (length name)) - (setf name ".")) (let (author) (unwind-protect (progn ===================================== tests/issues.lisp ===================================== @@ -707,6 +707,33 @@ ".txt") *test-path*)))) +(define-test issue.135 + (:tag :issues) + (assert-equalp "./" (ext:unix-namestring ".")) + (unwind-protect + (progn + ;; Create a test file in the current directory. + ;; unix-namestring requires files to exist to be able to + ;; return the namestring. + (with-open-file (f1 "foo.txt" + :direction :output + :if-exists :supersede) + (print "foo" f1)) + ;; Check unix-namestring and verify that converting the + ;; namestring to a pathname results in the same pathname + ;; object as expected. + (let ((foo (ext:unix-namestring "foo.txt"))) + (assert-equalp "foo.txt" foo) + (assert-equalp (make-pathname :name "foo" :type "txt") + (pathname foo))) + (let ((bar (ext:unix-namestring "src/code/filesys.lisp"))) + (assert-equalp "./src/code/filesys.lisp" bar) + (assert-equalp (make-pathname :directory '(:relative "src" "code") + :name "filesys" + :type "lisp") + (pathname bar)))) + (assert-true (delete-file "foo.txt")))) + (define-test issue.139-default-external-format (:tag :issues) (assert-eq :utf-8 stream:*default-external-format*) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5d83f1356e1072ab08e642… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5d83f1356e1072ab08e642… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs January 2025