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

filesystem-change-evt: fix use of failure thunk

Browse Source 
Also, allow the failure thunk to be #f to get the default behavior.
This commit is contained in:
Matthew Flatt 2019-06-21 07:19:49 -06:00
parent d6ffc5b820
commit a2a67a9660
5 changed files with 42 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pkgs/racket-doc/scribblings/reference/filesystem.scrbl
View File

@ -598,11 +598,9 @@ Returns @racket[#t] if @racket[v] is a @tech{filesystem change
event}, @racket[#f] otherwise.}
@defproc*[([(filesystem-change-evt [path path-string?])
filesystem-change-evt?]
[(filesystem-change-evt [path path-string?]
[failure-thunk (-> any)])
any])]{
@defproc[(filesystem-change-evt [path path-string?]
[failure-thunk (or/c (-> any) #f) #f])
(or/c filesystem-change-evt? any)]{
Creates a @deftech{filesystem change event}, which is a
@tech{synchronizable event} that becomes @tech{ready for
@ -635,22 +633,25 @@ event's @tech{synchronization result} is the event itself.
If the current platform does not support filesystem-change
notifications, then the @exnraise[exn:fail:unsupported] if
@racket[failure-thunk] is not provided, or @racket[failure-thunk] is
@racket[failure-thunk] is not provided as a procedure, or @racket[failure-thunk] is
called in tail position if provided. Similarly, if there is any
operating-system error when creating the event (such as a non-existent
file), then the @exnraise[exn:fail:filesystem] or @racket[failure-thunk]
is called.
Creation of a @tech{filesystem change event} allocates resources at the
Creation of a filesystem change event allocates resources at the
operating-system level. The resources are released at latest when the
event is sychronized and @tech{ready for synchronization} or when the
event is canceled with @racket[filesystem-change-evt-cancel].
See also @racket[system-type] in @racket['fs-change] mode.
event is sychronized and @tech{ready for synchronization}, when the
event is canceled with @racket[filesystem-change-evt-cancel], or when
the garbage collector determine that the filesystem change event is
unreachable. See also @racket[system-type] in @racket['fs-change] mode.
A @tech{filesystem change event} is placed under the management of the
A filesystem change event is placed under the management of the
@tech{current custodian} when it is created. If the @tech{custodian}
is shut down, @racket[filesystem-change-evt-cancel] is applied to the
event.}
event.
@history[#:changed "7.3.0.8" @elem{Allow @racket[#f] for @racket[failure-thunk].}]}
@defproc[(filesystem-change-evt-cancel [evt filesystem-change-evt?])

6
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -1556,6 +1556,12 @@
(check "f1" "f2" #t known-file-supported?)
(check "f1d" "f2d" #f known-supported?)
(let ([no-file (build-path dir "no-such-file-here")])
(test 'no filesystem-change-evt no-file (lambda () 'no))
(err/rt-test (filesystem-change-evt no-file) (lambda (x)
(or (exn:fail:filesystem? x)
(exn:fail:unsupported? x)))))
(delete-directory/files dir))
;;----------------------------------------------------------------------

10
racket/src/io/filesystem-change-evt/main.rkt
View File

@ -37,10 +37,7 @@
(define (filesystem-change-evt? v)
(fs-change-evt? v))
(define/who (filesystem-change-evt p [fail (lambda ()
(raise (exn:fail:unsupported
"filesystem-change-evt: unsupported"
(current-continuation-marks))))])
(define/who (filesystem-change-evt p [fail #f])
(check who path-string? p)
(check who (procedure-arity-includes/c 0) fail)
(define fn (->host p who '(exists)))
@ -66,8 +63,11 @@
[(rktio-error? rfc)
(end-atomic)
(cond
[fail (fail)]
[(racket-error? rfc RKTIO_ERROR_UNSUPPORTED)
(fail)]
(raise (exn:fail:unsupported
"filesystem-change-evt: unsupported"
(current-continuation-marks)))]
[else
(raise-filesystem-error who rfc (format "error generating event\n path: ~a"
(host-> fn)))])]

21
racket/src/racket/src/port.c
View File

@ -4498,17 +4498,16 @@ Scheme_Object *scheme_filesystem_change_evt(Scheme_Object *path, int flags, int
}
if (!rfc) {
if (scheme_last_error_is_racket(RKTIO_ERROR_UNSUPPORTED)) {
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"filesystem-change-evt: " NOT_SUPPORTED_STR "\n"
" path: %q\n",
filename);
} else {
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"filesystem-change-evt: error generating event\n"
" path: %q\n"
" system error: %R",
filename);
if (signal_errs) {
if (scheme_last_error_is_racket(RKTIO_ERROR_UNSUPPORTED)) {
if (signal_errs)
scheme_raise_exn(MZEXN_FAIL_UNSUPPORTED,
"filesystem-change-evt: " NOT_SUPPORTED_STR "\n"
" path: %q\n",
filename);
} else {
filename_exn("filesystem-change-evt", "error generating event", filename, 0);
}
}
return NULL;

11
racket/src/racket/src/portfun.c
View File

@ -4350,13 +4350,18 @@ static Scheme_Object *set_port_next_location(int argc, Scheme_Object *argv[])
static Scheme_Object *filesystem_change_evt(int argc, Scheme_Object *argv[])
{
Scheme_Object *e;
int raise_errs = 1;
if (!SCHEME_PATH_STRINGP(argv[0]))
scheme_wrong_contract("filesystem-change-evt", "path-string?", 0, argc, argv);
if (argc > 1)
scheme_check_proc_arity("filesystem-change-evt", 0, 1, argc, argv);
if (argc > 1) {
if (!SCHEME_FALSEP(argv[1])) {
scheme_check_proc_arity2("filesystem-change-evt", 0, 1, argc, argv, 1);
raise_errs = 0;
}
}
e = scheme_filesystem_change_evt(argv[0], 0, (argc < 2));
e = scheme_filesystem_change_evt(argv[0], 0, raise_errs);
if (!e)
return _scheme_tail_apply(argv[1], 0, NULL);