! 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.categories vocabs
+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 ;
-FROM: sets => members ;
IN: help.lint.checks
ERROR: simple-lint-error message ;
M: simple-lint-error error. summary print ;
SYMBOL: vocabs-quot
-SYMBOL: all-vocabs
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 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
dup struct-class? [ struct-slots ] [ all-slots ] if
[ name>> ] map
] [ extract-slots ] bi*
- [ swap member? not ] with filter [
+ [ swap member? ] with reject [
", " join "Described $slot does not exist: " prepend
simple-lint-error
] unless-empty
[ check-examples ]
[ check-modules ]
[ check-descriptions ]
+ [ check-slots-tables ]
} cleave ;
: files>vocabs ( -- assoc )
- vocabs
+ loaded-vocab-names
[ [ [ vocab-docs-path ] keep ] H{ } map>assoc ]
[ [ [ vocab-source-path ] keep ] H{ } map>assoc ]
bi assoc-union ;