Changeset 8699


Ignore:
Timestamp:
Mar 10, 2008, 12:30:02 PM (11 years ago)
Author:
gb
Message:

Try to handle (CLOSE f :ABORT T) when file was created by OPEN in
trunk, too.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sysio.lisp

    r8584 r8699  
    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
     
    731734                         basic)
    732735  (let* ((temp-name nil)
     736         (created nil)
    733737         (dir (pathname-directory filename))
    734738         (filename (if (eq (car dir) :relative)
     
    762766                (cond
    763767                  ((not native-truename)
    764                    (setq native-truename (%create-file filename)))
     768                   (setq native-truename (%create-file filename)
     769                         created t))
    765770                  ((memq direction '(:output :io))
    766771                   (when (eq if-exists :supersede)
     
    771776              (return-from open nil)))
    772777          (if (setq filename (if-does-not-exist if-does-not-exist filename))
    773             (unless (setq native-truename (%create-file filename :if-exists if-exists))
    774               (return-from open nil))
     778            (progn
     779              (unless (setq native-truename (%create-file filename :if-exists if-exists))
     780                (return-from open nil))
     781              (setq created t))
    775782            (return-from open nil)))
    776783        (let* ((fd (fd-open native-truename (case direction
     
    829836                       (ioblock (stream-ioblock fstream t)))
    830837                  (setf (stream-filename fstream) (namestring pathname)
    831                         (stream-actual-filename fstream) temp-name)
     838                        (stream-actual-filename fstream) (or temp-name created))
    832839                  (setf (file-ioblock-fileeof ioblock)
    833840                        (ioblock-octets-to-elements ioblock (fd-size fd)))
Note: See TracChangeset for help on using the changeset viewer.