[Openmcl-cvs-notifications] r14712 - in /release/1.6/source: ./ level-0/l0-misc.lisp level-1/l1-files.lisp level-1/l1-sysio.lisp
rme at clozure.com
rme at clozure.com
Thu Apr 14 10:53:47 CDT 2011
Author: rme
Date: Thu Apr 14 10:53:47 2011
New Revision: 14712
Log:
Merge r14662 from trunk.
Closes ticket:843.
Modified:
release/1.6/source/ (props changed)
release/1.6/source/level-0/l0-misc.lisp (props changed)
release/1.6/source/level-1/l1-files.lisp
release/1.6/source/level-1/l1-sysio.lisp
Propchange: release/1.6/source/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Thu Apr 14 10:53:47 2011
@@ -4,4 +4,4 @@
/branches/rme-logops:13875-13886
/branches/working-0711/ccl:7970-13192,13197-13198,13202,13208,13214,13235-=
13236,13239,13263,13277-13278,13290,13293-13294,13302-13306,13331-13332,133=
39,13361-13364,13379,13383,13386,13388,13409,13435-13436,13438,13440-13442,=
13460-13461,13465,13467,13476,13487,13490,13492-13493,13502-13528,13545-135=
47,13549,13557-13558
/release/1.5/source:13667
-/trunk/source:14361-14404,14422-14423,14425-14432,14435,14437-14438,14440-=
14441,14444-14445,14451,14457,14460-14464,14472,14476-14479,14482-14484,144=
94-14495,14519,14550,14559,14690,14692
+/trunk/source:14361-14404,14422-14423,14425-14432,14435,14437-14438,14440-=
14441,14444-14445,14451,14457,14460-14464,14472,14476-14479,14482-14484,144=
94-14495,14519,14550,14559,14662,14690,14692
Propchange: release/1.6/source/level-0/l0-misc.lisp
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Thu Apr 14 10:53:47 2011
@@ -4,4 +4,4 @@
/branches/rme-logops/level-0/l0-misc.lisp:13875-13886
/branches/working-0711/ccl/level-0/l0-misc.lisp:7970-13192,13197-13198,132=
02,13208,13214,13235-13236,13239,13263,13277-13278,13290,13293-13294,13302-=
13306,13331-13332,13339,13361-13364,13379,13383,13386,13388,13409,13435-134=
36,13438,13440-13442,13460-13461,13465,13467,13476,13487,13490,13492-13493,=
13502-13528,13545-13547,13549,13557-13558
/release/1.5/source/level-0/l0-misc.lisp:13667
-/trunk/source/level-0/l0-misc.lisp:14361-14404,14422-14423,14425-14432,144=
35,14437-14438,14440-14441,14444-14445,14451,14457,14460-14464,14472,14476-=
14479,14482-14484,14494-14495,14541,14550,14559,14692
+/trunk/source/level-0/l0-misc.lisp:14361-14404,14422-14423,14425-14432,144=
35,14437-14438,14440-14441,14444-14445,14451,14457,14460-14464,14472,14476-=
14479,14482-14484,14494-14495,14541,14550,14559,14662,14692
Modified: release/1.6/source/level-1/l1-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.6/source/level-1/l1-files.lisp (original)
+++ release/1.6/source/level-1/l1-files.lisp Thu Apr 14 10:53:47 2011
@@ -212,25 +212,22 @@
(create-directory path))
(when (directory-pathname-p path)
(return-from %create-file (probe-file-x path)))
- (assert (or (eql if-exists :overwrite)
- (null if-exists)
- (eq if-exists :error)
- (not (probe-file path))) ()
- "~s ~s not implemented yet" :if-exists if-exists)
(let* ((unix-name (native-translated-namestring path))
- (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT #$O_TRUNC
- (if (or (null if-exists)
- (eq if-exists :error))
- #$O_EXCL
- 0)))))
- (if (< fd 0)
- (if (and (null if-exists)
+ (fd (fd-open unix-name (logior #$O_WRONLY #$O_CREAT
+ (if (eq if-exists :overwrite)
+ #$O_TRUNC
+ #$O_EXCL)))))
+ (when (and (neq if-exists :error)
(or (eql fd (- #$EEXIST))
#+windows-target
(and (eql fd (- #$EPERM))
(probe-file path))))
- (return-from %create-file nil)
- (signal-file-error fd path))
+ (when (null if-exists)
+ (return-from %create-file nil))
+ (error "~s ~s not implemented yet" :if-exists if-exists))
+
+ (if (< fd 0)
+ (signal-file-error fd path)
(fd-close fd))
(%realpath unix-name)))
=
Modified: release/1.6/source/level-1/l1-sysio.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- release/1.6/source/level-1/l1-sysio.lisp (original)
+++ release/1.6/source/level-1/l1-sysio.lisp Thu Apr 14 10:53:47 2011
@@ -774,7 +774,8 @@
(t (report-bad-arg direction '(member :input :output :io :probe))))
(check-pathname-not-wild filename) ;; probe-file-x misses wild versi=
ons....
(multiple-value-bind (native-truename kind)(probe-file-x filename)
- (if native-truename
+ (tagbody retry
+ (if native-truename
(if (eq kind :directory)
(if (eq direction :probe)
(return-from open nil)
@@ -795,10 +796,18 @@
(return-from open nil)))
(if (setq filename (if-does-not-exist if-does-not-exist filename))
(progn
- (unless (setq native-truename (%create-file filename :if-exi=
sts if-exists))
- (return-from open nil))
+ (unless (setq native-truename (%create-file filename :if-exi=
sts (case if-exists
+ =
;; Let %create file handle these cases
+ =
((:error :overwrite) if-exists)
+ =
(t nil))))
+ ;; Somebody else created the file while we're trying to cr=
eate it.
+ (when (null if-exists) (return-from open nil))
+ (multiple-value-setq (native-truename kind) (probe-file-x =
filename))
+ (unless native-truename ;; huh? Perhaps it disappeared ag=
ain?
+ (error "Attempt to create ~s failed unexpectedly" filena=
me))
+ (go retry))
(setq created t))
- (return-from open nil)))
+ (return-from open nil))))
(let* ((fd (fd-open native-truename (case direction
((:probe :input) #$O_RDONLY)
(:output #$O_WRONLY)
More information about the Openmcl-cvs-notifications
mailing list