\ cond [ [ object ] [ ] ] "infer-effect" set-word-prop
\ cond [
- pop-literal [ first2 cons ] map
+ pop-literal [ first2 cons ] map reverse-slice
[ no-cond ] swap alist>quot infer-quot-value
] "infer" set-word-prop
} cond
] compile-1
] unit-test
+
+[ 3 ] [
+ [
+ 3 {
+ { [ dup fixnum? ] [ ] }
+ { [ t ] [ drop t ] }
+ } cond
+ ] compile-1
+] unit-test
[ "txt" ] [ "foo.bar.txt" file-extension ] unit-test
[ "text/plain" ] [ "foo.bar.txt" mime-type ] unit-test
[ "text/html" ] [ "index.html" mime-type ] unit-test
-
-! Some tests to ensure these words simply work, since we can't
-! really test them
-
-[ t ] [ cwd directory list? ] unit-test
-
-cwd directory.
] with-scope
] unit-test
-[ "<img src='/responder/resource/library/icons/File.png'>" ]
-[
- [
- ""
- [ [[ icon "library/icons/File.png" ]] ]
- [ drop ] icon-tag
- ] string-out
-] unit-test
-
[ "" ]
[
[
[ "" ] [ 0 read ] unit-test
-[ ] [ "123" write 9000 CHAR: x fill write flush ] unit-test
+! [ ] [ "123" write 9000 CHAR: x fill write flush ] unit-test
[ "line 1" CHAR: l ]
[
-IN: temporary
USING: kernel parser sequences test words ;
+IN: temporary
DEFER: foo
-": foo 2 2 + . ; parsing" eval
+"IN: temporary : foo 2 2 + . ; parsing" eval
[ [ ] ] [ "USE: temporary foo" parse ] unit-test
-": foo 2 2 + . ;" eval
+"IN: temporary : foo 2 2 + . ;" eval
[ [ POSTPONE: foo ] ] [ "USE: temporary foo" parse ] unit-test
-IN: temporary
USING: alien io kernel lists math prettyprint sequences
test words inference namespaces vectors ;
+IN: temporary
[ "4" ] [ 4 unparse ] unit-test
[ "1.0" ] [ 1.0 unparse ] unit-test
-IN: temporary
USING: compiler inference math generic parser test ;
+IN: temporary
: foo 1 2 ;
: bar foo foo ; compiled
: test ( name -- ? )
[
"=====> " write dup write "..." print
- test-path [ [ run-resource ] keep ] assert-depth drop
+ test-path [
+ [ [ run-resource ] with-scope ] keep
+ ] assert-depth drop
] test-handler ;
: prepare-tests ( -- )
] when* ;
: (clear-gadget) ( gadget -- )
- gadget-children [
- dup [ f swap set-gadget-parent ] each 0 swap set-length
- ] when* ;
+ dup gadget-children [ f swap set-gadget-parent ] each
+ f swap set-gadget-children ;
: clear-gadget ( gadget -- )
dup (clear-gadget) relayout ;