From 731bd1c88a0efa6d6c7408a8c22a28d4c0b82e90 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 2 Sep 2008 01:52:22 -0500 Subject: [PATCH] fix ui unit tests for new accessors --- basis/ui/gadgets/buttons/buttons-tests.factor | 9 +-- basis/ui/gadgets/editors/editors-tests.factor | 5 +- basis/ui/gadgets/gadgets-tests.factor | 66 +++++++++---------- basis/ui/gadgets/grids/grids-tests.factor | 6 +- basis/ui/gadgets/panes/panes-tests.factor | 6 +- .../presentations/presentations-tests.factor | 6 +- .../gadgets/scrollers/scrollers-tests.factor | 36 +++++----- basis/ui/gadgets/worlds/worlds-tests.factor | 16 ++--- basis/ui/operations/operations-tests.factor | 4 +- basis/ui/tools/listener/listener-tests.factor | 2 +- basis/ui/tools/search/search-tests.factor | 6 +- basis/ui/tools/tools-tests.factor | 8 +-- basis/ui/traverse/traverse-tests.factor | 6 +- 13 files changed, 87 insertions(+), 89 deletions(-) diff --git a/basis/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor index 6c5d757dd4..bdd9ebaf13 100755 --- a/basis/ui/gadgets/buttons/buttons-tests.factor +++ b/basis/ui/gadgets/buttons/buttons-tests.factor @@ -1,6 +1,7 @@ -IN: ui.gadgets.buttons.tests USING: ui.commands ui.gadgets.buttons ui.gadgets.labels -ui.gadgets tools.test namespaces sequences kernel models ; +ui.gadgets tools.test namespaces sequences kernel models +accessors ; +IN: ui.gadgets.buttons.tests TUPLE: foo-gadget ; @@ -15,7 +16,7 @@ TUPLE: foo-gadget ; T{ foo-gadget } "t" set -[ 2 ] [ "t" get gadget-children length ] unit-test +[ 2 ] [ "t" get children>> length ] unit-test [ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test [ ] [ @@ -34,7 +35,7 @@ T{ foo-gadget } "t" set \ must-infer [ 0 ] [ - "religion" get gadget-child radio-control-value + "religion" get gadget-child value>> ] unit-test [ 2 ] [ diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor index 166e6c264b..274d62ea46 100755 --- a/basis/ui/gadgets/editors/editors-tests.factor +++ b/basis/ui/gadgets/editors/editors-tests.factor @@ -2,6 +2,7 @@ USING: accessors ui.gadgets.editors tools.test kernel io io.streams.plain definitions namespaces ui.gadgets ui.gadgets.grids prettyprint documents ui.gestures tools.test.ui models ; +IN: ui.gadgets.editors.tests [ "foo bar" ] [ "editor" set @@ -34,7 +35,7 @@ models ; "editor" set "editor" get [ "bar\nbaz quux" "editor" get set-editor-string - { 0 3 } "editor" get editor-caret set-model + { 0 3 } "editor" get caret>> set-model "editor" get select-word "editor" get gadget-selection ] with-grafted-gadget @@ -45,5 +46,5 @@ models ; "hello" "field" set "field" get [ - [ "hello" ] [ "field" get field-model>> model-value ] unit-test + [ "hello" ] [ "field" get field-model>> value>> ] unit-test ] with-grafted-gadget diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor index 0bce366fcc..a1602effe9 100755 --- a/basis/ui/gadgets/gadgets-tests.factor +++ b/basis/ui/gadgets/gadgets-tests.factor @@ -1,8 +1,8 @@ -IN: ui.gadgets.tests USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test namespaces models kernel dlists deques math sets math.parser ui sequences hashtables assocs io arrays prettyprint io.streams.string math.geometry.rect ; +IN: ui.gadgets.tests [ { 300 300 } ] [ @@ -14,24 +14,24 @@ io.streams.string math.geometry.rect ; "b" get "c" get swap add-gadget drop ! position a and b - { 100 200 } "a" get set-rect-loc - { 200 100 } "b" get set-rect-loc + "a" get { 100 200 } >>loc drop + "b" get { 200 100 } >>loc drop ! give c a loc, it doesn't matter - { -1000 23 } "c" get set-rect-loc + "c" get { -1000 23 } >>loc drop ! what is the location of a inside c? "a" get "c" get relative-loc ] unit-test "g1" set -{ 10 10 } "g1" get set-rect-loc -{ 30 30 } "g1" get set-rect-dim +"g1" get { 10 10 } >>loc + { 30 30 } >>dim drop "g2" set -{ 20 20 } "g2" get set-rect-loc -{ 50 500 } "g2" get set-rect-dim +"g2" get { 20 20 } >>loc + { 50 500 } >>dim drop "g3" set -{ 100 200 } "g3" get set-rect-dim +"g3" get { 100 200 } >>dim drop "g1" get "g2" get swap add-gadget drop "g2" get "g3" get swap add-gadget drop @@ -47,15 +47,15 @@ io.streams.string math.geometry.rect ; [ { 100 200 } ] [ "g3" get screen-rect rect-dim ] unit-test "g1" set -{ 300 300 } "g1" get set-rect-dim +"g1" get { 300 300 } >>dim drop "g2" set "g2" get "g1" get swap add-gadget drop -{ 20 20 } "g2" get set-rect-loc -{ 20 20 } "g2" get set-rect-dim +"g2" get { 20 20 } >>loc + { 20 20 } >>dim drop "g3" set "g3" get "g1" get swap add-gadget drop -{ 100 100 } "g3" get set-rect-loc -{ 20 20 } "g3" get set-rect-dim +"g3" get { 100 100 } >>loc + { 20 20 } >>dim drop [ t ] [ { 30 30 } "g2" get inside? ] unit-test @@ -67,8 +67,8 @@ io.streams.string math.geometry.rect ; "g4" set "g4" get "g2" get swap add-gadget drop -{ 5 5 } "g4" get set-rect-loc -{ 1 1 } "g4" get set-rect-dim +"g4" get { 5 5 } >>loc + { 1 1 } >>dim drop [ t ] [ { 25 25 } "g1" get pick-up "g4" get eq? ] unit-test @@ -78,12 +78,10 @@ TUPLE: mock-gadget < gadget graft-called ungraft-called ; mock-gadget new-gadget 0 >>graft-called 0 >>ungraft-called ; M: mock-gadget graft* - dup mock-gadget-graft-called 1+ - swap set-mock-gadget-graft-called ; + [ 1+ ] change-graft-called drop ; M: mock-gadget ungraft* - dup mock-gadget-ungraft-called 1+ - swap set-mock-gadget-ungraft-called ; + [ 1+ ] change-ungraft-called drop ; ! We can't print to output-stream here because that might be a pane ! stream, and our graft-queue rebinding here would be captured @@ -100,35 +98,35 @@ M: mock-gadget ungraft* "g" set [ ] [ "g" get queue-graft ] unit-test [ f ] [ graft-queue deque-empty? ] unit-test - [ { f t } ] [ "g" get gadget-graft-state ] unit-test + [ { f t } ] [ "g" get graft-state>> ] unit-test [ ] [ "g" get graft-later ] unit-test - [ { f t } ] [ "g" get gadget-graft-state ] unit-test + [ { f t } ] [ "g" get graft-state>> ] unit-test [ ] [ "g" get ungraft-later ] unit-test - [ { f f } ] [ "g" get gadget-graft-state ] unit-test + [ { f f } ] [ "g" get graft-state>> ] unit-test [ t ] [ graft-queue deque-empty? ] unit-test [ ] [ "g" get ungraft-later ] unit-test [ ] [ "g" get graft-later ] unit-test [ ] [ notify-queued ] unit-test - [ { t t } ] [ "g" get gadget-graft-state ] unit-test + [ { t t } ] [ "g" get graft-state>> ] unit-test [ t ] [ graft-queue deque-empty? ] unit-test [ ] [ "g" get graft-later ] unit-test - [ 1 ] [ "g" get mock-gadget-graft-called ] unit-test + [ 1 ] [ "g" get graft-called>> ] unit-test [ ] [ "g" get ungraft-later ] unit-test - [ { t f } ] [ "g" get gadget-graft-state ] unit-test + [ { t f } ] [ "g" get graft-state>> ] unit-test [ ] [ notify-queued ] unit-test - [ 1 ] [ "g" get mock-gadget-ungraft-called ] unit-test - [ { f f } ] [ "g" get gadget-graft-state ] unit-test + [ 1 ] [ "g" get ungraft-called>> ] unit-test + [ { f f } ] [ "g" get graft-state>> ] unit-test ] with-variable : add-some-children 3 [ - over over set-gadget-model + over >>model dup "g" get swap add-gadget drop swap 1+ number>string set ] each ; : status-flags - { "g" "1" "2" "3" } [ get gadget-graft-state ] map prune ; + { "g" "1" "2" "3" } [ get graft-state>> ] map prune ; : notify-combo ( ? ? -- ) nl "===== Combo: " write 2dup 2array . nl @@ -140,12 +138,12 @@ M: mock-gadget ungraft* [ V{ { f t } } ] [ status-flags ] unit-test dup [ [ ] [ notify-queued ] unit-test ] when [ ] [ "g" get clear-gadget ] unit-test - [ [ 1 ] [ graft-queue dlist-length ] unit-test ] unless + [ [ 1 ] [ graft-queue length>> ] unit-test ] unless [ [ ] [ notify-queued ] unit-test ] when [ ] [ add-some-children ] unit-test - [ { f t } ] [ "1" get gadget-graft-state ] unit-test - [ { f t } ] [ "2" get gadget-graft-state ] unit-test - [ { f t } ] [ "3" get gadget-graft-state ] unit-test + [ { f t } ] [ "1" get graft-state>> ] unit-test + [ { f t } ] [ "2" get graft-state>> ] unit-test + [ { f t } ] [ "3" get graft-state>> ] unit-test [ ] [ graft-queue [ "x" print notify ] slurp-deque ] unit-test [ ] [ notify-queued ] unit-test [ V{ { t t } } ] [ status-flags ] unit-test diff --git a/basis/ui/gadgets/grids/grids-tests.factor b/basis/ui/gadgets/grids/grids-tests.factor index cfca5d5a93..9015b7ec1b 100644 --- a/basis/ui/gadgets/grids/grids-tests.factor +++ b/basis/ui/gadgets/grids/grids-tests.factor @@ -1,10 +1,10 @@ USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays -namespaces math.geometry.rect ; +namespaces math.geometry.rect accessors ; IN: ui.gadgets.grids.tests [ { 0 0 } ] [ { } pref-dim ] unit-test -: 100x100 { 100 100 } over set-rect-dim ; +: 100x100 { 100 100 } >>dim ; [ { 100 100 } ] [ 100x100 @@ -38,7 +38,7 @@ IN: ui.gadgets.grids.tests 100x100 dup "a" set 100x100 dup "b" set 2array 1array - { 10 10 } over set-grid-gap + { 10 10 } >>gap dup prefer dup layout rect-dim diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index fd1ee0f573..64a72fe523 100755 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -1,11 +1,11 @@ -IN: ui.gadgets.panes.tests USING: alien ui.gadgets.panes ui.gadgets namespaces kernel sequences io io.styles io.streams.string tools.test prettyprint definitions help help.syntax help.markup help.stylesheet splitting tools.test.ui models math summary -inspector ; +inspector accessors ; +IN: ui.gadgets.panes.tests -: #children "pane" get gadget-children length ; +: #children "pane" get children>> length ; [ ] [ "pane" set ] unit-test diff --git a/basis/ui/gadgets/presentations/presentations-tests.factor b/basis/ui/gadgets/presentations/presentations-tests.factor index fcbc65725a..358bf2b791 100644 --- a/basis/ui/gadgets/presentations/presentations-tests.factor +++ b/basis/ui/gadgets/presentations/presentations-tests.factor @@ -1,7 +1,7 @@ -IN: ui.gadgets.presentations.tests USING: math ui.gadgets.presentations ui.gadgets tools.test prettyprint ui.gadgets.buttons io io.streams.string kernel -classes.tuple ; +classes.tuple accessors ; +IN: ui.gadgets.presentations.tests [ t ] [ "Hi" \ + gadget? @@ -9,6 +9,6 @@ classes.tuple ; [ "+" ] [ [ - \ + f \ pprint dup button-quot call + \ + f \ pprint dup quot>> call ] with-string-writer ] unit-test diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor index fb3e6cec23..48251c4927 100755 --- a/basis/ui/gadgets/scrollers/scrollers-tests.factor +++ b/basis/ui/gadgets/scrollers/scrollers-tests.factor @@ -1,9 +1,9 @@ -IN: ui.gadgets.scrollers.tests USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test kernel models models.compose models.range ui.gadgets.viewports ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames ui.gadgets.sliders math math.vectors arrays sequences -tools.test.ui math.geometry.rect ; +tools.test.ui math.geometry.rect accessors ; +IN: ui.gadgets.scrollers.tests [ ] [ "g" set @@ -12,11 +12,11 @@ tools.test.ui math.geometry.rect ; [ { 100 200 } ] [ { 100 200 } "g" get scroll>rect - "s" get scroller-follows rect-loc + "s" get follows>> rect-loc ] unit-test [ ] [ "s" get scroll>bottom ] unit-test -[ t ] [ "s" get scroller-follows ] unit-test +[ t ] [ "s" get follows>> ] unit-test [ ] [ dup "g" set @@ -25,46 +25,46 @@ tools.test.ui math.geometry.rect ; ] unit-test "v" get [ - [ { 10 20 } ] [ "v" get gadget-model range-value ] unit-test + [ { 10 20 } ] [ "v" get model>> range-value ] unit-test [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test ] with-grafted-gadget [ ] [ - { 100 100 } over set-rect-dim + { 100 100 } >>dim dup "g" set "s" set ] unit-test -[ ] [ { 50 50 } "s" get set-rect-dim ] unit-test +[ ] [ "s" get { 50 50 } >>dim drop ] unit-test [ ] [ "s" get layout ] unit-test "s" get [ - [ { 34 34 } ] [ "s" get scroller-viewport rect-dim ] unit-test + [ { 34 34 } ] [ "s" get viewport>> rect-dim ] unit-test - [ { 106 106 } ] [ "s" get scroller-viewport viewport-dim ] unit-test + [ { 106 106 } ] [ "s" get viewport>> viewport-dim ] unit-test [ ] [ { 0 0 } "s" get scroll ] unit-test - [ { 0 0 } ] [ "s" get gadget-model range-min-value ] unit-test + [ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test - [ { 106 106 } ] [ "s" get gadget-model range-max-value ] unit-test + [ { 106 106 } ] [ "s" get model>> range-max-value ] unit-test [ ] [ { 10 20 } "s" get scroll ] unit-test - [ { 10 20 } ] [ "s" get gadget-model range-value ] unit-test + [ { 10 20 } ] [ "s" get model>> range-value ] unit-test - [ { 10 20 } ] [ "s" get scroller-viewport gadget-model range-value ] unit-test + [ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test ] with-grafted-gadget - { 600 400 } over set-rect-dim "g1" set - { 600 10 } over set-rect-dim "g2" set + { 600 400 } >>dim "g1" set + { 600 10 } >>dim "g2" set "g2" get "g1" get swap add-gadget drop "g1" get -{ 300 300 } over set-rect-dim +{ 300 300 } >>dim dup layout "s" set @@ -80,9 +80,9 @@ dup layout [ ] [ "Hi"