[Openmcl-devel] close on abort

bryan o'connor bryan-lisp at lunch.org
Mon Sep 5 03:16:22 PDT 2005

it's obviously too late for me since i'm correcting myself
once again.

cl:rename-file calls truename (for symlink resolution) which
ends up dropping the :unspecific type.

i attached the current state of my patch below.  i'll be
fully testing it tomorrow.  it should do the right thing
with your original example (even if symlinks).


-------------- next part --------------
Index: level-1/l1-sysio.lisp
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/level-1/l1-sysio.lisp,v
retrieving revision 1.9
diff -u -u -r1.9 l1-sysio.lisp
--- level-1/l1-sysio.lisp	30 Aug 2005 07:26:33 -0000	1.9
+++ level-1/l1-sysio.lisp	5 Sep 2005 10:10:13 -0000
@@ -477,7 +477,7 @@
 	    (setf (ioblock-dirty ioblock) nil)
 	    (fd-stream-close s ioblock)
-	    (rename-file original-name filename :if-exists :overwrite))
+	    (unix-rename (namestring original-name) (probe-file-x filename)))
 	  (delete-file original-name)))
       (setq *open-file-streams* (nremove s *open-file-streams*))
@@ -509,7 +509,8 @@
   (let* ((temp-name nil)
-	 (pathname (pathname filename)))
+         (filename (full-pathname filename))
+         (pathname (pathname filename)))
     (block open
       (if (or (memq element-type '(:default character base-char))
 	      (subtypep element-type 'character))
@@ -547,7 +548,7 @@
 		   (when (eq if-exists :supersede)
 		     (let ((truename (native-to-pathname native-truename)))
 		       (setq temp-name (gen-file-name truename))
-		       (rename-file truename temp-name :if-exists :overwrite)
+		       (unix-rename native-truename (namestring temp-name))
 		       (%create-file native-truename))))))
 	      (return-from open nil)))
 	  (if (setq filename (if-does-not-exist if-does-not-exist filename))
-------------- next part --------------

More information about the Openmcl-devel mailing list