Changeset 14712
- Timestamp:
- Apr 14, 2011, 3:53:47 PM (10 years ago)
- Location:
- release/1.6/source
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
release/1.6/source
- Property svn:mergeinfo changed
/trunk/source merged: 14662
- Property svn:mergeinfo changed
-
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 213 213 (when (directory-pathname-p path) 214 214 (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)220 215 (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) 228 221 (or (eql fd (- #$EEXIST)) 229 222 #+windows-target 230 223 (and (eql fd (- #$EPERM)) 231 224 (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) 234 231 (fd-close fd)) 235 232 (%realpath unix-name))) -
release/1.6/source/level-1/l1-sysio.lisp
r13426 r14712 776 776 (check-pathname-not-wild filename) ;; probe-file-x misses wild versions.... 777 777 (multiple-value-bind (native-truename kind)(probe-file-x filename) 778 (if native-truename 778 (tagbody retry 779 (if native-truename 779 780 (if (eq kind :directory) 780 781 (if (eq direction :probe) … … 797 798 (if (setq filename (if-does-not-exist if-does-not-exist filename)) 798 799 (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)) 801 810 (setq created t)) 802 (return-from open nil))) 811 (return-from open nil)))) 803 812 (let* ((fd (fd-open native-truename (case direction 804 813 ((:probe :input) #$O_RDONLY)
Note: See TracChangeset
for help on using the changeset viewer.