From 6cc44d023887e0bf0ffa0d225e7879fe403d9061 Mon Sep 17 00:00:00 2001 From: Gary Palter Date: Thu, 15 Oct 2020 20:17:34 -0400 Subject: [PATCH] Fix bug which causes compilation to leave empty temporary files on Genera Genera uses versioned pathnames. TMPIZE-PATHNAME creates a temporary file to ensure a unique name. If we leave that file, Genera will create a new version (i.e., version 2) when its caller opens the file for output. After that file is renamed, the original temporary file remains. Since Genera runs on a single core processor, the possibility of a name collision is minimal if not nil. So, don't keep the temporary file. --- uiop/stream.lisp | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 6e007b80..10b47434 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -681,8 +681,8 @@ Upon success, the KEEP form is evaluated and the file is is deleted unless it ev ,@(when element-type `(:element-type ,element-type)) ,@(when external-format `(:external-format ,external-format)))))) - (defun get-temporary-file (&key directory prefix suffix type) - (with-temporary-file (:pathname pn :keep t + (defun get-temporary-file (&key directory prefix suffix type (keep t)) + (with-temporary-file (:pathname pn :keep keep :directory directory :prefix prefix :suffix suffix :type type) pn)) @@ -700,7 +700,14 @@ clash with any concurrent process attempting the same thing." (let* ((px (ensure-pathname x :ensure-physical t)) (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) (directory (pathname-directory-pathname px))) - (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) + ;; Genera uses versioned pathnames -- If we leave the empty file in place, + ;; the system will create a new version of the file when the caller opens + ;; it for output. That empty file will remain after the operation is completed. + ;; As Genera is a single core processor, the possibility of a name conflict is + ;; minimal if not nil. (And, in the event of a collision, the two processes + ;; would be writing to different versions of the file.) + (get-temporary-file :directory directory :prefix prefix :type (pathname-type px) + #+genera :keep #+genera nil))) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically -- GitLab