Ignore:
Timestamp:
Sep 5, 2005, 8:02:54 PM (14 years ago)
Author:
bryan
Message:

(defclass file-stream): rename original-name slot to actual-filename.

stream-original-name, (setf stream-original-name): renamed to
stream-actual-filename, (setf stream-actual-filename).

make-file-stream, close: use renamed functions.

make-file-stream: if filename is relative, use (full-pathname filename).
we don't call full-pathname if the filename is absolute to avoid
clobbering a logical-pathname with its non-logical counterpart.
(maybe full-pathname should do that for us?)

make-file-stream, close: use ccl::unix-rename instead of cl:rename-file
to avoid merge-pathnames issues when filename has no type.

File:
1 edited

Legend:

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

    r2444 r2500  
    279279(defclass file-stream (fd-stream)
    280280    ((filename :initform nil :initarg :filename :accessor file-stream-filename)
    281      (original-name :initform nil :initarg :original-name)
     281     (actual-filename :initform nil :initarg :actual-filename)
    282282     (external-format :initform :default :initarg :external-format
    283283                      :accessor file-stream-external-format)))
     
    287287  (file-stream-filename s))
    288288
    289 (defmethod stream-original-name ((s file-stream))
    290   (slot-value s 'original-name))
     289(defmethod stream-actual-filename ((s file-stream))
     290  (slot-value s 'actual-filename))
    291291
    292292(defmethod (setf stream-filename) (new (s file-stream))
    293293  (setf (file-stream-filename s) new))
    294294
    295 (defmethod (setf stream-original-name) (new (s file-stream))
    296   (setf (slot-value s 'original-name) new))
     295(defmethod (setf stream-actual-filename) (new (s file-stream))
     296  (setf (slot-value s 'actual-filename) new))
    297297
    298298(defmethod print-object ((s file-stream) out)
     
    473473    (let* ((ioblock (stream-ioblock s))
    474474           (filename (stream-filename s))
    475            (original-name (stream-original-name s)))
    476       (when original-name
     475           (actual-filename (stream-actual-filename s)))
     476      (when actual-filename
    477477        (if abort
    478478          (progn
    479479            (setf (ioblock-dirty ioblock) nil)
    480480            (fd-stream-close s ioblock)
    481             (rename-file original-name filename :if-exists :overwrite))
    482           (delete-file original-name)))
     481            (unix-rename (namestring actual-filename) (probe-file-x filename)))
     482          (delete-file actual-filename)))
    483483      (setq *open-file-streams* (nremove s *open-file-streams*))
    484484      (call-next-method))))
     
    511511
    512512  (let* ((temp-name nil)
    513          (pathname (pathname filename)))
     513         (dir (pathname-directory filename))
     514         (filename (if (eq (car dir) :relative)
     515                       (full-pathname filename)
     516                       filename))
     517         (pathname (pathname filename)))
    514518    (block open
    515519      (if (or (memq element-type '(:default character base-char))
     
    549553                     (let ((truename (native-to-pathname native-truename)))
    550554                       (setq temp-name (gen-file-name truename))
    551                        (rename-file truename temp-name :if-exists :overwrite)
     555                       (unix-rename native-truename (namestring temp-name))
    552556                       (%create-file native-truename))))))
    553557              (return-from open nil)))
     
    610614                     (ioblock (stream-ioblock fstream)))
    611615                (setf (stream-filename fstream) (namestring pathname)
    612                       (stream-original-name fstream) temp-name)
     616                      (stream-actual-filename fstream) temp-name)
    613617                (setf (file-ioblock-fileeof ioblock)
    614618                      (ioblock-octets-to-elements ioblock (fd-size fd)))
Note: See TracChangeset for help on using the changeset viewer.