From 197a64eaaeaa4685e232623fe8fd96206c7adf0c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:19:55 -0500
Subject: [PATCH 01/15] io.streams.duplex: fix test
---
basis/io/streams/duplex/duplex-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/io/streams/duplex/duplex-tests.factor b/basis/io/streams/duplex/duplex-tests.factor
index 4903db2b1b..b64273ebb3 100644
--- a/basis/io/streams/duplex/duplex-tests.factor
+++ b/basis/io/streams/duplex/duplex-tests.factor
@@ -5,7 +5,7 @@ IN: io.streams.duplex.tests
! Test duplex stream close behavior
TUPLE: closing-stream < disposable ;
-: <closing-stream> ( -- stream ) closing-stream new ;
+: <closing-stream> ( -- stream ) closing-stream new-disposable ;
M: closing-stream dispose* drop ;
From 3be328056db8ab721e3a92c542568f592bf61d6b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:21:03 -0500
Subject: [PATCH 02/15] libc: use central disposables mechanism to track
mallocs
---
basis/libc/libc-tests.factor | 4 ++--
basis/libc/libc.factor | 28 ++++++++++++-------------
basis/tools/deploy/shaker/shaker.factor | 2 --
3 files changed, 16 insertions(+), 18 deletions(-)
diff --git a/basis/libc/libc-tests.factor b/basis/libc/libc-tests.factor
index b00463127f..3dcebb5e7a 100644
--- a/basis/libc/libc-tests.factor
+++ b/basis/libc/libc-tests.factor
@@ -4,8 +4,8 @@ destructors kernel ;
100 malloc "block" set
-[ t ] [ "block" get mallocs key? ] unit-test
+[ t ] [ "block" get malloc-exists? ] unit-test
[ ] [ [ "block" get &free drop ] with-destructors ] unit-test
-[ f ] [ "block" get mallocs key? ] unit-test
+[ f ] [ "block" get malloc-exists? ] unit-test
diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor
index 7a55b15473..926a6c4ec4 100644
--- a/basis/libc/libc.factor
+++ b/basis/libc/libc.factor
@@ -3,7 +3,7 @@
! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: alien assocs continuations alien.destructors kernel
-namespaces accessors sets summary ;
+namespaces accessors sets summary destructors destructors.private ;
IN: libc
: errno ( -- int )
@@ -26,8 +26,16 @@ IN: libc
: (realloc) ( alien size -- newalien )
"void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
-: mallocs ( -- assoc )
- \ mallocs [ H{ } clone ] initialize-alien ;
+! We stick malloc-ptr instances in the global disposables set
+TUPLE: malloc-ptr value continuation ;
+
+M: malloc-ptr hashcode* value>> hashcode* ;
+
+M: malloc-ptr equal?
+ over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
+
+: <malloc-ptr> ( value -- malloc-ptr )
+ malloc-ptr new swap >>value ;
PRIVATE>
@@ -39,11 +47,6 @@ M: bad-ptr summary
: check-ptr ( c-ptr -- c-ptr )
[ bad-ptr ] unless* ;
-ERROR: double-free ;
-
-M: double-free summary
- drop "Free failed since memory is not allocated" ;
-
ERROR: realloc-error ptr size ;
M: realloc-error summary
@@ -52,16 +55,13 @@ M: realloc-error summary
<PRIVATE
: add-malloc ( alien -- alien )
- dup mallocs conjoin ;
+ dup <malloc-ptr> register-disposable ;
: delete-malloc ( alien -- )
- [
- mallocs delete-at*
- [ drop ] [ double-free ] if
- ] when* ;
+ [ <malloc-ptr> unregister-disposable ] when* ;
: malloc-exists? ( alien -- ? )
- mallocs key? ;
+ <malloc-ptr> disposables get key? ;
PRIVATE>
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index c587f842ca..b24981ed88 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -284,8 +284,6 @@ IN: tools.deploy.shaker
"io-thread" "io.thread" lookup ,
- "mallocs" "libc.private" lookup ,
-
"disposables" "destructors" lookup ,
deploy-threads? [
From b12bbaf7ecad3b18cb446a32faa7424f3bd9efd2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:21:38 -0500
Subject: [PATCH 03/15] tools.destructors: destructors. and leaks words now
output a 'show instances' link which lists all relevant disposables
---
basis/tools/destructors/destructors.factor | 52 +++++++++++++++-------
core/destructors/destructors.factor | 16 +++++--
2 files changed, 49 insertions(+), 19 deletions(-)
diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor
index 4f182c6777..d032b5291a 100644
--- a/basis/tools/destructors/destructors.factor
+++ b/basis/tools/destructors/destructors.factor
@@ -1,31 +1,51 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes destructors fry kernel math namespaces
-prettyprint sequences sets sorting ;
+prettyprint sequences sets sorting continuations accessors arrays
+io io.styles combinators.smart ;
IN: tools.destructors
<PRIVATE
-: disposable-tally ( -- assoc )
- disposables get
- H{ } clone [ [ keys ] dip '[ class _ inc-at ] each ] keep ;
-
-: subtract-values ( assoc1 assoc2 -- assoc )
- [ [ keys ] bi@ append prune ] 2keep
- H{ } clone [
- '[
- [ _ _ [ at 0 or ] bi-curry@ bi - ] keep _ set-at
- ] each
- ] keep ;
+: class-tally ( assoc -- assoc' )
+ H{ } clone [ [ keys ] dip '[ dup class _ push-at ] each ] keep ;
: (disposables.) ( assoc -- )
- >alist sort-keys simple-table. ;
+ class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with
+ standard-table-style [
+ [
+ [ "Disposable class" write ] with-cell
+ [ "Instances" write ] with-cell
+ [ ] with-cell
+ ] with-row
+ [
+ [
+ [
+ [ pprint-cell ]
+ [ pprint-cell ]
+ [ [ "[ List instances ]" swap write-object ] with-cell ]
+ tri*
+ ] input<sequence
+ ] with-row
+ ] each
+ ] tabular-output nl ;
+
+: sort-disposables ( seq -- seq' )
+ [ disposable? ] partition [ [ id>> ] sort-with ] dip append ;
PRIVATE>
: disposables. ( -- )
- disposable-tally (disposables.) ;
+ disposables get (disposables.) ;
+
+: disposables-of-class. ( class -- )
+ [ disposables get values sort-disposables ] dip
+ '[ _ instance? ] filter stack. ;
: leaks ( quot -- )
- disposable-tally [ call disposable-tally ] dip subtract-values
- (disposables.) ; inline
+ disposables get clone
+ debug-leaks? on
+ [
+ [ call disposables get clone ] dip
+ ] [ ] [ debug-leaks? off ] cleanup
+ assoc-diff (disposables.) ; inline
diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index 39f0e9f2b9..d306da18c4 100644
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -1,24 +1,34 @@
! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors continuations kernel namespaces make
-sequences vectors sets assocs init ;
+sequences vectors sets assocs init math ;
IN: destructors
SYMBOL: disposables
[ H{ } clone disposables set-global ] "destructors" add-init-hook
+ERROR: already-unregistered disposable ;
+
+SYMBOL: debug-leaks?
+
<PRIVATE
+SLOT: continuation
+
: register-disposable ( obj -- )
+ debug-leaks? get [ continuation >>continuation ] when
disposables get conjoin ;
: unregister-disposable ( obj -- )
- disposables get delete-at ;
+ disposables get 2dup key? [ already-unregistered ] unless delete-at ;
PRIVATE>
-TUPLE: disposable < identity-tuple disposed id ;
+TUPLE: disposable < identity-tuple
+{ id integer }
+{ disposed boolean }
+continuation ;
M: disposable hashcode* nip id>> ;
From 623ddfca6f8c56c985e390dbfbcee259df655648 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:22:00 -0500
Subject: [PATCH 04/15] ui.tools.operations: disposables now have a 'dispose'
operation, and disposables created within a 'leaks' now have an operation
which shows the continuation that created them
---
basis/ui/tools/operations/operations.factor | 35 +++++++++++++++------
1 file changed, 26 insertions(+), 9 deletions(-)
diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor
index 4944cba1d6..3019de4e21 100644
--- a/basis/ui/tools/operations/operations.factor
+++ b/basis/ui/tools/operations/operations.factor
@@ -1,15 +1,16 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations definitions generic help.topics threads
-stack-checker summary io.pathnames io.styles kernel namespaces parser
-prettyprint quotations tools.crossref tools.annotations editors
-tools.profiler tools.test tools.time tools.walker vocabs vocabs.loader
-words sequences classes compiler.errors compiler.units
-accessors vocabs.parser macros.expander ui ui.tools.browser
-ui.tools.listener ui.tools.listener.completion ui.tools.profiler
-ui.tools.inspector ui.tools.traceback ui.commands ui.gadgets.editors
-ui.gestures ui.operations ui.tools.deploy models help.tips
-source-files.errors ;
+stack-checker summary io.pathnames io.styles kernel namespaces
+parser prettyprint quotations tools.crossref tools.annotations
+editors tools.profiler tools.test tools.time tools.walker vocabs
+vocabs.loader words sequences classes compiler.errors
+compiler.units accessors vocabs.parser macros.expander ui
+ui.tools.browser ui.tools.listener ui.tools.listener.completion
+ui.tools.profiler ui.tools.inspector ui.tools.traceback
+ui.commands ui.gadgets.editors ui.gestures ui.operations
+ui.tools.deploy models help.tips source-files.errors destructors
+libc libc.private ;
IN: ui.tools.operations
! Objects
@@ -182,6 +183,22 @@ M: word com-stack-effect 1quotation com-stack-effect ;
{ +listener+ t }
} define-operation
+! Disposables
+[ disposable? ] \ dispose H{ } define-operation
+
+! Disposables with a continuation
+PREDICATE: tracked-disposable < disposable
+ continuation>> >boolean ;
+
+PREDICATE: tracked-malloc-ptr < malloc-ptr
+ continuation>> >boolean ;
+
+: com-creation-traceback ( disposable -- )
+ continuation>> traceback-window ;
+
+[ tracked-disposable? ] \ com-creation-traceback H{ { +primary+ t } } define-operation
+[ tracked-malloc-ptr? ] \ com-creation-traceback H{ { +primary+ t } } define-operation
+
! Operations -> commands
interactor
"quotation"
From adc154e06bba18e2b16ea69ac0ac1ece66bca641 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:27:22 -0500
Subject: [PATCH 05/15] destructors: already-unregistered error had the wrong
content, also don't throw an error when disposing a disposable twice
---
core/destructors/destructors-tests.factor | 11 ++++++++++-
core/destructors/destructors.factor | 8 ++++++--
core/io/files/files-tests.factor | 8 +++++++-
3 files changed, 23 insertions(+), 4 deletions(-)
diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor
index f9d0770d02..c55b5ef423 100644
--- 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 d306da18c4..4190cdaaf5 100644
--- 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 f57dafbdc6..6387e47dfc 100644
--- 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
From b2a1858f8f66183db1d9619158c77b0bb43a5574 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:33:27 -0500
Subject: [PATCH 06/15] Move a few more things over to new disposable protocol
---
basis/checksums/openssl/openssl.factor | 8 ++++----
basis/io/backend/unix/multiplexers/epoll/epoll.factor | 2 +-
basis/io/backend/unix/multiplexers/kqueue/kqueue.factor | 2 +-
basis/io/backend/unix/multiplexers/multiplexers.factor | 6 +++---
basis/ui/pixel-formats/pixel-formats.factor | 8 +++++---
5 files changed, 14 insertions(+), 12 deletions(-)
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index 58748b7c29..6f21d96e86 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -19,13 +19,13 @@ C: <openssl-checksum> openssl-checksum
<PRIVATE
-TUPLE: evp-md-context handle ;
+TUPLE: evp-md-context < disposable handle ;
: <evp-md-context> ( -- ctx )
- "EVP_MD_CTX" <c-object>
- dup EVP_MD_CTX_init evp-md-context boa ;
+ evp-md-context new-disposable
+ "EVP_MD_CTX" <c-object> dup EVP_MD_CTX_init >>handle ;
-M: evp-md-context dispose
+M: evp-md-context dispose*
handle>> EVP_MD_CTX_cleanup drop ;
: with-evp-md-context ( quot -- )
diff --git a/basis/io/backend/unix/multiplexers/epoll/epoll.factor b/basis/io/backend/unix/multiplexers/epoll/epoll.factor
index e1428fee4d..98c48c113d 100644
--- a/basis/io/backend/unix/multiplexers/epoll/epoll.factor
+++ b/basis/io/backend/unix/multiplexers/epoll/epoll.factor
@@ -18,7 +18,7 @@ TUPLE: epoll-mx < mx events ;
max-events epoll_create dup io-error >>fd
max-events "epoll-event" <struct-array> >>events ;
-M: epoll-mx dispose fd>> close-file ;
+M: epoll-mx dispose* fd>> close-file ;
: make-event ( fd events -- event )
"epoll-event" <c-object>
diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor
index 7bd157136a..f7b15beb54 100644
--- a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor
+++ b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor
@@ -17,7 +17,7 @@ TUPLE: kqueue-mx < mx events ;
kqueue dup io-error >>fd
max-events "kevent" <struct-array> >>events ;
-M: kqueue-mx dispose fd>> close-file ;
+M: kqueue-mx dispose* fd>> close-file ;
: make-kevent ( fd filter flags -- event )
"kevent" <c-object>
diff --git a/basis/io/backend/unix/multiplexers/multiplexers.factor b/basis/io/backend/unix/multiplexers/multiplexers.factor
index 844670d635..73d8a60310 100644
--- a/basis/io/backend/unix/multiplexers/multiplexers.factor
+++ b/basis/io/backend/unix/multiplexers/multiplexers.factor
@@ -1,12 +1,12 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors assocs sequences threads ;
+USING: kernel accessors assocs sequences threads destructors ;
IN: io.backend.unix.multiplexers
-TUPLE: mx fd reads writes ;
+TUPLE: mx < disposable fd reads writes ;
: new-mx ( class -- obj )
- new
+ new-disposable
H{ } clone >>reads
H{ } clone >>writes ; inline
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index a280ab0666..b902521079 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -46,13 +46,15 @@ HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value
ERROR: invalid-pixel-format-attributes world attributes ;
-TUPLE: pixel-format world handle ;
+TUPLE: pixel-format < disposable world handle ;
: <pixel-format> ( world attributes -- pixel-format )
2dup (make-pixel-format)
- [ nip pixel-format boa ] [ invalid-pixel-format-attributes ] if* ;
+ [ pixel-format new swap >>handle swap >>world ]
+ [ invalid-pixel-format-attributes ]
+ ?if ;
-M: pixel-format dispose
+M: pixel-format dispose*
[ (free-pixel-format) ] [ f >>handle drop ] bi ;
: pixel-format-attribute ( pixel-format attribute-name -- value )
From e44a0158e60fdcbc4af3aeb67273bac4f4a02a09 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:45:06 -0500
Subject: [PATCH 07/15] tools.destructors: leaks now tracks leaks globally
---
basis/tools/destructors/destructors.factor | 4 ++--
core/destructors/destructors.factor | 2 +-
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor
index d032b5291a..c0aa35b049 100644
--- a/basis/tools/destructors/destructors.factor
+++ b/basis/tools/destructors/destructors.factor
@@ -44,8 +44,8 @@ PRIVATE>
: leaks ( quot -- )
disposables get clone
- debug-leaks? on
+ t debug-leaks? set-global
[
[ call disposables get clone ] dip
- ] [ ] [ debug-leaks? off ] cleanup
+ ] [ ] [ f debug-leaks? set-global ] cleanup
assoc-diff (disposables.) ; inline
diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index 4190cdaaf5..3e57f498af 100644
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -17,7 +17,7 @@ SYMBOL: debug-leaks?
SLOT: continuation
: register-disposable ( obj -- )
- debug-leaks? get [ continuation >>continuation ] when
+ debug-leaks? get-global [ continuation >>continuation ] when
disposables get conjoin ;
: unregister-disposable ( obj -- )
From 8b68a07649a23fbfc9f0a343f6d91c3a053362a6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:45:19 -0500
Subject: [PATCH 08/15] ui.pixel-formats: fix screwup
---
basis/ui/pixel-formats/pixel-formats.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index b902521079..f463ae2b68 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -50,7 +50,7 @@ TUPLE: pixel-format < disposable world handle ;
: <pixel-format> ( world attributes -- pixel-format )
2dup (make-pixel-format)
- [ pixel-format new swap >>handle swap >>world ]
+ [ pixel-format new-disposable swap >>handle swap >>world ]
[ invalid-pixel-format-attributes ]
?if ;
From 7b6d00a833ebd6326516b9bdd735a512018c347e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:45:46 -0500
Subject: [PATCH 09/15] alien.destructors: don't use disposable protocol, since
it is common practice to 'leak' alien destructors (|Foo idiom)
---
basis/alien/destructors/destructors.factor | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor
index 24a75304b7..7fd991b9af 100755
--- a/basis/alien/destructors/destructors.factor
+++ b/basis/alien/destructors/destructors.factor
@@ -4,7 +4,7 @@ USING: functors destructors accessors kernel parser words
effects generalizations sequences ;
IN: alien.destructors
-SLOT: alien
+TUPLE: alien-destructor alien ;
FUNCTOR: define-destructor ( F -- )
@@ -16,12 +16,12 @@ N [ F stack-effect out>> length ]
WHERE
-TUPLE: F-destructor < disposable alien ;
+TUPLE: F-destructor < alien-destructor ;
: <F-destructor> ( alien -- destructor )
- F-destructor new-disposable swap >>alien ; inline
+ F-destructor boa ; inline
-M: F-destructor dispose* alien>> F N ndrop ;
+M: F-destructor dispose alien>> F N ndrop ;
: &F ( alien -- alien ) dup <F-destructor> &dispose drop ; inline
From 29b489c892919c8f40cab2b8e9b81a1f94df939b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 20:55:24 -0500
Subject: [PATCH 10/15] io.monitors: fixes for disposable protocol
---
basis/io/monitors/macosx/macosx.factor | 3 +--
basis/io/monitors/monitors.factor | 2 --
2 files changed, 1 insertion(+), 4 deletions(-)
diff --git a/basis/io/monitors/macosx/macosx.factor b/basis/io/monitors/macosx/macosx.factor
index be1dcc64b6..96f178fb79 100644
--- a/basis/io/monitors/macosx/macosx.factor
+++ b/basis/io/monitors/macosx/macosx.factor
@@ -17,7 +17,6 @@ M:: macosx (monitor) ( path recursive? mailbox -- monitor )
path 1array 0 0 <event-stream> >>handle
] ;
-M: macosx-monitor dispose
- handle>> dispose ;
+M: macosx-monitor dispose* handle>> dispose ;
macosx set-io-backend
diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor
index d8bb1ed488..cb2f552a32 100644
--- a/basis/io/monitors/monitors.factor
+++ b/basis/io/monitors/monitors.factor
@@ -22,8 +22,6 @@ M: object dispose-monitors ;
TUPLE: monitor < disposable path queue timeout ;
-M: monitor hashcode* path>> hashcode* ;
-
M: monitor timeout timeout>> ;
M: monitor set-timeout (>>timeout) ;
From c925724d7b119121c1467d5164349fbdafe2bb5c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 21:44:48 -0500
Subject: [PATCH 11/15] Improve destructors docs, fix bug where debug-leaks?
wasn't being switched off
---
basis/listener/listener.factor | 1 +
.../tools/destructors/destructors-docs.factor | 7 ++++--
.../destructors/destructors-tests.factor | 13 +++++++++++
basis/tools/destructors/destructors.factor | 2 +-
core/destructors/destructors-docs.factor | 22 +++++++++++++++++--
5 files changed, 40 insertions(+), 5 deletions(-)
create mode 100644 basis/tools/destructors/destructors-tests.factor
diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 34d9eac121..57d1fd3964 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -163,6 +163,7 @@ SYMBOL: interactive-vocabs
"syntax"
"tools.annotations"
"tools.crossref"
+ "tools.destructors"
"tools.disassembler"
"tools.errors"
"tools.memory"
diff --git a/basis/tools/destructors/destructors-docs.factor b/basis/tools/destructors/destructors-docs.factor
index e5a8f0318b..e01c61db00 100644
--- a/basis/tools/destructors/destructors-docs.factor
+++ b/basis/tools/destructors/destructors-docs.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax quotations ;
+USING: help.markup help.syntax help.tips quotations destructors ;
IN: tools.destructors
HELP: disposables.
@@ -10,10 +10,13 @@ HELP: leaks
{ $values
{ "quot" quotation }
}
-{ $description "Runs a quotation, printing any increases in the number of disposable objects after the quotation returns." } ;
+{ $description "Runs a quotation, printing any increases in the number of disposable objects after the quotation returns. The " { $link debug-leaks? } " variable is also switched on while the quotation runs, recording the current continuation in every newly-created disposable object." } ;
+
+TIP: "Use the " { $link leaks } " combinator to track down resource leaks." ;
ARTICLE: "tools.destructors" "Destructor tools"
"The " { $vocab-link "tools.destructors" } " vocabulary provides words for tracking down resource leaks."
+{ $subsection debug-leaks? }
{ $subsection disposables. }
{ $subsection leaks }
{ $see-also "destructors" } ;
diff --git a/basis/tools/destructors/destructors-tests.factor b/basis/tools/destructors/destructors-tests.factor
new file mode 100644
index 0000000000..24904f76f6
--- /dev/null
+++ b/basis/tools/destructors/destructors-tests.factor
@@ -0,0 +1,13 @@
+USING: kernel tools.destructors tools.test destructors namespaces ;
+IN: tools.destructors.tests
+
+f debug-leaks? set-global
+
+[ [ 3 throw ] leaks ] must-fail
+
+[ f ] [ debug-leaks? get-global ] unit-test
+
+[ ] [ [ ] leaks ] unit-test
+
+[ f ] [ debug-leaks? get-global ] unit-test
+
diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor
index c0aa35b049..42d09d0ef9 100644
--- a/basis/tools/destructors/destructors.factor
+++ b/basis/tools/destructors/destructors.factor
@@ -47,5 +47,5 @@ PRIVATE>
t debug-leaks? set-global
[
[ call disposables get clone ] dip
- ] [ ] [ f debug-leaks? set-global ] cleanup
+ ] [ f debug-leaks? set-global ] [ ] cleanup
assoc-diff (disposables.) ; inline
diff --git a/core/destructors/destructors-docs.factor b/core/destructors/destructors-docs.factor
index 8a0c36b99a..a342352b90 100644
--- a/core/destructors/destructors-docs.factor
+++ b/core/destructors/destructors-docs.factor
@@ -1,7 +1,24 @@
USING: help.markup help.syntax libc kernel continuations io
-sequences ;
+sequences classes ;
IN: destructors
+HELP: debug-leaks?
+{ $var-description "When this variable is on, " { $link new-disposable } " stores the current continuation in the " { $link disposable } "'s " { $slot "continuation" } " slot." }
+{ $see-also "tools.destructors" } ;
+
+HELP: disposable
+{ $class-description "Parent class for disposable resources. This class has three slots:"
+ { $list
+ { { $slot "disposed" } " - boolean. Set to true by " { $link dispose } ". Assert that it is false with " { $link check-disposed } "." }
+ { { $slot "id" } " - unique identifier. Set by " { $link new-disposable } "." }
+ { { $slot "continuation" } " - current continuation at construction time, for debugging. Set by " { $link new-disposable } " if " { $link debug-leaks? } " is on." }
+ }
+"New instances must be constructed with " { $link new-disposable } " and subclasses must implement " { $link dispose* } "." } ;
+
+HELP: new-disposable
+{ $values { "class" class } { "disposable" disposable } }
+{ $description "Constructs a new instance of a subclass of " { $link disposable } ". This sets the " { $slot "id" } " slot, registers the new object with the global " { $link disposables } " set, and if " { $link debug-leaks? } " is on, stores the current continuation in the " { $slot "continuation" } " slot." } ;
+
HELP: dispose
{ $values { "disposable" "a disposable object" } }
{ $contract "Releases operating system resources associated with a disposable object. Disposable objects include streams, memory mapped files, and so on."
@@ -52,7 +69,8 @@ HELP: dispose-each
{ $description "Attempts to dispose of each element of a sequence and collects all of the errors into a sequence. If any errors are thrown during disposal, the last error is rethrown after all objects have been disposed." } ;
HELP: disposables
-{ $var-description "Global variable holding all disposable objects which have not been disposed of yet. The " { $link new-disposable } " word adds objects here, and the " { $link dispose } " method on disposables removes them. The " { $link "tools.destructors" } " vocabulary provides some words for working with this data." } ;
+{ $var-description "Global variable holding all disposable objects which have not been disposed of yet. The " { $link new-disposable } " word adds objects here, and the " { $link dispose } " method on disposables removes them. The " { $link "tools.destructors" } " vocabulary provides some words for working with this data." }
+{ $see-also "tools.destructors" } ;
ARTICLE: "destructors-anti-patterns" "Resource disposal anti-patterns"
"Words which create objects corresponding to external resources should always be used with " { $link with-disposal } ". The following code is wrong:"
From bb51ee8d260bb6150aa1e587680274c75c9e4fc3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 24 Aug 2009 21:56:14 -0500
Subject: [PATCH 12/15] help.vocabs: 'authors' and 'tags' weren't recursing
like they should've been
---
basis/help/vocabs/vocabs.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/help/vocabs/vocabs.factor b/basis/help/vocabs/vocabs.factor
index 7d99493691..e8b145d37e 100644
--- a/basis/help/vocabs/vocabs.factor
+++ b/basis/help/vocabs/vocabs.factor
@@ -249,7 +249,8 @@ C: <vocab-author> vocab-author
} cleave ;
: keyed-vocabs ( str quot -- seq )
- [ all-vocabs ] 2dip '[ [ _ swap @ member? ] filter ] assoc-map ; inline
+ [ all-vocabs-recursive ] 2dip
+ '[ [ _ swap @ member? ] filter no-prefixes ] assoc-map ; inline
: tagged ( tag -- assoc )
[ vocab-tags ] keyed-vocabs ;
From 93adf617c03f9b4b6faa01365d6bf8ce26736bc0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Tue, 25 Aug 2009 05:02:50 -0500
Subject: [PATCH 13/15] windows.com.wrapper: crash fix
---
basis/windows/com/wrapper/wrapper.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index 81ae923d26..afa3abf287 100755
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -153,7 +153,7 @@ PRIVATE>
[ +live-wrappers+ get adjoin ] bi ;
: <com-wrapper> ( implementations -- wrapper )
- com-wrapper new-disposable swap (make-callbacks) >>vtbls
+ com-wrapper new-disposable swap (make-callbacks) >>callbacks
dup allocate-wrapper ;
M: com-wrapper dispose*
From 6106eed185f934c682014130b8d3aaa79d0130d8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Tue, 25 Aug 2009 05:06:16 -0500
Subject: [PATCH 14/15] alien.marshall.syntax: don't clobber bool type in unit
tests
---
extra/alien/marshall/syntax/syntax-tests.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/extra/alien/marshall/syntax/syntax-tests.factor b/extra/alien/marshall/syntax/syntax-tests.factor
index 3945924a57..68e6f7aff8 100644
--- a/extra/alien/marshall/syntax/syntax-tests.factor
+++ b/extra/alien/marshall/syntax/syntax-tests.factor
@@ -10,7 +10,8 @@ C-LIBRARY: test
C-INCLUDE: <stdlib.h>
C-INCLUDE: <string.h>
-C-TYPEDEF: char bool
+! This used to typedef 'bool' but that's bad for PowerPC where its really an int
+C-TYPEDEF: char mybool
CM-FUNCTION: void outarg1 ( int* a )
*a += 2;
@@ -38,7 +39,7 @@ CM-FUNCTION: void change_time ( double hours, sundial* d )
d->wedge.degrees = hours * 30;
;
-CM-FUNCTION: bool c_not ( bool p )
+CM-FUNCTION: mybool c_not ( mybool p )
return !p;
;
From 965e9ba3279e567899370fc4beb7a526a2480593 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Tue, 25 Aug 2009 05:10:41 -0500
Subject: [PATCH 15/15] alien.marshall: fix unit tests
---
extra/alien/marshall/marshall.factor | 4 ++--
extra/alien/marshall/syntax/syntax-tests.factor | 6 ++----
2 files changed, 4 insertions(+), 6 deletions(-)
diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index 547e37f78a..d861178fad 100644
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -93,7 +93,7 @@ ALIAS: marshall-void* marshall-pointer
: primitive-marshaller ( type -- quot/f )
{
- { "bool" [ [ marshall-bool ] ] }
+ { "bool" [ [ ] ] }
{ "boolean" [ [ marshall-bool ] ] }
{ "char" [ [ marshall-primitive ] ] }
{ "uchar" [ [ marshall-primitive ] ] }
@@ -179,7 +179,7 @@ ALIAS: marshall-void* marshall-pointer
: primitive-unmarshaller ( type -- quot/f )
{
- { "bool" [ [ unmarshall-bool ] ] }
+ { "bool" [ [ ] ] }
{ "boolean" [ [ unmarshall-bool ] ] }
{ "char" [ [ ] ] }
{ "uchar" [ [ ] ] }
diff --git a/extra/alien/marshall/syntax/syntax-tests.factor b/extra/alien/marshall/syntax/syntax-tests.factor
index 68e6f7aff8..437685137c 100644
--- a/extra/alien/marshall/syntax/syntax-tests.factor
+++ b/extra/alien/marshall/syntax/syntax-tests.factor
@@ -9,9 +9,7 @@ C-LIBRARY: test
C-INCLUDE: <stdlib.h>
C-INCLUDE: <string.h>
-
-! This used to typedef 'bool' but that's bad for PowerPC where its really an int
-C-TYPEDEF: char mybool
+C-INCLUDE: <stdbool.h>
CM-FUNCTION: void outarg1 ( int* a )
*a += 2;
@@ -39,7 +37,7 @@ CM-FUNCTION: void change_time ( double hours, sundial* d )
d->wedge.degrees = hours * 30;
;
-CM-FUNCTION: mybool c_not ( mybool p )
+CM-FUNCTION: bool c_not ( bool p )
return !p;
;