Changeset 14712


Ignore:
Timestamp:
Apr 14, 2011, 3:53:47 PM (8 years ago)
Author:
rme
Message:

Merge r14662 from trunk.

Closes ticket:843.

Location:
release/1.6/source
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/1.6/source

  • release/1.6/source/level-0/l0-misc.lisp

    • Property svn:mergeinfo changed (with no actual effect on merging)
  • release/1.6/source/level-1/l1-files.lisp

    r14453 r14712  
    213213  (when (directory-pathname-p path)
    214214    (return-from %create-file (probe-file-x path)))
    215   (assert (or (eql if-exists :overwrite)
    216               (null if-exists)
    217               (eq if-exists :error)
    218               (not (probe-file path))) ()
    219           "~s ~s not implemented yet" :if-exists if-exists)
    220215  (let* ((unix-name (native-translated-namestring path))
    221          (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT #$O_TRUNC
    222                                         (if (or (null if-exists)
    223                                                 (eq if-exists :error))
    224                                           #$O_EXCL
    225                                           0)))))
    226     (if (< fd 0)
    227       (if (and (null if-exists)
     216         (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT
     217                                        (if (eq if-exists :overwrite)
     218                                          #$O_TRUNC
     219                                          #$O_EXCL)))))
     220    (when (and (neq if-exists :error)
    228221               (or (eql fd (- #$EEXIST))
    229222                   #+windows-target
    230223                   (and (eql fd (- #$EPERM))
    231224                        (probe-file path))))
    232         (return-from %create-file nil)
    233         (signal-file-error fd path))
     225      (when (null if-exists)
     226        (return-from %create-file nil))
     227      (error "~s ~s not implemented yet" :if-exists if-exists))
     228
     229    (if (< fd 0)
     230      (signal-file-error fd path)
    234231      (fd-close fd))
    235232    (%realpath unix-name)))
  • release/1.6/source/level-1/l1-sysio.lisp

    r13426 r14712  
    776776      (check-pathname-not-wild filename) ;; probe-file-x misses wild versions....
    777777      (multiple-value-bind (native-truename kind)(probe-file-x filename)
    778         (if native-truename
     778       (tagbody retry
     779        (if native-truename
    779780          (if (eq kind :directory)
    780781            (if (eq direction :probe)
     
    797798          (if (setq filename (if-does-not-exist if-does-not-exist filename))
    798799            (progn
    799               (unless (setq native-truename (%create-file filename :if-exists if-exists))
    800                 (return-from open nil))
     800              (unless (setq native-truename (%create-file filename :if-exists (case if-exists
     801                                                                                ;; Let %create file handle these cases
     802                                                                                ((:error :overwrite) if-exists)
     803                                                                                (t nil))))
     804                ;; Somebody else created the file while we're trying to create it.
     805                (when (null if-exists) (return-from open nil))
     806                (multiple-value-setq (native-truename kind) (probe-file-x filename))
     807                (unless native-truename ;; huh?  Perhaps it disappeared again?
     808                  (error "Attempt to create ~s failed unexpectedly" filename))
     809                (go retry))
    801810              (setq created t))
    802             (return-from open nil)))
     811            (return-from open nil))))
    803812        (let* ((fd (fd-open native-truename (case direction
    804813                                              ((:probe :input) #$O_RDONLY)
Note: See TracChangeset for help on using the changeset viewer.