Changeset 8237


Ignore:
Timestamp:
Jan 23, 2008, 5:50:07 AM (12 years ago)
Author:
gb
Message:

Handle and use (%CREATE-FILE ... :IF-EXISTS NIL).

Location:
trunk/source/level-1
Files:
3 edited

Legend:

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

    r7796 r8237  
    193193  (when (directory-pathname-p path)
    194194    (return-from %create-file (probe-file-x path)))
    195   (assert (or (eql if-exists :overwrite) (not (probe-file path))) ()
     195  (assert (or (eql if-exists :overwrite)
     196              (null if-exists)
     197              (not (probe-file path))) ()
    196198          "~s ~s not implemented yet" :if-exists if-exists)
    197199  (let* ((unix-name (native-translated-namestring path))
    198          (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT #$O_TRUNC))))
     200         (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT #$O_TRUNC
     201                                        (if (null if-exists)
     202                                          #$O_EXCL
     203                                          0)))))
    199204    (if (< fd 0)
    200       (signal-file-error fd path)
     205      (if (eql fd (- #$EEXIST))         ; #$O_EXCL was set and file exists
     206        (return-from %create-file nil)
     207        (signal-file-error fd path))
    201208      (fd-close fd))
    202209    (%realpath unix-name)))
  • trunk/source/level-1/l1-streams.lisp

    r7971 r8237  
    55775577         (tem-path (merge-pathnames (make-pathname :name (%integer-to-string date) :type "tem" :defaults nil) path)))
    55785578    (loop
    5579       (when (not (probe-file tem-path)) (return tem-path))
     5579      (when (%create-file tem-path :if-exists nil) (return tem-path))
    55805580      (setf (%pathname-name tem-path) (%integer-to-string (setq date (1+ date)))))))
    55815581
  • trunk/source/level-1/l1-sysio.lisp

    r8170 r8237  
    773773              (return-from open nil)))
    774774          (if (setq filename (if-does-not-exist if-does-not-exist filename))
    775             (setq native-truename (%create-file filename))
     775            (unless (setq native-truename (%create-file filename :if-exists if-exists))
     776              (return-from open nil))
    776777            (return-from open nil)))
    777778        (let* ((fd (fd-open native-truename (case direction
Note: See TracChangeset for help on using the changeset viewer.