--- /dev/null
+USING: help.markup help.syntax sequences words ;
+IN: help.lint.checks
+
+HELP: check-example
+{ $values { "element" sequence } }
+{ $description "Throws an error if the expected output from the $example is different from the expected, or if it leaks disposables." } ;
+
+HELP: check-values
+{ $values { "word" word } { "element" sequence } }
+{ $description "Throws an error if the $values pair doesnt match the declared stack effect." }
+{ $examples
+ { $unchecked-example
+ "USING: help.lint.checks math ;"
+ ": foo ( x -- y ) ;"
+ "\\ foo { $values { \"a\" number } { \"b\" number } } check-values"
+ "$values don't match stack effect; expected { \"x\" \"y\" }, got { \"a\" \"b\" }\n\nType :help for debugging help."
+ }
+} ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.tuple combinators
-combinators.short-circuit debugger definitions effects eval fry
-grouping help help.markup help.topics io io.streams.string
-kernel macros namespaces sequences sequences.deep sets splitting
-strings summary unicode.categories vocabs vocabs.loader words
-words.constant words.symbol ;
+combinators.short-circuit debugger definitions effects eval
+formatting fry grouping help help.markup help.topics io io.streams.string
+kernel macros math namespaces sequences sequences.deep sets splitting
+strings summary threads tools.destructors unicode.categories vocabs vocabs.loader
+words words.constant words.symbol ;
FROM: sets => members ;
IN: help.lint.checks
SYMBOL: vocab-articles
: check-example ( element -- )
- '[
- _ rest [
- but-last "\n" join
- [ (eval>string) ] call( code -- output )
- "\n" ?tail drop
- ] keep
- last assert=
- ] vocabs-quot get call( quot -- ) ;
+ [
+ '[
+ _ rest [
+ but-last "\n" join
+ [ (eval>string) ] call( code -- output )
+ "\n" ?tail drop
+ ] keep
+ last assert=
+ ] vocabs-quot get call( quot -- )
+ ] leaks members length [
+ "%d disposable(s) leaked in example" sprintf simple-lint-error
+ ] unless-zero ;
: check-examples ( element -- )
\ $example swap elements [ check-example ] each ;
: extract-value-effects ( element -- seq )
\ $values swap elements dup empty? [
- first rest [
+ first rest [
\ $quotation swap elements dup empty? [ drop f ] [
first second
] if
[ constant? ]
} 1|| ;
+: skip-check-values? ( word element -- ? )
+ [ don't-check-word? ] [ contains-funky-elements? ] bi* or ;
+
: check-values ( word element -- )
- {
- [
- [ don't-check-word? ]
- [ contains-funky-elements? ]
- bi* or
- ] [
- [ effect-values ]
- [ extract-values ]
- bi* sequence=
- ]
- } 2|| [ "$values don't match stack effect" simple-lint-error ] unless ;
+ 2dup skip-check-values? [ 2drop ] [
+ [ effect-values ] [ extract-values ] bi* 2dup
+ sequence= [ 2drop ] [
+ "$values don't match stack effect; expected %u, got %u" sprintf
+ simple-lint-error
+ ] if
+ ] if ;
: check-value-effects ( word element -- )
[ effect-effects ]
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax help.tips quotations destructors ;
+USING: destructors help.markup help.syntax help.tips quotations sequences ;
IN: tools.destructors
HELP: disposables.
{ $description "Print the number of disposable objects of each class." } ;
-HELP: leaks
+HELP: leaks.
{ $values
{ "quot" quotation }
}
{ $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." ;
+HELP: leaks
+{ $values
+ { "quot" quotation }
+ { "disposables" sequence }
+}
+{ $description
+ "Runs the quotation and collects all disposables leaked by it. Used by " { $link leaks. } "."
+} ;
+
+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."
{ $subsections
debug-leaks?
disposables.
- leaks
+ leaks.
}
{ $see-also "destructors" } ;
f debug-leaks? set-global
-[ [ 3 throw ] leaks ] must-fail
+[ [ 3 throw ] leaks. ] must-fail
[ f ] [ debug-leaks? get-global ] unit-test
-[ ] [ [ ] leaks ] unit-test
+[ ] [ [ ] leaks. ] unit-test
[ f ] [ debug-leaks? get-global ] unit-test
-
[ disposables get members sort-disposables ] dip
'[ _ instance? ] filter stack. ;
-: leaks ( quot -- )
+: leaks ( quot -- disposables )
disposables get clone
t debug-leaks? set-global
[
[ call disposables get clone ] dip
] [ f debug-leaks? set-global ] [ ] cleanup
- diff (disposables.) ; inline
+ diff ; inline
+
+: leaks. ( quot -- )
+ leaks (disposables.) ; inline