! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes classes.struct
classes.tuple combinators 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 tools.destructors unicode vocabs vocabs.loader words
-words.constant words.symbol ;
+definitions effects eval formatting grouping help help.markup
+help.topics io io.streams.string kernel macros math
+math.statistics namespaces prettyprint sequences sequences.deep
+sets splitting strings summary tools.destructors unicode vocabs
+vocabs.loader words words.constant words.symbol ;
IN: help.lint.checks
ERROR: simple-lint-error message ;
M: simple-lint-error error. summary print ;
SYMBOL: vocabs-quot
-SYMBOL: all-vocabs-list
SYMBOL: vocab-articles
+: no-ui-disposables ( seq -- seq' )
+ [
+ class-of name>> {
+ "single-texture" "multi-texture" ! opengl.textures
+ "line" ! core-text
+ "layout" ! ui.text.pango
+ "script-string" ! windows.uniscribe
+ "linux-monitor" ! github issue #2014, race condition in disposing of child monitors
+ "event-stream"
+ "macosx-monitor"
+ "recursive-monitor"
+ "input-port"
+ "malloc-ptr"
+ "fd"
+ } member?
+ ] reject ;
+
: check-example ( element -- )
[
'[
_ rest [
- but-last "\n" join
- [ (eval>string) ] call( code -- output )
+ but-last join-lines
+ (eval-with-stack>string)
"\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 ;
+ ] leaks members no-ui-disposables
+ dup length 0 > [
+ dup [ class-of ] histogram-by
+ [ "Leaked resources: " write ... ] with-string-writer simple-lint-error
+ ] [
+ drop
+ ] if ;
: check-examples ( element -- )
\ $example swap elements [ check-example ] each ;
[ parsing-word? ]
[ "declared-effect" word-prop not ]
[ constant? ]
+ [ "help" word-prop not ]
} 1|| ;
: skip-check-values? ( word element -- ? )
simple-lint-error
] unless ;
-: check-nulls ( element -- )
- \ $values swap elements
- null swap deep-member?
- [ "$values should not contain null" simple-lint-error ] when ;
-
: check-see-also ( element -- )
\ $see-also swap elements [ rest all-unique? ] all?
[ "$see-also are not unique" simple-lint-error ] unless ;
-: vocab-exists? ( name -- ? )
- [ lookup-vocab ] [ all-vocabs-list get member? ] bi or ;
-
: check-modules ( element -- )
\ $vocab-link swap elements [
second
] unless
] each ;
+: check-slots-tables ( element -- )
+ \ $slots swap elements [ rest [ length 2 = ] all? ] all?
+ [ "$slots have too many values in at least one row" simple-lint-error ] unless ;
+
: check-rendering ( element -- )
[ print-content ] with-string-writer drop ;
simple-lint-error
] when
] [
- " " swap subseq? [
+ " " subseq-of? [
"Paragraph text should not contain double spaces"
simple-lint-error
] when
[ check-examples ]
[ check-modules ]
[ check-descriptions ]
+ [ check-slots-tables ]
} cleave ;
: files>vocabs ( -- assoc )