destructors: already-unregistered error had the wrong content, also don't throw an...

diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor
index f9d0770d0238f4605b0b93786e8260add302db95..c55b5ef4231eff46b3295c927979e35338362841 100644 (file)
--- a/core/destructors/destructors-tests.factor
+++ b/core/destructors/destructors-tests.factor
@@ -1,5 +1,5 @@
 USING: destructors kernel tools.test continuations accessors
-namespaces sequences ;
+namespaces sequences destructors.private ;
 IN: destructors.tests
 
 TUPLE: dispose-error ;
@@ -66,3 +66,12 @@ M: dummy-destructor dispose ( obj -- )
     ] ignore-errors destroyed?>>
 ] unit-test
 
+TUPLE: silly-disposable < disposable ;
+
+M: silly-disposable dispose* drop ;
+
+silly-disposable new-disposable "s" set
+"s" get dispose
+[ "s" get unregister-disposable ]
+[ disposable>> silly-disposable? ]
+must-fail-with

diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index d306da18c4a8100252f9ec9989c48b2e892fc39b..4190cdaaf5f447a7bbc875c98e6032a5c75fefbd 100644 (file)
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -21,7 +21,7 @@ SLOT: continuation
     disposables get conjoin ;
 
 : unregister-disposable ( obj -- )
-    disposables get 2dup key? [ already-unregistered ] unless delete-at ;
+    disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ;
 
 PRIVATE>
 
@@ -49,7 +49,11 @@ M: object dispose
     dup disposed>> [ drop ] [ t >>disposed dispose* ] if ;
 
 M: disposable dispose
-    [ unregister-disposable ] [ call-next-method ] bi ;
+    dup disposed>> [ drop ] [
+        [ unregister-disposable ]
+        [ call-next-method ]
+        bi
+    ] if ;
 
 : dispose-each ( seq -- )
     [

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index f57dafbdc64990c22eb1fac6a024375ea47afb08..6387e47dfc3bb97d4db856a2ceceb07a6110be6e 100644 (file)
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -152,4 +152,10 @@ USE: debugger.threads
     "non-byte-array-error" unique-file binary [
         "" write
     ] with-file-writer
-] [ no-method? ] must-fail-with
\ No newline at end of file
+] [ no-method? ] must-fail-with
+
+! What happens if we close a file twice?
+[ ] [
+    "closing-twice" unique-file ascii <file-writer>
+    [ dispose ] [ dispose ] bi
+] unit-test
\ No newline at end of file