diff --git a/extra/io/monitors/monitors-tests.factor b/extra/io/monitors/monitors-tests.factor index 6407108a61..77d539259e 100644 --- a/extra/io/monitors/monitors-tests.factor +++ b/extra/io/monitors/monitors-tests.factor @@ -33,7 +33,6 @@ os { winnt linux macosx } member? [ [ ] [ "m" get dispose ] unit-test ] with-monitors - [ [ "monitor-test" temp-file delete-tree ] ignore-errors @@ -88,4 +87,7 @@ os { winnt linux macosx } member? [ [ ] [ "m" get dispose ] unit-test ] with-monitors + + ! Out-of-scope disposal should not fail + [ "" resource-path t ] with-monitors dispose ] when diff --git a/extra/io/monitors/recursive/recursive.factor b/extra/io/monitors/recursive/recursive.factor index 1b18015513..04d491edbe 100644 --- a/extra/io/monitors/recursive/recursive.factor +++ b/extra/io/monitors/recursive/recursive.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors sequences assocs arrays continuations combinators kernel -threads concurrency.messaging concurrency.mailboxes -concurrency.promises -io.files io.monitors ; +threads concurrency.messaging concurrency.mailboxes concurrency.promises +io.files io.monitors debugger ; IN: io.monitors.recursive ! Simulate recursive monitors on platforms that don't have them TUPLE: recursive-monitor < monitor children thread ready ; +: notify? ( -- ? ) monitor tget ready>> promise-fulfilled? ; + DEFER: add-child-monitor : qualify-path ( path -- path' ) @@ -17,25 +18,22 @@ DEFER: add-child-monitor : add-child-monitors ( path -- ) #! We yield since this directory scan might take a while. - [ - directory* [ first add-child-monitor yield ] each - ] curry ignore-errors ; + directory* [ first add-child-monitor ] each yield ; : add-child-monitor ( path -- ) + notify? [ dup { +add-file+ } monitor tget queue-change ] when qualify-path dup link-info type>> +directory+ eq? [ [ add-child-monitors ] [ - [ f my-mailbox (monitor) ] keep - monitor tget children>> set-at + [ + [ f my-mailbox (monitor) ] keep + monitor tget children>> set-at + ] curry ignore-errors ] bi ] [ drop ] if ; -USE: io -USE: prettyprint - : remove-child-monitor ( monitor -- ) - monitor tget children>> delete-at* - [ dispose ] [ drop ] if ; + monitor tget children>> delete-at* [ dispose ] [ drop ] if ; M: recursive-monitor dispose dup queue>> closed>> [ diff --git a/extra/io/unix/linux/monitors/monitors.factor b/extra/io/unix/linux/monitors/monitors.factor index 15b9b61e89..cd17dfbbce 100644 --- a/extra/io/unix/linux/monitors/monitors.factor +++ b/extra/io/unix/linux/monitors/monitors.factor @@ -8,16 +8,18 @@ math math.bitfields sets alien alien.strings alien.c-types vocabs.loader accessors system hashtables ; IN: io.unix.linux.monitors -TUPLE: linux-monitor < monitor wd ; - -: ( wd path mailbox -- monitor ) - linux-monitor new-monitor - swap >>wd ; - SYMBOL: watches SYMBOL: inotify +TUPLE: linux-monitor < monitor wd inotify watches ; + +: ( wd path mailbox -- monitor ) + linux-monitor new-monitor + inotify get >>inotify + watches get >>watches + swap >>wd ; + : wd>monitor ( wd -- monitor ) watches get at ; : ( -- port/f ) @@ -53,8 +55,13 @@ M: linux (monitor) ( path recursive? mailbox -- monitor ) ] if ; M: linux-monitor dispose ( monitor -- ) - [ wd>> watches get delete-at ] - [ wd>> inotify-fd swap inotify_rm_watch io-error ] bi ; + dup inotify>> closed>> [ drop ] [ + [ [ wd>> ] [ watches>> ] bi delete-at ] + [ + [ inotify>> handle>> ] [ wd>> ] bi + inotify_rm_watch io-error + ] bi + ] if ; : ignore-flags? ( mask -- ? ) {