From 560ff92c719dd0c4b60edd0d65f612be6ffc5af8 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 16 May 2010 16:59:08 -0400 Subject: [PATCH] Some renames for this dusty code. original commit: d8fec78585aac51145b12cf486a38d53375e8c21 --- .../tests/actual-bigger.rktl | 38 +++ .../tests/edit-sequence-loop.rkt | 16 -- .../tests/insertion-without-display.rkt | 4 - .../tests/test-alignment.rkt | 251 ------------------ .../tests/test-pasteboard-lib.rkt | 207 --------------- .../tests/test-snip-lib.rkt | 208 --------------- .../private/aligned-pasteboard/tests/test.rkt | 231 ---------------- .../aligned-pasteboard/tests/test2.rkt | 189 ------------- 8 files changed, 38 insertions(+), 1106 deletions(-) create mode 100644 collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/test.rkt delete mode 100644 collects/mrlib/private/aligned-pasteboard/tests/test2.rkt diff --git a/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl b/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl new file mode 100644 index 00000000..e707ade6 --- /dev/null +++ b/collects/mrlib/private/aligned-pasteboard/tests/actual-bigger.rktl @@ -0,0 +1,38 @@ +(require + mzlib/class + mzlib/list + mred + mzlib/etc + "../aligned-editor-container.ss" + "../aligned-pasteboard.ss" + "../snip-lib.ss") + +(define f (new frame% (label "test") (width 200) (height 200))) +(define e (new text%)) +(define c (new editor-canvas% (editor e) (parent f))) + +(define vpb1 (new vertical-pasteboard%)) +(define aes1 (new aligned-editor-snip% (editor vpb1))) + +(define vpb2 (new vertical-pasteboard%)) +(define aes2 (new aligned-editor-snip% (editor vpb2))) + +(define t (new text%)) +(define es (new editor-snip% (editor t))) + +(send vpb1 insert aes2 false) +(send vpb2 insert es) +(send e insert aes1) +(send f show #t) +(send f show #f) + +(send t begin-edit-sequence) +(send e begin-edit-sequence) +(send t insert "1\n") +(send t insert "1") +(send e end-edit-sequence) +(send t end-edit-sequence) + +(>= (send vpb1 get-aligned-min-height) + (send vpb2 get-aligned-min-height) + (snip-height es)) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt b/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt deleted file mode 100644 index 20f31075..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/edit-sequence-loop.rkt +++ /dev/null @@ -1,16 +0,0 @@ -(require - "../aligned-pasteboard.ss" - "../aligned-editor-container.ss") - -(define (converges? x) #t) - -(converges? - (let* ((f (new frame% (label "test"))) - (e (new text%)) - (c (new editor-canvas% (editor e) (parent f))) - (pb (new vertical-pasteboard%)) - (actual (new text%)) - (act-line (new aligned-editor-snip% (editor (new vertical-pasteboard%)))) - (t (new aligned-editor-snip% (editor pb)))) - (send e insert t) - (send* pb (begin-edit-sequence) (insert act-line #f) (end-edit-sequence)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt b/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt deleted file mode 100644 index b4a5a80c..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/insertion-without-display.rkt +++ /dev/null @@ -1,4 +0,0 @@ -(require mrlib/aligned-pasteboard) -(with-handlers ([exn? (lambda (x) #f)]) - (send (new pasteboard%) insert (new aligned-editor-snip% (editor (new horizontal-pasteboard%)))) - #t) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt deleted file mode 100644 index 9fff4e38..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-alignment.rkt +++ /dev/null @@ -1,251 +0,0 @@ - -(require - mzlib/etc - mzlib/list - mzlib/match - "../alignment.ss" - "test-macro.ss") - -;;los-equal? ((listof rect?) (listof rect?) . -> . boolean?) -;;tests the equality of the list of structures -(define (los-equal? a b) - (equal? - (map rect->list a) - (map rect->list b))) - -;;rect->list (rect? . -> . vector?) -;;a vector of the fields in the rect -(define rect->list - (match-lambda - [($ rect ($ dim x width stretchable-width?) ($ dim y height stretchable-height?)) - (list x width stretchable-width? y height stretchable-height?)])) - -;;empty pasteboard -(test - los-equal? - (align 'vertical 100 100 empty) - empty) - -;;empty pasteboard -(test - los-equal? - (align 'horizontal 100 100 empty) - empty) - -;;one unstretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -(test - los-equal? - (align 'horizontal - 100 100 - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 10 false) - (make-dim 0 10 false)))) - -;;one stretchable snip -(test - los-equal? - (align 'vertical - 100 100 - (list (make-rect (make-dim 0 10 true) - (make-dim 0 10 true)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 100 true)))) - -;;two stretchable snips -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 5 true)) - (make-rect (make-dim 0 10 true) - (make-dim 5 5 true)))) - -;;three stretchable, one too big -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 25 true)) - (make-rect (make-dim 0 50 true) - (make-dim 75 25 true)))) - -;;three stetchable, one too big, and an unstetchable -(test - los-equal? - (align 'vertical - 50 100 - (list (make-rect (make-dim 0 0 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 50 false) - (make-dim 0 10 false)))) - (list (make-rect (make-dim 0 50 true) - (make-dim 0 50 true)) - (make-rect (make-dim 0 50 true) - (make-dim 50 20 true)) - (make-rect (make-dim 0 50 true) - (make-dim 70 20 true)) - (make-rect (make-dim 0 50 false) - (make-dim 90 10 false)))) - -;;failure from test-suite frame -;;wrong answer given was (list (make-rect 0 0 335.0 10 #t)) -(test - los-equal? - (align 'vertical - 335.0 - 563.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)))) - (list (make-rect (make-dim 0 335.0 true) - (make-dim 0 563.0 true)))) - -;;sort of like the previous failed test but with a nonsizable snip -(test - los-equal? - (align 'vertical - 563.0 - 335.0 - (list - (make-rect (make-dim 0 10.0 #t) - (make-dim 0 10.0 #t)) - (make-rect (make-dim 0 10.0 false) - (make-dim 0 10.0 false)))) - (list (make-rect (make-dim 0 563.0 true) - (make-dim 0 325.0 true)) - (make-rect (make-dim 0 10.0 false) - (make-dim 325.0 10.0 false)))) - -;;something that requires a little modulo in division -(test - los-equal? - (align 'vertical - 10 - 10 - (list - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)) - (make-rect (make-dim 0 0 true) - (make-dim 0 0 true)))) - (list (make-rect (make-dim 0 10 true) - (make-dim 0 4 true)) - (make-rect (make-dim 0 10 true) - (make-dim 4 3 true)) - (make-rect (make-dim 0 10 true) - (make-dim 7 3 true)))) - -;; 1 snip only stretches in off dimention -(test - los-equal? - (align 'vertical - 100 - 400 - (list - (make-rect (make-dim 0 10 true) - (make-dim 0 30 false)))) - (list (make-rect (make-dim 0 100 true) - (make-dim 0 30 false)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following examples of usage were taken from the test-suite tool and turned into test cases ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(test - los-equal? - (align 'vertical 563.0 335.0 (list)) - empty) - -(test - los-equal? - (align 'vertical 563.0 335.0 - (list (make-rect (make-dim 0 241 #t) (make-dim 0 114 #f)))) - (list (make-rect (make-dim 0 563.0 #t) (make-dim 0 114 #f)))) - -(test - los-equal? - (align 'vertical 551.0 102.0 - (list (make-rect (make-dim 0 34 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 231 #t) (make-dim 0 57 #t)))) - (list (make-rect (make-dim 0 551.0 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 551.0 #t) (make-dim 47 57 #t)))) - -(test - los-equal? - (align 'vertical 539.0 35.0 - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list (make-rect (make-dim 0 24 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 13 24 #f)))) - -(test - los-equal? - (align 'horizontal 539.0 45.0 - (list (make-rect (make-dim 0 65 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 48 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 63 #t) (make-dim 0 47 #t)) - (make-rect (make-dim 0 45 #f) (make-dim 0 44 #f)))) - (list - (make-rect (make-dim 0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 165.0 165.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 330.0 164.0 true) (make-dim 0 45.0 true)) - (make-rect (make-dim 494.0 45 false) (make-dim 0 44 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 55 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 55 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 153.0 33.0 - (list (make-rect (make-dim 0 38 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 11 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 38 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 11 false) (make-dim 13 24 false)))) - -(test - los-equal? - (align 'vertical 152.0 33.0 - (list (make-rect (make-dim 0 26 #f) (make-dim 0 13 #f)) - (make-rect (make-dim 0 53 #f) (make-dim 0 24 #f)))) - (list - (make-rect (make-dim 0 26 false) (make-dim 0 13 false)) - (make-rect (make-dim 0 53 false) (make-dim 13 24 false)))) diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt deleted file mode 100644 index 95c56209..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-pasteboard-lib.rkt +++ /dev/null @@ -1,207 +0,0 @@ - -(require - mzlib/etc - mzlib/class - "test-macro.ss" - mred - "../pasteboard-lib.ss" - "../aligned-pasteboard.ss" - "../aligned-editor-container.ss") - -;; (printf "running tests for pasteboard-lib.ss~n") - -;;pasteboard-root: ((is-a?/c aligned-pasteboard<%>) -> (is-a?/c aligned-pasteboard<%>)) -;;gets the top most aligned pasteboard in the tree of pasteboards and containers - -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate vertical-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - - (send pb1 insert es2) - (send pb2 insert es3) - - (test - equal? - (pasteboard-root pb3) - pb1) - - (test - equal? - (pasteboard-root pb2) - pb1) - - (test - equal? - (pasteboard-root pb1) - pb1) - ) - -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate vertical-pasteboard% ())] - [es1 (instantiate aligned-editor-snip% () (editor pb1))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))]) - - (send pb2 insert es1) - (send pb2 insert es3) - - (test - equal? - (pasteboard-root pb3) - pb2) - - (test - equal? - (pasteboard-root pb2) - pb2) - - (test - equal? - (pasteboard-root pb1) - pb2) - ) - -;;pasteboard-parent: ((is-a?/c pasteboard%) . -> . (is-a?/c aligned-editor-container<%>)) -;;gets the canvas or snip that the pasteboard is displayed in -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate vertical-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - - (send pb1 insert es2) - (send pb2 insert es3) - - (test - equal? - (pasteboard-parent pb1) - canvas) - - (test - equal? - (pasteboard-parent pb2) - es2) - - (test - equal? - (pasteboard-parent pb3) - es3) - ) - -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate vertical-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - - (send pb1 insert es2) - (send pb1 insert es3) - - (test - equal? - (pasteboard-parent pb1) - canvas) - - (test - equal? - (pasteboard-parent pb2) - es2) - - (test - equal? - (pasteboard-parent pb3) - es3) - ) - -#| -;;num-sizeable: ((is-a?/c aligned-pasteboard<%>) . -> . number?) -;;the number of snips in the pasteboard that can be resized -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (test - = - (num-sizeable pb1) - 0) - - (send pb1 delete es1) - - (test - = - (num-sizeable pb1) - 0) - - (send frame show false) - ) - -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es2 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es3 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - [es4 (instantiate aligned-editor-snip% () (editor (instantiate vertical-pasteboard% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (test - = - (num-sizeable pb1) - 4) - - (send pb1 delete es1) - - (test - = - (num-sizeable pb1) - 3) - - (send pb1 erase) - - (test - = - (num-sizeable pb1) - 0) - - (send frame show false) - ) - -(printf "tests done~n") -|# diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt deleted file mode 100644 index 8d1bc282..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test-snip-lib.rkt +++ /dev/null @@ -1,208 +0,0 @@ - -(require - mzlib/etc - mzlib/class - mred - "../snip-lib.ss" - "../aligned-pasteboard.ss" - "../aligned-editor-container.ss" - "test-macro.ss") - -;;(printf "running tests for snip-lib.ss~n") - -;;snip-width: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) -;;the width of a snip in the given pasteboard -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test - equal? - (snip-width #;pb2 es1) - 20.0) - - (send es1 resize 200 90) - (sleep/yield 1) - (test - equal? - (snip-width #;pb2 es1) - 200.0) - - (send frame show false) - ) - -;;snip-height: ((is-a?/c aligned-pasteboard<%>) (is-a?/c snip%) . -> . number?) -;;the height of a snip in the given pasteboard -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate vertical-pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - (send es1 resize 20 20) - (sleep/yield 1) - (test - equal? - (snip-height #;pb2 es1) - 20.0) - - (send es1 resize 200 90) - (sleep/yield 1) - (test - equal? - (snip-height #;pb2 es1) - 90.0) - - (send frame show false) - ) - -;;snip-min-width: ((is-a?/c snip%) . -> . number?) -;;the minimum width of the snip - -;;snip-min-height: ((is-a?/c snip%) . -> . number?) -;;the minimum height of the snip - -;;snip-parent: ((is-a?/c snip%) . -> . (is-a?/c editor<%>)) -;;the pasteboard that contains the snip -(let* - ([pb1 (instantiate pasteboard% ())] - [es1 (instantiate editor-snip% () (editor pb1))] - [pb2 (instantiate pasteboard% ())] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate editor-canvas% () (parent frame) (editor pb2))]) - (send frame show true) - - (send pb2 insert es1) - - (test - equal? - (snip-parent es1) - pb2) - - (send frame show false) - ) - -(let* - ([pb1 (instantiate horizontal-pasteboard% ())] - [pb2 (instantiate horizontal-pasteboard% ())] - [pb3 (instantiate horizontal-pasteboard% ())] - [pb4 (instantiate horizontal-pasteboard% ())] - [pb5 (instantiate horizontal-pasteboard% ())] - [es2 (instantiate aligned-editor-snip% () (editor pb2))] - [es3 (instantiate aligned-editor-snip% () (editor pb3))] - [es4 (instantiate aligned-editor-snip% () (editor pb4))] - [es5 (instantiate aligned-editor-snip% () (editor pb5))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - (send pb1 insert es2) - (send pb2 insert es3) - (send pb3 insert es4) - (send pb4 insert es5) - - (test - equal? - (snip-parent es2) - pb1) - - (test - equal? - (snip-parent es3) - pb2) - - (test - equal? - (snip-parent es4) - pb3) - - (test - equal? - (snip-parent es5) - pb4) - - (send frame show false) - ) - -;;fold-snip: (lambda (b?) ((any? b? . -> . b?) b? (is-a?/c snip%) . -> . b?)) -;;the application of f on all snips from snip to the end in a foldl foldr mannor -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (send es1 resize 100 100) - (send es2 resize 100 100) - (send es3 resize 100 100) - (send es4 resize 100 100) - - (test - = - (fold-snip - (lambda (snip total-height) - (+ (snip-height #;pb1 snip) - total-height)) - 0 - es1) - 400) - - (send frame show false) - ) - - -;;for-each-snip: (((is-a?/c snip%) . -> . (void)) (is-a/c? snip%) . -> . (void)) -;;applies the function to all the snips -(let* - ([pb1 (instantiate vertical-pasteboard% ())] - [es1 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es2 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es3 (instantiate editor-snip% () (editor (instantiate text% ())))] - [es4 (instantiate editor-snip% () (editor (instantiate text% ())))] - - [frame (instantiate frame% () (label "l") (width 10) (height 10))] - [canvas (instantiate aligned-editor-canvas% () (parent frame) (editor pb1))] - [count 0]) - (send frame show true) - - (send pb1 insert es1) - (send pb1 insert es2) - (send pb1 insert es3) - (send pb1 insert es4) - - (for-each-snip - (lambda (snip) - (set! count (add1 count))) - es1) - - (test - = - count - 4) - - (send frame show false) - ) -;;(printf "tests done~n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test.rkt deleted file mode 100644 index 010479b3..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test.rkt +++ /dev/null @@ -1,231 +0,0 @@ -(require - mzlib/class - mred - mzlib/etc - mzlib/list - "../aligned-pasteboard.ss" - "../aligned-editor-container.ss" - "snip-dumper.ss") - - - -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; - -(printf "running test1.ss~n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define insider - (instantiate vertical-pasteboard% ())) - -(define insider2 - (instantiate vertical-pasteboard% ())) - -(define insider3 - (instantiate vertical-pasteboard% ())) - -(define insider4 - (instantiate vertical-pasteboard% ())) - -(define insider5 - (instantiate vertical-pasteboard% ())) - -(define insider6 - (instantiate vertical-pasteboard% ())) - -(define insider7 - (instantiate vertical-pasteboard% ())) - -(define pb-snip - (instantiate aligned-editor-snip% () - (editor insider))) - -(define pb-snip2 - (instantiate aligned-editor-snip% () - (editor insider2))) - -(define pb-snip3 - (instantiate aligned-editor-snip% () - (editor insider3))) - -(define pb-snip4 - (instantiate aligned-editor-snip% () - (editor insider4))) - -(define pb-snip5 - (instantiate aligned-editor-snip% () - (editor insider5))) - -(define pb-snip6 - (instantiate aligned-editor-snip% () - (editor insider6))) - -(define pb-snip7 - (instantiate aligned-editor-snip% () - (editor insider7))) - -(define t-snip - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(define i-snip - (instantiate image-snip% ())) - -(define i-snip2 - (instantiate image-snip% ())) - -(define t-snip2 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) -(define t-snip3 - (instantiate editor-snip% () - (editor - (instantiate text% ())))) - -(send pasteboard begin-edit-sequence) -(send frame show true) -(send pasteboard insert pb-snip) -(send pasteboard insert t-snip) -(send pasteboard insert i-snip) -(send pasteboard insert i-snip2) -(send pasteboard insert pb-snip2) -(send pasteboard insert t-snip2) -(send insider insert t-snip3) -(send insider2 insert pb-snip3) -(send insider2 insert pb-snip4) -(send pasteboard insert pb-snip5) -(send pasteboard insert pb-snip6) -(send pasteboard insert pb-snip7) -(send pasteboard end-edit-sequence) - - - - -; ; ; -; ; ; -;;;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; - - - - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 57.0 368.0 0.0 0.0 empty) - (make-snip-dump 114.0 368.0 57.0 0.0 empty) - (make-snip-dump 171.0 368.0 114.0 0.0 empty) - (make-snip-dump 182.0 24.0 171.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 182.0 - 0.0 - (list (make-snip-dump 55.0 178.0 0.0 0.0 empty) (make-snip-dump 55.0 356.0 0.0 178.0 empty))) - (make-snip-dump 269.0 20.0 249.0 0.0 false) - (make-snip-dump 289.0 20.0 269.0 0.0 false) - (make-snip-dump 300.0 24.0 289.0 0.0 empty) - (make-snip-dump 368.0 368.0 300.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 0 0) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 34.0 0.0 0.0 empty) - (make-snip-dump 20.0 34.0 10.0 0.0 empty) - (make-snip-dump 30.0 34.0 20.0 0.0 empty) - (make-snip-dump 41.0 24.0 30.0 0.0 empty) - (make-snip-dump - 61.0 - 34.0 - 41.0 - 0.0 - (list (make-snip-dump 10.0 11.0 0.0 0.0 empty) (make-snip-dump 10.0 22.0 0.0 11.0 empty))) - (make-snip-dump 81.0 20.0 61.0 0.0 false) - (make-snip-dump 101.0 20.0 81.0 0.0 false) - (make-snip-dump 112.0 24.0 101.0 0.0 empty) - (make-snip-dump 133.0 34.0 112.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 800 600) -(sleep/yield 1) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 137.0 568.0 0.0 0.0 empty) - (make-snip-dump 274.0 568.0 137.0 0.0 empty) - (make-snip-dump 411.0 568.0 274.0 0.0 empty) - (make-snip-dump 422.0 24.0 411.0 0.0 empty) - (make-snip-dump - 569.0 - 568.0 - 422.0 - 0.0 - (list (make-snip-dump 135.0 278.0 0.0 0.0 empty) (make-snip-dump 135.0 556.0 0.0 278.0 empty))) - (make-snip-dump 589.0 20.0 569.0 0.0 false) - (make-snip-dump 609.0 20.0 589.0 0.0 false) - (make-snip-dump 620.0 24.0 609.0 0.0 empty) - (make-snip-dump 768.0 568.0 620.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send frame resize 400 400) -(send pasteboard delete i-snip) -(send pasteboard delete i-snip2) - -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 65.0 368.0 0.0 0.0 empty) - (make-snip-dump 130.0 368.0 65.0 0.0 empty) - (make-snip-dump 195.0 368.0 130.0 0.0 empty) - (make-snip-dump 206.0 24.0 195.0 0.0 empty) - (make-snip-dump - 281.0 - 368.0 - 206.0 - 0.0 - (list (make-snip-dump 63.0 178.0 0.0 0.0 empty) (make-snip-dump 63.0 356.0 0.0 178.0 empty))) - (make-snip-dump 292.0 24.0 281.0 0.0 empty) - (make-snip-dump 368.0 368.0 292.0 0.0 (list (make-snip-dump 11.0 24.0 0.0 0.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done~n") diff --git a/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt b/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt deleted file mode 100644 index 10151a47..00000000 --- a/collects/mrlib/private/aligned-pasteboard/tests/test2.rkt +++ /dev/null @@ -1,189 +0,0 @@ -(require - mzlib/class - mred - mzlib/etc - mzlib/list - "../aligned-pasteboard.ss" - "../aligned-editor-container.ss" - "snip-dumper.ss") - -; -; -; ;; -; ; -; ; -; ;;;;; ;; ;; ;;;;;;;;;;;;;; ;;; ; ;;;;; ;;;; -; ; ; ;;;; ; ; ; ; ;; ;; ; ; ; ; ; -; ;;;;;; ;; ;;;; ; ; ; ; ; ; ;;;;;; ;;;; -; ; ;; ; ; ; ; ; ; ; ; ; ; -; ;; ; ; ; ; ; ; ; ; ;; ;; ; ;; ; ; ; -; ;;;; ;; ;; ;;;;;;; ;; ;;; ;;; ;;;;; ;;;; ;;;; -; ; -; ;;; -; - -(printf "running test2.ss~n") - -(define frame - (instantiate frame% () - (label "Frame") - (width 400) - (height 400))) - -(define pasteboard - (instantiate horizontal-pasteboard% ())) - -(define canvas - (instantiate aligned-editor-canvas% () - (parent frame) - (editor pasteboard))) - -(define vp1 - (instantiate vertical-pasteboard% ())) - -(define ae-snip1 - (instantiate aligned-editor-snip% () - (editor vp1))) - -(define vp2 - (instantiate vertical-pasteboard% ())) - -(define ae-snip2 - (instantiate aligned-editor-snip% () - (editor vp2))) - -(define vp3 - (instantiate vertical-pasteboard% ())) - -(define ae-snip3 - (instantiate aligned-editor-snip% () - (editor vp3))) - -(define vp4 - (instantiate vertical-pasteboard% ())) - -(define ae-snip4 - (instantiate aligned-editor-snip% () - (editor vp4))) - -(define vp5 - (instantiate vertical-pasteboard% ())) - -(define ae-snip5 - (instantiate aligned-editor-snip% () - (editor vp5))) - -(send pasteboard insert ae-snip1) -(send pasteboard insert ae-snip2) -(send pasteboard insert ae-snip5) -(send vp2 insert ae-snip3) -(send vp2 insert ae-snip4) -(send frame show true) - -; -; -; -; ; ; -; ; ; -; ;;;;; ;;;;; ;;;; ;;;;; ;;;; -; ; ; ; ; ; ; ; ; -; ; ;;;;;; ;;;; ; ;;;; -; ; ; ; ; ; -; ; ;; ; ; ; ; ; ; -; ;;;;; ;;;; ;;;; ;;;;; ;;;; -; -; -; - -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 120.0 368.0 0.0 0.0 empty) - (make-snip-dump - 249.0 - 368.0 - 120.0 - 0.0 - (list (make-snip-dump 117.0 178.0 0.0 0.0 empty) (make-snip-dump 117.0 356.0 0.0 178.0 empty))) - (make-snip-dump 368.0 368.0 249.0 0.0 empty)) - ) - -(send frame resize 0 0) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 10.0 30.0 0.0 0.0 empty) - (make-snip-dump - 30.0 - 30.0 - 10.0 - 0.0 - (list (make-snip-dump 10.0 10.0 0.0 0.0 empty) (make-snip-dump 10.0 19.0 0.0 9.0 empty))) - (make-snip-dump 40.0 30.0 30.0 0.0 empty)) - ) - -(send frame resize 800 600) -(sleep/yield 1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 389.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 377.0 278.0 0.0 0.0 empty) (make-snip-dump 377.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 389.0 0.0 empty)) - ) - -(send pasteboard insert ae-snip5) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump 253.0 568.0 0.0 0.0 empty) - (make-snip-dump - 516.0 - 568.0 - 253.0 - 0.0 - (list (make-snip-dump 251.0 278.0 0.0 0.0 empty) (make-snip-dump 251.0 556.0 0.0 278.0 empty))) - (make-snip-dump 768.0 568.0 516.0 0.0 empty)) - ) - -(send pasteboard delete ae-snip5) -(send pasteboard delete ae-snip1) -(dump=? - (dump-children pasteboard) - (list - (make-snip-dump - 768.0 - 568.0 - 0.0 - 0.0 - (list (make-snip-dump 756.0 278.0 0.0 0.0 empty) (make-snip-dump 756.0 556.0 0.0 278.0 empty)))) - ) - -(send pasteboard erase) -(dump=? - (dump-children pasteboard) - empty - ) - -(send frame show false) -(printf "done~n")