dispose-each

core/continuations/continuations-tests.factor

@@ -1,6 +1,6 @@
 USING: kernel math namespaces io tools.test sequences vectors
 continuations debugger parser memory arrays words
-kernel.private ;
+kernel.private accessors ;
 IN: continuations.tests
 
 : (callcc1-test)
@@ -100,3 +100,20 @@ SYMBOL: error-counter
     [ 3 ] [ always-counter get ] unit-test
     [ 1 ] [ error-counter get ] unit-test
 ] with-scope
+
+TUPLE: dispose-error ;
+
+M: dispose-error dispose 3 throw ;
+
+TUPLE: dispose-dummy disposed? ;
+
+M: dispose-dummy dispose t >>disposed? drop ;
+
+T{ dispose-error } "a" set
+T{ dispose-dummy } "b" set
+
+[ f ] [ "b" get disposed?>> ] unit-test
+
+[ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
+
+[ t ] [ "b" get disposed?>> ] unit-test

core/continuations/continuations.factor

@@ -138,6 +138,11 @@ SYMBOL: thread-error-hook
 
 GENERIC: dispose ( object -- )
 
+: dispose-each ( seq -- )
+    [
+        [ [ dispose ] curry [ , ] recover ] each
+    ] { } make dup empty? [ drop ] [ peek rethrow ] if ;
+
 : with-disposal ( object quot -- )
     over [ dispose ] curry [ ] cleanup ; inline
 

extra/destructors/destructors.factor

@@ -26,14 +26,11 @@ M: destructor dispose
 : add-always-destructor ( obj -- )
     <destructor> always-destructors get push ;
 
-: dispose-each ( seq -- )
-    <reversed> [ dispose ] each ;
-
 : do-always-destructors ( -- )
-    always-destructors get dispose-each ;
+    always-destructors get <reversed> dispose-each ;
 
 : do-error-destructors ( -- )
-    error-destructors get dispose-each ;
+    error-destructors get <reversed> dispose-each ;
 
 : with-destructors ( quot -- )
     [

extra/io/server/server.factor

@@ -47,7 +47,7 @@ PRIVATE>
     ] with-variable ; inline
 
 : stop-server ( -- )
-    servers get [ dispose ] each ;
+    servers get dispose-each ;
 
 <PRIVATE