Changeset 8622


Ignore:
Timestamp:
Feb 29, 2008, 4:10:39 AM (12 years ago)
Author:
gb
Message:

Try to support deletion of created files in (CLOSE ... :ABORT T).
Better support for :IF-EXISTS NIL in MAKE-FILE-STREAM.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.1/ccl/level-1/l1-sysio.lisp

    r7805 r8622  
    632632           (filename (stream-filename s))
    633633           (actual-filename (stream-actual-filename s)))
    634       (when actual-filename
     634      (when actual-filename ; t => created when opened
    635635        (if abort
    636636          (progn
    637637            (setf (ioblock-dirty ioblock) nil)
    638638            (fd-stream-close s ioblock)
    639             (unix-rename (namestring actual-filename) (probe-file-x filename)))
    640           (delete-file actual-filename)))
     639            (if (eq actual-filename t)
     640              (delete-file filename)
     641              (unix-rename (namestring actual-filename) (probe-file-x filename))))
     642          (unless (eq actual-filename t)
     643            (delete-file actual-filename))))
    641644      (remove-open-file-stream s))))
    642645
     
    733736
    734737  (let* ((temp-name nil)
     738         (created nil)
    735739         (dir (pathname-directory filename))
    736740         (filename (if (eq (car dir) :relative)
     
    764768                (cond
    765769                  ((not native-truename)
    766                    (setq native-truename (%create-file filename)))
     770                   (setq native-truename (%create-file filename)
     771                         created t))
    767772                  ((memq direction '(:output :io))
    768773                   (when (eq if-exists :supersede)
     
    773778              (return-from open nil)))
    774779          (if (setq filename (if-does-not-exist if-does-not-exist filename))
    775             (setq native-truename (%create-file filename))
     780            (progn
     781              (unless (setq native-truename (%create-file filename :if-exists if-exists))
     782                (return-from open nil))
     783              (setq created t))
    776784            (return-from open nil)))
    777785        (let* ((fd (fd-open native-truename (case direction
     
    830838                       (ioblock (stream-ioblock fstream t)))
    831839                  (setf (stream-filename fstream) (namestring pathname)
    832                         (stream-actual-filename fstream) temp-name)
     840                        (stream-actual-filename fstream) (or temp-name created))
    833841                  (setf (file-ioblock-fileeof ioblock)
    834842                        (ioblock-octets-to-elements ioblock (fd-size fd)))
Note: See TracChangeset for help on using the changeset viewer.