suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix make-lock-file-name'; add path-element?'

Browse Source
This commit is contained in:
Matthew Flatt 2011-08-19 15:46:44 -06:00
parent d7a996ee0b
commit 11f5c84493
6 changed files with 89 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/racket/file.rkt
View File

@ -1,4 +1,5 @@
#lang racket/base
(require "path.rkt")
(provide delete-directory/files
copy-directory/files
@ -154,20 +155,31 @@
(unless (eq? table (weak-box-value pref-cache))
(set! pref-cache (make-weak-box table)))))
(define (make-pathless-lock-file-name name)
(bytes->path-element
(bytes-append
(if (eq? 'windows (system-type))
#"_"
#".")
#"LOCK"
(path-element->bytes name))))
(define make-lock-file-name
(case-lambda
[(path) (let-values ([(dir name dir?) (split-path path)])
(make-lock-file-name dir name))]
[(path)
(unless (path-string? path)
(raise-type-error 'make-lock-file-name "path string" path))
(let-values ([(dir name dir?) (split-path path)])
(if (eq? dir 'relative)
(make-pathless-lock-file-name name)
(make-lock-file-name dir name)))]
[(dir name)
(unless (path-string? dir)
(raise-type-error 'make-lock-file-name "path string" dir))
(unless (path-element? name)
(raise-type-error 'make-lock-file-name "path element" name))
(build-path dir
(bytes->path-element
(bytes-append
(if (eq? 'windows (system-type))
#"_"
#".")
#"LOCK"
(path-element->bytes name))))]))
(make-pathless-lock-file-name name))]))
(define (preferences-lock-file-mode)
(case (system-type)

8
collects/racket/path.rkt
View File

@ -8,7 +8,8 @@
file-name-from-path
path-only
some-system-path->string
string->some-system-path)
string->some-system-path
path-element?)
(define (simple-form-path p)
(unless (path-string? p)
@ -184,4 +185,7 @@
(raise-type-error 'string->some-system-path "'unix or 'windows" kind))
(bytes->path (string->bytes/utf-8 path) kind))
(define (path-element? path)
(and (path-for-some-system? path)
(let-values ([(base name d?) (split-path path)])
(eq? base 'relative))))

13
collects/scribblings/reference/filesystem.scrbl
View File

@ -1094,10 +1094,15 @@ in the sense of @racket[port-try-file-lock?].
(lambda () (printf "Shouldn't ger here eithere\n"))
#:get-lock-file (lambda () (make-lock-file-name filename)))]
@defproc*[([(make-lock-file-name [path path-string?]) path-string?]
[(make-lock-file-name [dir path-string?] [name path-string?]) path-string?])]{
Creates a lock filename by prepending @racket["_LOCK"] on windows or @racket[".LOCK"] on all other platforms
to the file portion of the path.
@defproc*[([(make-lock-file-name [path (or path-string? path-for-some-system?)])
path?]
[(make-lock-file-name [dir (or path-string? path-for-some-system?)]
[name path-element?])
path?])]{
Creates a lock filename by prepending @racket["_LOCK"] on Windows or
@racket[".LOCK"] on other platforms to the file portion of the path.
@examples[
#:eval file-eval

14
collects/scribblings/reference/paths.scrbl
View File

@ -152,7 +152,7 @@ other path is deconstructed with @racket[split-path] and
elements is necessary.}
@defproc[(path-element->string [path path?]) string?]{
@defproc[(path-element->string [path path-element?]) string?]{
Like @racket[path->string], except that trailing path separators are
removed (as by @racket[split-path]). On Windows, any
@ -168,7 +168,7 @@ The @racket[path-element->string] procedure is generally the best
choice for presenting a pathless file or directory name to a user.}
@defproc[(path-element->bytes [path path-string?]) bytes?]{
@defproc[(path-element->bytes [path path-element?]) bytes?]{
Like @racket[path->bytes], except that any encoding prefix is removed,
etc., as for @racket[path-element->string].
@ -563,6 +563,16 @@ An error is signaled by @racket[normalize-path] if the input
path contains an embedded path for a non-existent directory,
or if an infinite cycle of soft links is detected.}
@defproc[(path-element? [path any/c]) boolean?]{
Returns @racket[#t] if @racket[path] is a path value for some
platform (see @racket[path-for-some-system?]) such that
@racket[split-path] applied to @racket[path] would return
@racket['relative] as its first result and a path as its second
result. Otherwise, the result is @racket[#f].}
@defproc[(path-only [path (or/c path-string? path-for-some-system?)])
(or/c #f path-for-some-system?)]{

24
collects/tests/racket/file.rktl
View File

@ -1302,30 +1302,6 @@
'(close-input-port r2))))
(tcp-close l))
;;----------------------------------------------------------------------
;; File Locks
(define tempfile (make-temporary-file))
(err/rt-test (call-with-file-lock/timeout 10 'shared (lambda () #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'bogus (lambda () #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'shared (lambda (x) #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda () #t) (lambda (x) #f)))
(test #t call-with-file-lock/timeout tempfile 'shared (lambda () #t) (lambda () #f))
(test #t call-with-file-lock/timeout tempfile 'exclusive (lambda () #t) (lambda () #f))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda ()
(call-with-file-lock/timeout tempfile 'exclusive (lambda () #f) (lambda () (error))))
(lambda () 'uhoh)))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda ()
(call-with-file-lock/timeout tempfile 'shared (lambda () #f) (lambda () (error))))
(lambda () 'uhon)))
(err/rt-test (call-with-file-lock/timeout tempfile 'shared (lambda ()
(call-with-file-lock/timeout tempfile 'exclusive (lambda () #f) (lambda () (error))))
(lambda () 'uhoh)))
(test #t call-with-file-lock/timeout tempfile 'shared (lambda ()
(call-with-file-lock/timeout tempfile 'shared (lambda () #t) (lambda () #f)))
(lambda () 'uhoh))
;;----------------------------------------------------------------------
;; TCP

41
collects/tests/racket/filelib.rktl
View File

@ -132,5 +132,46 @@
(delete-file "filelib-link")
'done))))
;; ----------------------------------------
;;----------------------------------------------------------------------
;; File Locks
(define tempfile (make-temporary-file))
(err/rt-test (call-with-file-lock/timeout 10 'shared (lambda () #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'bogus (lambda () #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'shared (lambda (x) #t) (lambda () #f)))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda () #t) (lambda (x) #f)))
(test #t call-with-file-lock/timeout tempfile 'shared (lambda () #t) (lambda () #f))
(test #t call-with-file-lock/timeout tempfile 'exclusive (lambda () #t) (lambda () #f))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda ()
(call-with-file-lock/timeout tempfile 'exclusive (lambda () #f) (lambda () (error))))
(lambda () 'uhoh)))
(err/rt-test (call-with-file-lock/timeout tempfile 'exclusive (lambda ()
(call-with-file-lock/timeout tempfile 'shared (lambda () #f) (lambda () (error))))
(lambda () 'uhon)))
(err/rt-test (call-with-file-lock/timeout tempfile 'shared (lambda ()
(call-with-file-lock/timeout tempfile 'exclusive (lambda () #f) (lambda () (error))))
(lambda () 'uhoh)))
(test #t call-with-file-lock/timeout tempfile 'shared (lambda ()
(call-with-file-lock/timeout tempfile 'shared (lambda () #t) (lambda () #f)))
(lambda () 'uhoh))
(test (string->path (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name
"stuff")
(test (string->path (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name
"stuff")
(test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name
"dir/stuff")
(test (build-path "dir" (if (eq? (system-type) 'windows) "_LOCKstuff" ".LOCKstuff"))
make-lock-file-name
"dir"
(string->path "stuff"))
;; ----------------------------------------
(report-errs)