test-rope.ss
(module test-rope mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "util.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "comprehensions.ss" ("dyoo" "srfi-alias.plt" 1))
           (lib "etc.ss")
           (lib "list.ss")
           
           "rope.ss")
  
  (require/expose "rope.ss" (make-rope:concat))
  (define (++ x y)
    (make-rope:concat x y (+ (rope-length x) (rope-length y))))
  
  
  (define (make-long-degenerate-rope)
    (define my-rope "")
    (do-ec (:range i 5000)
           (set! my-rope (++ my-rope (format "hello~a" i))))
    my-rope)
  
  
  
  (define (read-file-as-rope filename)
    (call-with-input-file filename
      (lambda (ip)
        (let loop ([char (read-char ip)]
                   [a-rope ""])
          (cond [(eof-object? char)
                 a-rope]
                [else
                 (loop (read-char ip)
                       (rope-append a-rope (string char)))])))))
  
  (provide rope-tests)
  (define rope-tests
    (test-suite
     "rope.ss"
     (test-case
      "rope?"
      (check-true (rope? "is this a rope?"))
      (check-true (rope? (rope-append "hello " "world"))))
     
     (test-case
      "rope-append"
      (check-equal? (rope->string (rope-append "" "abcd"))
                    (rope->string (rope-append "abcd" ""))))
     
     (test-case
      "subrope checking bounds"
      (local ((define myrope (make-long-degenerate-rope)))
        (check-equal? (rope->string
                      (subrope myrope 0 18))
                     "hello0hello1hello2")
        (check-equal? (rope->string
                       (subrope myrope 1 18))
                      "ello0hello1hello2")
        (check-equal? (rope->string
                       (subrope myrope 3 18))
                      "lo0hello1hello2")
        (check-equal? (rope->string
                       (subrope myrope 6 18))
                      "hello1hello2")
        (check-equal? (rope->string
                       (subrope myrope 6 15))
                      "hello1hel")
        (check-equal? (rope->string
                       (subrope myrope 17 30))
                      "2hello3hello4")
        (check-equal? (rope->string
                       (subrope myrope 17 31))
                      "2hello3hello4h")))
     
     (test-case
      "balance"
      (parameterize ([current-optimize-flat-ropes #f])
        (check-equal? "abcdef"
                      (rope->string
                       (rope-balance (++ "a" (++ "bc" (++ "d" "ef"))))))
        (check-equal? (rope-depth
                       (rope-balance (++ "a" (++ "bc" (++ "d" "ef")))))
                      2)))
     
     (test-case
      "rope-fold/leaves"
      (parameterize ([current-optimize-flat-ropes #f])
        (check-equal? (rope-fold/leaves (lambda (a-str acc)
                                          (cons a-str acc))
                                        '()
                                        (++ "hello" "world"))
                      (list "world" "hello"))))
     
     
     (test-case
      "rope-fold"
      (parameterize ([current-optimize-flat-ropes #f])
        (check-equal? (rope-fold (lambda (a-str acc)
                                   (cons a-str acc))
                                 '()
                                 (++ "hello" "world"))
                      (reverse (list #\h #\e #\l #\l #\o #\w #\o #\r #\l #\d)))))
     
     
     (test-case
      "open-input-rope"
      (parameterize ([current-optimize-flat-ropes #f])
        (check-equal?
         (regexp-match
          "abracadabra"
          (open-input-rope (++ "a" (++ "braca" (++ (++ "da" "br") "a")))))
         '(#"abracadabra"))))
     
     
     (test-case
      "rope-depth and balancing"
      (parameterize ([current-optimize-flat-ropes #f])
        (check-equal? (rope-depth (rope-balance (++ "h0" "h1")))
                      1)
        (check-equal? (rope-depth (rope-balance (++ "h0" (++ "h1" "h2"))))
                      2)
        (check-equal? (rope-depth (rope-balance (++ "h0" (++ "h1" (++ "h2" "h3")))))
                      2)
        (check-equal? (rope-depth
                       (rope-balance
                        (++ "h0" (++ "h1" (++ "h2" (++ "h3" "h4"))))))
                      3)
        (check-equal? (rope-depth
                       (rope-balance
                        (++ "h0" (++ "h1" (++ "h2" (++ "h3" (++ "h4" "h5")))))))
                      3)))
     
     
     (test-case
      "rope-ref"
      (parameterize ([current-optimize-flat-ropes #f])
        (local ((define word-rope (++
                                   (++ (++ "super" "cali") (++ "fragil" "istic"))
                                   (++ "expiali" "docious")))
                (define word-string "supercalifragilisticexpialidocious"))
          (for-each (lambda (i ch)
                      (check-equal? (rope-ref word-rope i) ch))
                    (build-list (string-length word-string) (lambda (i) i))
                    (string->list word-string)))))))
  
  
  (test/text-ui rope-tests))