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/9da10f582cd173e1569f3e8... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9da10f582cd173e1569f3e8... You're receiving this email because of your account on gitlab.common-lisp.net.