Changeset 9870


Ignore:
Timestamp:
Jul 1, 2008, 9:27:31 PM (11 years ago)
Author:
gz
Message:

Propagate r8699 here from trunk

File:
1 edited

Legend:

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

    r9805 r9870  
    622622           (filename (stream-filename s))
    623623           (actual-filename (stream-actual-filename s)))
    624       (when actual-filename
     624      (when actual-filename ; t => created when opened
    625625        (if abort
    626626          (progn
    627627            (setf (ioblock-dirty ioblock) nil)
    628628            (fd-stream-close s ioblock)
    629             (unix-rename (namestring actual-filename) (probe-file-x filename)))
    630           (delete-file actual-filename)))
     629            (if (eq actual-filename t)
     630              (delete-file filename)
     631              (unix-rename (namestring actual-filename) (probe-file-x filename))))
     632          (unless (eq actual-filename t)
     633            (delete-file actual-filename))))
    631634      (remove-open-file-stream s))))
    632635
     
    721724                         basic)
    722725  (let* ((temp-name nil)
     726         (created nil)
    723727         (dir (pathname-directory filename))
    724728         (filename (if (eq (car dir) :relative)
     
    753757                (cond
    754758                  ((not native-truename)
    755                    (setq native-truename (%create-file filename)))
     759                   (setq native-truename (%create-file filename)
     760                         created t))
    756761                  ((memq direction '(:output :io))
    757762                   (when (eq if-exists :supersede)
     
    762767              (return-from open nil)))
    763768          (if (setq filename (if-does-not-exist if-does-not-exist filename))
    764             (unless (setq native-truename (%create-file filename :if-exists if-exists ))
    765               (return-from open nil))
     769            (progn
     770              (unless (setq native-truename (%create-file filename :if-exists if-exists))
     771                (return-from open nil))
     772              (setq created t))
    766773            (return-from open nil)))
    767774        (let* ((fd (fd-open native-truename (case direction
     
    820827                       (ioblock (stream-ioblock fstream t)))
    821828                  (setf (stream-filename fstream) (namestring pathname)
    822                         (stream-actual-filename fstream) temp-name)
     829                        (stream-actual-filename fstream) (or temp-name created))
    823830                  (setf (file-ioblock-fileeof ioblock)
    824831                        (ioblock-octets-to-elements ioblock (fd-size fd)))
Note: See TracChangeset for help on using the changeset viewer.