diff --git a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl index bd6e573c4d..2c229c6515 100644 --- a/pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -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?]) diff --git a/pkgs/racket-test-core/tests/racket/file.rktl b/pkgs/racket-test-core/tests/racket/file.rktl index b3f4eea429..35a4cdb464 100644 --- a/pkgs/racket-test-core/tests/racket/file.rktl +++ b/pkgs/racket-test-core/tests/racket/file.rktl @@ -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)) ;;---------------------------------------------------------------------- diff --git a/racket/src/io/filesystem-change-evt/main.rkt b/racket/src/io/filesystem-change-evt/main.rkt index c77fae7c54..20ec18d182 100644 --- a/racket/src/io/filesystem-change-evt/main.rkt +++ b/racket/src/io/filesystem-change-evt/main.rkt @@ -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)))])] diff --git a/racket/src/racket/src/port.c b/racket/src/racket/src/port.c index 9c27b85a28..1cf1692619 100644 --- a/racket/src/racket/src/port.c +++ b/racket/src/racket/src/port.c @@ -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; diff --git a/racket/src/racket/src/portfun.c b/racket/src/racket/src/portfun.c index 3dbbab6ae9..599f9fcca5 100644 --- a/racket/src/racket/src/portfun.c +++ b/racket/src/racket/src/portfun.c @@ -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);