parent
724dc2fdbf
commit
fef695f066
|
@ -296,7 +296,7 @@ exists---to the path @racket[new]. If the file or directory is not
|
||||||
renamed successfully, the @exnraise[exn:fail:filesystem].
|
renamed successfully, the @exnraise[exn:fail:filesystem].
|
||||||
|
|
||||||
This procedure can be used to move a file/directory to a different
|
This procedure can be used to move a file/directory to a different
|
||||||
directory (on the same disk) as well as rename a file/directory within
|
directory (on the same filesystem) as well as rename a file/directory within
|
||||||
a directory. Unless @racket[exists-ok?] is provided as a true value,
|
a directory. Unless @racket[exists-ok?] is provided as a true value,
|
||||||
@racket[new] cannot refer to an existing file or directory. Even if
|
@racket[new] cannot refer to an existing file or directory. Even if
|
||||||
@racket[exists-ok?] is true, @racket[new] cannot refer to an existing
|
@racket[exists-ok?] is true, @racket[new] cannot refer to an existing
|
||||||
|
|
|
@ -181,6 +181,44 @@
|
||||||
(delete-file tempfile)
|
(delete-file tempfile)
|
||||||
(delete-file (make-lock-file-name tempfile))
|
(delete-file (make-lock-file-name tempfile))
|
||||||
|
|
||||||
|
;;----------------------------------------------------------------------
|
||||||
|
;; Atomic output
|
||||||
|
|
||||||
|
(define (try-atomic-output fn)
|
||||||
|
(call-with-output-file*
|
||||||
|
fn
|
||||||
|
#:exists 'truncate
|
||||||
|
(lambda (o) (display "()" o)))
|
||||||
|
(define ts
|
||||||
|
(append
|
||||||
|
;; Writers
|
||||||
|
(for/list ([i 10])
|
||||||
|
(thread (lambda ()
|
||||||
|
(for ([j 100])
|
||||||
|
(call-with-atomic-output-file
|
||||||
|
fn
|
||||||
|
(lambda (o tmp-path)
|
||||||
|
(test (or (path-only fn) (current-directory))
|
||||||
|
path-only tmp-path)
|
||||||
|
(display "(" o)
|
||||||
|
(flush-output o)
|
||||||
|
(sync (system-idle-evt))
|
||||||
|
(display ")" o)))))))
|
||||||
|
;; Readers
|
||||||
|
(for/list ([i 10])
|
||||||
|
(thread (lambda ()
|
||||||
|
(for ([j 100])
|
||||||
|
(sync (system-idle-evt))
|
||||||
|
(test '() call-with-input-file fn read)))))))
|
||||||
|
(for-each sync ts)
|
||||||
|
(delete-file fn))
|
||||||
|
|
||||||
|
(try-atomic-output (make-temporary-file))
|
||||||
|
;; The user's add-on directory should be writable and might be a
|
||||||
|
;; different filesystem, so try that:
|
||||||
|
(parameterize ([current-directory (find-system-path 'addon-dir)])
|
||||||
|
(try-atomic-output (format "atomic-output-~a" (current-inexact-milliseconds))))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -213,7 +213,7 @@
|
||||||
(delete-file path)))
|
(delete-file path)))
|
||||||
(let ([bp (current-break-parameterization)]
|
(let ([bp (current-break-parameterization)]
|
||||||
[tmp-path (parameterize ([current-security-guard (or guard (current-security-guard))])
|
[tmp-path (parameterize ([current-security-guard (or guard (current-security-guard))])
|
||||||
(make-temporary-file "tmp~a" #f (path-only path)))]
|
(make-temporary-file "tmp~a" #f (or (path-only path) (current-directory))))]
|
||||||
[ok? #f])
|
[ok? #f])
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
void
|
void
|
||||||
|
|
Loading…
Reference in New Issue
Block a user