;;
;; testing text.* module
;;

(use gauche.test)
(test-start "text utilities")

;;-------------------------------------------------------------------
(test-section "csv")
(use text.csv)
(test-module 'text.csv)

(test* "csv-reader" '("abc" "def" "" "ghi")
       (call-with-input-string "abc  ,  def  ,, ghi  "
         (make-csv-reader #\,)))

(test* "csv-reader (trim, parameter)" '("abc" "def" "" "ghi")
       (parameterize ([csv-trim-unquoted-charset #[_]])
         (call-with-input-string "abc__,__def__,,_ghi__"
           (make-csv-reader #\,))))

(test* "csv-reader (do not trim)" '("abc  " "  def  " "" " ghi  ")
       (call-with-input-string "abc  ,  def  ,, ghi  "
         (make-csv-reader #\, #\" #f)))

(test* "csv-reader" '("abc" "def" "" ", ghi")
       (call-with-input-string "abc  :  def  :: , ghi  "
         (make-csv-reader #\:)))

(test* "csv-reader" '("abc" "def" "ghi")
       (call-with-input-string "abc  ,  \"def\"  , \"ghi\"  "
         (make-csv-reader #\,)))

(test* "csv-reader" '("abc" " de,f " "gh\ni" "jkl")
       (call-with-input-string "   abc,  \" de,f \"  , \"gh\ni\", \"jkl\""
         (make-csv-reader #\,)))

(test* "csv-reader (do not allow extra spaces w/o trimming)"
       (test-error <error> #/quote char in a field/)
       (parameterize ([csv-trim-unquoted-charset #f])
         (call-with-input-string "abc  ,  \"def\"  , \"ghi\"  "
           (make-csv-reader #\,))))

(test* "csv-reader" '("ab\nc" "de \n\n \nf " "" "" "gh\"\n\"i")
       (call-with-input-string "   \"ab\nc\" ,  \"de \n\n \nf \"  ,  , \"\" , \"gh\"\"\n\"\"i\""
         (make-csv-reader #\,)))

(test* "csv-reader" '(("" "") ("a" "") ("" "b"))
       (let1 r (make-csv-reader #\,)
         (call-with-input-string ",\na,  \n  ,b"
           (^p (let* ([a (r p)] [b (r p)] [c (r p)] [d (r p)])
                 (and (eof-object? d)
                      (list a b c)))))))

(test* "csv-reader" (test-error)
       (call-with-input-string " abc,  def , \"ghi\"\"\n\n"
         (make-csv-reader #\,)))

(test* "csv-reader" #t
       (eof-object?
        (call-with-input-string "" (make-csv-reader #\,))))

(test* "csv-writer"
       "abc,def,123,\"what's up?\",\"he said, \"\"nothing new.\"\"\"\n"
       (call-with-output-string
         (lambda (out)
           ((make-csv-writer #\,)
            out
            '("abc" "def" "123" "what's up?" "he said, \"nothing new.\""))))
       )

(test* "csv-writer"
       "abc,def,123,\"what's up?\",\"he said, \"\"nothing new.\"\"\"\r\n"
       (call-with-output-string
         (lambda (out)
           ((make-csv-writer #\, "\r\n")
            out
            '("abc" "def" "123" "what's up?" "he said, \"nothing new.\""))))
       )

(test* "csv-writer" "\n"
       (call-with-output-string
         (lambda (out)
           ((make-csv-writer #\,) out '()))))

;; middle-level API

(let ([data '(("" "" "" "" "" "" "" "" "")
              ("Exported data" "" "" "" "" "" "" "" "")
              ("" "" "" "" "" "" "" "" "")
              ("" "" "Year" "Country" "" "Population" "GDP" "" "Note")
              ("" "" "1958" "Land of Lisp" "" "39994" "551,435,453" "" "")
              ("" "" "1957" "United States of Formula Translators" "" "115333"
               "4,343,225,434" "" "Estimated")
              ("" "" "1959" "People's Republic of COBOL" ""
               "82524" "3,357,551,143" "" "")
              ("" "" "1970" "Kingdom of Pascal" "" "3785" "" "" "GDP missing")
              ("" "" "" "" "" "" "" "" "")
              ("" "" "1962" "APL Republic" "" "1545" "342,335,151" "" ""))]
      [header-slots1  '("Country" "Year" "GDP" "Population")]
      [header-slots2 '(#/country/i #/year/i #/gdp/i #/popu/i)])
  (test* "make-csv-header-parser (strings)" '#(3 2 6 5)
         (any (make-csv-header-parser header-slots1) data))

  (test* "make-csv-header-parser (regexps)" '#(3 2 6 5)
         (any (make-csv-header-parser header-slots2) data))

  (test* "make-csv-record-parser (strings)"
         '(("Land of Lisp" "1958" "551,435,453" "39994")
           ("United States of Formula Translators" "1957" "4,343,225,434"
            "115333")
           ("People's Republic of COBOL" "1959" "3,357,551,143" "82524")
           ("APL Republic" "1962" "342,335,151" "1545"))
         (filter-map (make-csv-record-parser header-slots1 '#(3 2 6 5)
                                             '(("Year" #/^\d+$/)
                                               "Country" "Population" "GDP"))
                     data))

  (test* "make-csv-record-parser (regexps)"
         '(("Land of Lisp" "1958" "551,435,453" "39994")
           ("United States of Formula Translators" "1957" "4,343,225,434"
            "115333")
           ("People's Republic of COBOL" "1959" "3,357,551,143" "82524")
           ("APL Republic" "1962" "342,335,151" "1545"))
         (filter-map (make-csv-record-parser header-slots2 '#(3 2 6 5)
                                             '((#/year/i #/^\d+$/)
                                               #/country/i #/popu/i #/gdp/i))
                     data))

  (test* "csv-rows->tuples (allow-gap? #f)"
         '(("Land of Lisp" "1958" "551,435,453" "39994")
           ("United States of Formula Translators" "1957" "4,343,225,434"
            "115333")
           ("People's Republic of COBOL" "1959" "3,357,551,143" "82524")
           ("Kingdom of Pascal" "1970" "" "3785"))
         (csv-rows->tuples data header-slots1))

  (test* "csv-rows->tuples (allow-gap? #t)"
         '(("Land of Lisp" "1958" "551,435,453" "39994")
           ("United States of Formula Translators" "1957" "4,343,225,434"
            "115333")
           ("People's Republic of COBOL" "1959" "3,357,551,143" "82524")
           ("Kingdom of Pascal" "1970" "" "3785")
           ("APL Republic" "1962" "342,335,151" "1545"))
         (csv-rows->tuples data header-slots1 :allow-gap? #t))
  )

;;-------------------------------------------------------------------
(test-section "diff")
(use text.diff)
(use srfi.13)
(test-module 'text.diff)

(define diff-a "foo
bar
bar
baz
baz
hoge
")
(define diff-b "foo
bar
baz
fuga
hoge
fuga
")

(test* "diff"
       '(((- 2 "bar")) ((- 4 "baz") (+ 3 "fuga")) ((+ 5 "fuga")))
       (diff diff-a diff-b))

(test* "diff"
       '(((- 2 "bar")) ((- 4 "baz") (+ 3 "FUGA")) ((+ 5 "FUGA")))
       (diff diff-a (string-upcase diff-b) :equal string-ci=?))

(test* "diff-report"
       "  foo\n  bar\n- bar\n  baz\n- baz\n+ fuga\n  hoge\n+ fuga\n"
       (with-output-to-string
         (lambda () (diff-report diff-a diff-b))))

(test* "diff-report/context"
       (string-join '("***************"
                      "*** 1,6 ****"
                      "  foo"
                      "  bar"
                      "- bar"
                      "  baz"
                      "! baz"
                      "  hoge"
                      "--- 1,6 ----"
                      "  foo"
                      "  bar"
                      "  baz"
                      "! fuga"
                      "  hoge"
                      "+ fuga")
                    "\n" 'suffix)
       (with-output-to-string
         (lambda () (diff-report/context diff-a diff-b))))

(test* "diff-report/context (one-side empty)"
       (string-join '("***************"
                      "*** 0 ****"
                      "--- 1,6 ----"
                      "+ foo"
                      "+ bar"
                      "+ baz"
                      "+ fuga"
                      "+ hoge"
                      "+ fuga")
                    "\n" 'suffix)
       (with-output-to-string
         (lambda () (diff-report/context "" diff-b))))

(test* "diff-report/unified"
       (string-join '("@@ -1,6 +1,6 @@"
                      " foo"
                      " bar"
                      "-bar"
                      " baz"
                      "-baz"
                      "+fuga"
                      " hoge"
                      "+fuga")
                    "\n" 'suffix)
       (with-output-to-string
         (lambda () (diff-report/unified diff-a diff-b))))

(test* "diff-report/context (one-side empty)"
       (string-join '("@@ -1,6 +0,0 @@"
                      "-foo"
                      "-bar"
                      "-bar"
                      "-baz"
                      "-baz"
                      "-hoge")
                    "\n" 'suffix)
       (with-output-to-string
         (lambda () (diff-report/unified diff-a ""))))

;;-------------------------------------------------------------------
(test-section "edn")
(use text.edn)
(use srfi.13)
(use gauche.uvector)
(test-module 'text.edn)

;; simple stuff
(let1 data `[(#t . "  true ")
             (#f . "false")
             (nil . "nil ")
             (symbol . " symbol ")
             (namespace/name . " namespace/name")
             (:keyword . ":keyword")
             ("string" . "\"string\"")
             ("weird \" characters \t\n\r\\"
              . "\"weird \\\" characters \\t\\n\\r\\\\\"")
             (#\a . "\\a")
             (#\newline . "\\newline")
             (#\return . "\\return")
             (#\space . "\\space")
             (#\tab . "\\tab")
             (0 . "0")
             (-1 . "-1")
             (() . "()")
             ((a b c) . "(a b c)")
             (#(a b c) . "[a b c]")
             (#((a b) (a c) #(b c)) . "[(a b) (a c) [b c]]")]
  (test* "parser basics" (map car data)
         (map ($ parse-edn-string $ cdr $) data))
  (test* "writer basics" (map ($ string-trim-both $ cdr $) data)
         (map ($ construct-edn-string $ car $) data)))

;; numeric formats (round-trip is not guaranteed)
;; NB: Edn page doesn't mention it, but Clojure reader also supports
;; 0xNNNN (hexadecimal) and 0NNN (octal) representations.
(let1 data `[(1234 . "1234")
             (-1234 . "-1234N")
             (1234 . "+1234N")
             (1234.0 . "1234M")
             (1234.5678 . "1234.5678")
             (12.34 . "1234e-2")
             (-1234.5678 . "-12.345678e2")
             (1234.5678 . "12.345678e+2")
             (1234.5678 . "+12.345678E+2")
             (4660      . "0x1234")
             (-4660      . "-0x1234")
             (668        . "01234")
             (-668       . "-01234")]
  (test* "parser numeric" (map car data)
         (map ($ parse-edn-string $ cdr $) data)))

;; other aggregates (round-trip is not guaranteed)
(let1 data `(("{:a 1, :b 2, :c 3}" . ,(edn-map :a 1 :b 2 :c '3))
             ("#{a b c d e}" . ,(edn-set 'a 'b 'c 'd 'e))
             ("#myobj{:a 1}" . ,(make-edn-object 'myobj (edn-map :a 1)))
             ("#foo\"abc\"" .  ,(make-edn-object 'foo "abc"))
             ("#bar[1 2 3]" .  ,(make-edn-object 'bar '#(1 2 3)))
             ("#baz 2345" .    ,(make-edn-object 'baz 2345))
             )
  (dolist [d data]
    (test* (format "parse ~s" d) (cdr d) (parse-edn-string (car d)) edn-equal?)
    (test* (format "write ~s" d) (parse-edn-string (car d))
           ($ parse-edn-string $ construct-edn-string
              $ parse-edn-string $ car d)
           edn-equal?)))

;; custom object
(register-edn-object-handler! 'u8vector
                              (^[tag vec] (vector->u8vector vec)))
(define-method edn-write ((x <u8vector>))
  (display "#u8vector")
  (edn-write (u8vector->vector x)))
(test* "custom parse" '#u8(1 2 3 4)
       (parse-edn-string "#u8vector[1 2 3 4]"))
(test* "custom writer" "#u8vector[1 2 3 4]"
       (construct-edn-string '#u8(1 2 3 4)))


;; invalid
(let1 invalids '("foo/bar/baz" "/foo" "foo/")
  (dolist [d invalids]
    (test* (format "parse (invalid) ~s" d)
           (test-error <edn-parse-error> #/invalid token/)
           (parse-edn-string d))))
(test* (format "valid symbol name") '(#f #f #f #f #t)
       (map edn-valid-symbol-name?
            '("nil" "bar/nil" "true" "false" "nile")))

;;-------------------------------------------------------------------
(test-section "external-editor")
(use text.external-editor)
(test-module 'text.external-editor)

;;-------------------------------------------------------------------
;; text.fill depends on gauche.unicode, and tested in ext/gauche.

;;-------------------------------------------------------------------
(test-section "html-lite")
(use text.html-lite)
(use srfi.13)
(test-module 'text.html-lite)

(test* "html-escape-string"
       "&lt;a href=&quot;http://abc/def?ghi&amp;jkl&quot;&gt;"
       (html-escape-string "<a href=\"http://abc/def?ghi&jkl\">"))

(test* "html-escape-string"
       "&lt;class&gt;"
       (html-escape-string '<class>))

(test* "html-doctype"
       '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\""
         "\"http://www.w3.org/TR/html4/strict.dtd\">" "")
       (map string-trim-both (string-split (html-doctype) #\newline)))

(test* "html-doctype"
       '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\""
         "\"http://www.w3.org/TR/html4/loose.dtd\">" "")
       (map string-trim-both
            (string-split (html-doctype :type :transitional) #\newline)))

(test* "html-doctype"
       '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\""
         "\"http://www.w3.org/TR/html4/frameset.dtd\">" "")
       (map string-trim-both
            (string-split (html-doctype :type :frameset) #\newline)))

(test* "html-doctype"
       '("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
         "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" "")
       (map string-trim-both
            (string-split (html-doctype :type :xhtml-1.0) #\newline)))

(use srfi.13)

(let ()
  ;; NB: avoid using tree->string, for we haven't tested it yet.
  (define (tos x) (string-delete (string-downcase (x->string x)) #\newline))
  (define (flatten-rec x r)
    (cond ((null? x) r)
          ((not (pair? x)) (cons (tos x) r))
          ((pair? (car x))
           (flatten-rec (cdr x) (flatten-rec (car x) r)))
          ((null? (car x)) (flatten-rec (cdr x) r))
          (else (flatten-rec (cdr x) (cons (tos (car x)) r)))))
  (define (flatten x) (string-concatenate-reverse (flatten-rec x '())))

  (test* "html, head, body"
         "<html><head><title>foo</title></head><body>foo</body></html>"
         (flatten (html:html (html:head (html:title "foo"))
                             (html:body "foo"))))
  (test* "attributes"
         "<a href=\"http://foo/bar?a&amp;b\" id=\"aabb\">zzdd</a>"
         (flatten (html:a :href "http://foo/bar?a&b" :id "aabb" "zzdd")))

  (test* "empty element"
         "<img src=\"foo\" alt=\"bar baz\" />"
         (flatten (html:img :src "foo" :alt "bar baz")))
  )

;;-------------------------------------------------------------------
(test-section "info")
(use text.info)
(test-module 'text.info)

;;-------------------------------------------------------------------
(test-section "multicolumn")
(use text.multicolumn)
(test-module 'text.multicolumn)

(let ([data '("alike" "ancient" "attend" "blood" "both"
              "break" "bury" "but" "children's" "civil" "continuance"
              "could" "death" "death-mark'd" "dignity" "do" "ears"
              "end" "fair" "fatal" "fearful" "foes" "forth" "from"
              "grudge" "hands" "here" "hours" "households" "if"
              "in" "is" "lay" "life" "loins" "love" "lovers" "makes"
              "mend" "misadventured" "miss" "mutiny" "new" "nought"
              "now" "of" "our" "overthrows" "pair" "parents"
              "passage" "patient" "piteous" "rage" "remove" "scene"
              "shall" "stage" "star-cross'd" "strife" "strive" "take"
              "the" "their" "these" "to" "toil" "traffic" "two" "unclean"
              "verona" "we" "what" "where" "which" "whose" "with" "you")])
  (define (t expect . args)
    (test*/diff (write-to-string `(display-multicolumn data ,@args))
                expect
                (with-output-to-string
                  (cut apply display-multicolumn data args))))

  (t '(
       "alike          fearful        miss           strive"
       "ancient        foes           mutiny         take"
       "attend         forth          new            the"
       "blood          from           nought         their"
       "both           grudge         now            these"
       "break          hands          of             to"
       "bury           here           our            toil"
       "but            hours          overthrows     traffic"
       "children's     households     pair           two"
       "civil          if             parents        unclean"
       "continuance    in             passage        verona"
       "could          is             patient        we"
       "death          lay            piteous        what"
       "death-mark'd   life           rage           where"
       "dignity        loins          remove         which"
       "do             love           scene          whose"
       "ears           lovers         shall          with"
       "end            makes          stage          you"
       "fair           mend           star-cross'd"
       "fatal          misadventured  strife"))

  (t '(
       "alike                    here                     piteous"
       "ancient                  hours                    rage"
       "attend                   households               remove"
       "blood                    if                       scene"
       "both                     in                       shall"
       "break                    is                       stage"
       "bury                     lay                      star-cross'd"
       "but                      life                     strife"
       "children's               loins                    strive"
       "civil                    love                     take"
       "continuance              lovers                   the"
       "could                    makes                    their"
       "death                    mend                     these"
       "death-mark'd             misadventured            to"
       "dignity                  miss                     toil"
       "do                       mutiny                   traffic"
       "ears                     new                      two"
       "end                      nought                   unclean"
       "fair                     now                      verona"
       "fatal                    of                       we"
       "fearful                  our                      what"
       "foes                     overthrows               where"
       "forth                    pair                     which"
       "from                     parents                  whose"
       "grudge                   passage                  with"
       "hands                    patient                  you")
      :minimum-width 25)

  (t '("alike          ears           lay            pair           these"
       "ancient        end            life           parents        to"
       "attend         fair           loins          passage        toil"
       "blood          fatal          love           patient        traffic"
       "both           fearful        lovers         piteous        two"
       "break          foes           makes          rage           unclean"
       "bury           forth          mend           remove         verona"
       "but            from           misadventured  scene          we"
       "children's     grudge         miss           shall          what"
       "civil          hands          mutiny         stage          where"
       "continuance    here           new            star-cross'd   which"
       "could          hours          nought         strife         whose"
       "death          households     now            strive         with"
       "death-mark'd   if             of             take           you"
       "dignity        in             our            the"
       "do             is             overthrows     their")
     :max-columns 7)

  (t '("alike          ancient        attend         blood"
       "both           break          bury           but"
       "children's     civil          continuance    could"
       "death          death-mark'd   dignity        do"
       "ears           end            fair           fatal"
       "fearful        foes           forth          from"
       "grudge         hands          here           hours"
       "households     if             in             is"
       "lay            life           loins          love"
       "lovers         makes          mend           misadventured"
       "miss           mutiny         new            nought"
       "now            of             our            overthrows"
       "pair           parents        passage        patient"
       "piteous        rage           remove         scene"
       "shall          stage          star-cross'd   strife"
       "strive         take           the            their"
       "these          to             toil           traffic"
       "two            unclean        verona         we"
       "what           where          which          whose"
       "with           you")
     :order 'row)

  (t '(
       "alike          here           piteous"
       "ancient        hours          rage"
       "attend         households     remove"
       "blood          if             scene"
       "both           in             shall"
       "break          is             stage"
       "bury           lay            star-cross'd"
       "but            life           strife"
       "children's     loins          strive"
       "civil          love           take"
       "continuance    lovers         the"
       "could          makes          their"
       "death          mend           these"
       "death-mark'd   misadventured  to"
       "dignity        miss           toil"
       "do             mutiny         traffic"
       "ears           new            two"
       "end            nought         unclean"
       "fair           now            verona"
       "fatal          of             we"
       "fearful        our            what"
       "foes           overthrows     where"
       "forth          pair           which"
       "from           parents        whose"
       "grudge         passage        with"
       "hands          patient        you")
     :width 50)

  (t '(
       "     alike          here           piteous"
       "     ancient        hours          rage"
       "     attend         households     remove"
       "     blood          if             scene"
       "     both           in             shall"
       "     break          is             stage"
       "     bury           lay            star-cross'd"
       "     but            life           strife"
       "     children's     loins          strive"
       "     civil          love           take"
       "     continuance    lovers         the"
       "     could          makes          their"
       "     death          mend           these"
       "     death-mark'd   misadventured  to"
       "     dignity        miss           toil"
       "     do             mutiny         traffic"
       "     ears           new            two"
       "     end            nought         unclean"
       "     fair           now            verona"
       "     fatal          of             we"
       "     fearful        our            what"
       "     foes           overthrows     where"
       "     forth          pair           which"
       "     from           parents        whose"
       "     grudge         passage        with"
       "     hands          patient        you")
     :width 50 :indent 5)

  (t '(
       "     alike          misadventured"
       "     ancient        miss"
       "     attend         mutiny"
       "     blood          new"
       "     both           nought"
       "     break          now"
       "     bury           of"
       "     but            our"
       "     children's     overthrows"
       "     civil          pair"
       "     continuance    parents"
       "     could          passage"
       "     death          patient"
       "     death-mark'd   piteous"
       "     dignity        rage"
       "     do             remove"
       "     ears           scene"
       "     end            shall"
       "     fair           stage"
       "     fatal          star-cross'd"
       "     fearful        strife"
       "     foes           strive"
       "     forth          take"
       "     from           the"
       "     grudge         their"
       "     hands          these"
       "     here           to"
       "     hours          toil"
       "     households     traffic"
       "     if             two"
       "     in             unclean"
       "     is             verona"
       "     lay            we"
       "     life           what"
       "     loins          where"
       "     love           which"
       "     lovers         whose"
       "     makes          with"
       "     mend           you")
     :width 45 :indent 5)

  (t '(
       "alike        death-mark'd  here        misadventured  piteous       to"
       "ancient      dignity       hours       miss           rage          toil"
       "attend       do            households  mutiny         remove        traffic"
       "blood        ears          if          new            scene         two"
       "both         end           in          nought         shall         unclean"
       "break        fair          is          now            stage         verona"
       "bury         fatal         lay         of             star-cross'd  we"
       "but          fearful       life        our            strife        what"
       "children's   foes          loins       overthrows     strive        where"
       "civil        forth         love        pair           take          which"
       "continuance  from          lovers      parents        the           whose"
       "could        grudge        makes       passage        their         with"
       "death        hands         mend        patient        these         you"
       )
     :width 80 :max-columns 10 :style 'packed)

  (t '(
       "alike   ancient       attend      blood          both          break"
       "bury    but           children's  civil          continuance   could"
       "death   death-mark'd  dignity     do             ears          end"
       "fair    fatal         fearful     foes           forth         from"
       "grudge  hands         here        hours          households    if"
       "in      is            lay         life           loins         love"
       "lovers  makes         mend        misadventured  miss          mutiny"
       "new     nought        now         of             our           overthrows"
       "pair    parents       passage     patient        piteous       rage"
       "remove  scene         shall       stage          star-cross'd  strife"
       "strive  take          the         their          these         to"
       "toil    traffic       two         unclean        verona        we"
       "what    where         which       whose          with          you"
       )
     :width 80 :order 'row :max-columns 10 :style 'packed)

  (t '(
       "alike          strife"
       "ancient        strive"
       "attend         take"
       "blood          the"
       "both           their"
       "break          these"
       "bury           to"
       "but            toil"
       "children's     traffic"
       "civil          two"
       "continuance    unclean"
       "could          verona"
       "death          we"
       "death-mark'd   what"
       "dignity        where"
       "do             which"
       "ears           whose"
       "end            with"
       "fair           you"
       "fatal"
       "fearful"
       "foes"
       "forth"
       "from"
       "grudge"
       "hands"
       "here"
       "hours"
       "households"
       "if"
       "in"
       "is"
       "lay"
       "life"
       "loins"
       "love"
       "lovers"
       "makes"
       "mend"
       "misadventured"
       "miss"
       "mutiny"
       "new"
       "nought"
       "now"
       "of"
       "our"
       "overthrows"
       "pair"
       "parents"
       "passage"
       "patient"
       "piteous"
       "rage"
       "remove"
       "scene"
       "shall"
       "stage"
       "star-cross'd"
       )
     :width 24 :style 'packed)
  )

;; corner cases
(test* "multicolumn corner case" '()
       (layout-multicolumn '()))
(test* "multicolumn corner case" '()
       (layout-multicolumn '() :order 'row))
(test* "multicolumn corner case" '()
       (layout-multicolumn '() :style 'packed))
(test* "multicolumn corner case" '(("a"))
       (layout-multicolumn '("a")))
(test* "multicolumn corner case" '(("a"))
       (layout-multicolumn '("a") :order 'row))
(test* "multicolumn corner case" '(("a"))
       (layout-multicolumn '("a") :style 'packed))
(test* "multicolumn corner case" '(("a       " "b       " "c"))
       (layout-multicolumn '("a" "b" "c")))
(test* "multicolumn corner case" '(("a       " "b       " "c"))
       (layout-multicolumn '("a" "b" "c") :order 'row))
(test* "multicolumn corner case" '(("a       " "b       " "c"))
       (layout-multicolumn '("a" "b" "c") :style 'packed))


;;-------------------------------------------------------------------
(test-section "parse")
(use text.parse)
(test-module 'text.parse)

;; a part of text data is taken from Oleg's vinput-parse.scm
;;  http://pobox.com/~oleg/ftp/Scheme/parsing.html

(define (test-find-string input pattern . max-chars)
  (call-with-input-string input
    (lambda (p)
      (let* ((n (apply find-string-from-port? pattern p max-chars))
             (c (read-char p)))
        (list n (if (eof-object? c) 'eof c))))))

(test* "find-string-from-port?" '(7 #\d)
       (test-find-string "bacacabd" "acab"))
(test* "find-string-from-port?" '(7 #\d)
       (test-find-string "bacacabd" "acab" 100))
(test* "find-string-from-port?" '(#f eof)
       (test-find-string "bacacabd" "acad"))
(test* "find-string-from-port?" '(#f eof)
       (test-find-string "bacacabd" "acad" 100))
(test* "find-string-from-port?" '(#f #\a)
       (test-find-string "bacacabd" "bd" 5))
(test* "find-string-from-port?" '(8 eof)
       (test-find-string "bacacabd" "bd" 9))
(test* "find-string-from-port?" '(8 eof)
       (test-find-string "bacacabd" "bd"))
(test* "find-string-from-port?" '(8 eof)
       (test-find-string "bacacabd" "bd" 8))
(test* "find-string-from-port?" '(#f eof)
       (test-find-string "bacacabd" "be" 20))


(define (test-parseutil proc input . args)
  (call-with-input-string input
    (lambda (p)
      (let* ((c (apply proc (append args (list p))))
             (n (read-char p)))
        (list (if (eof-object? c) 'eof c)
              (if (eof-object? n) 'eof n))))))

(define (test-assert-curr-char str clist)
  (test-parseutil assert-curr-char str clist "zz"))

(test* "assert-curr-char" '(#\space #\a)
       (test-assert-curr-char " abcd" '(#\a #\space)))
(test* "assert-curr-char" '(#\space #\a)
       (test-assert-curr-char " abcd" #[a ]))
(test* "assert-curr-char" '(#\space #\a)
       (test-assert-curr-char " abcd" #[a\s]))
(test* "assert-curr-char" '(#\space #\a)
       (test-assert-curr-char " abcd" '(#\a #[\s])))
(test* "assert-curr-char" '(#\a #\space)
       (test-assert-curr-char "a bcd" '(#\a #\space)))
(test* "assert-curr-char" '(#\a #\space)
       (test-assert-curr-char "a bcd" #[a ]))
(test* "assert-curr-char" (test-error)
       (test-assert-curr-char "bcd" #[a ]))
(test* "assert-curr-char" (test-error)
       (test-assert-curr-char "" #[a ]))
(test* "assert-curr-char" '(eof eof)
       (test-assert-curr-char "" '(#\a #\space *eof*)))

(test* "skip-until number" '(#f #\a)
       (test-parseutil skip-until " abcd" 1))
(test* "skip-until number" (test-error)
       (test-parseutil skip-until " abcd" 10))
(test* "skip-until number" '(#f eof)
       (test-parseutil skip-until " abcd" 5))
(test* "skip-until cset" '(#\space #\a)
       (test-parseutil skip-until " abcd" '(#\a #\space)))
(test* "skip-until cset" '(#\space #\a)
       (test-parseutil skip-until " abcd" #[a ]))
(test* "skip-until cset" '(#\c #\space)
       (test-parseutil skip-until "xxxc bcd" #[abc ]))
(test* "skip-until cset" '(#\c eof)
       (test-parseutil skip-until "xxxc" #[abc ]))
(test* "skip-until cset" (test-error)
       (test-parseutil skip-until "xxxc" #[def]))
(test* "skip-until cset" '(eof eof)
       (test-parseutil skip-until "xxxc" '(#[def] *eof*)))
(test* "skip-until cset" '(#\c eof)
       (test-parseutil skip-until "xxxc" '(#[c-f] *eof*)))
(test* "skip-until proc" '(#\c #\space)
       (test-parseutil skip-until "xxxc bcd"
                       (^x (not (eqv? x #\x)))))
(test* "skip-until proc" '(eof eof)
       (test-parseutil skip-until "xxx"
                       (^x (not (eqv? x #\x)))))
(test* "skip-until proc" (test-error)
       (test-parseutil skip-until "yyyy"
                       (^x (eqv? x #\x))))
(test* "skip-while" '(#\d #\d)
       (test-parseutil skip-while "xxxd" '(#\a #\space #\x)))
(test* "skip-while" '(#\d #\d)
       (test-parseutil skip-while "xxxd" #[ax ]))
(test* "skip-while" '(#\y #\y)
       (test-parseutil skip-while "yxxxd" #[ax ]))
(test* "skip-while" '(eof eof)
       (test-parseutil skip-while "xxxa" #[ax ]))
(test* "skip-while" '(#\d #\d)
       (test-parseutil skip-while "xxxd"
                       (^x (eqv? x #\x))))
(test* "skip-while" '(#\y #\y)
       (test-parseutil skip-while "yxxxd"
                       (^x (eqv? x #\x))))
(test* "skip-while" '(eof eof)
       (test-parseutil skip-while "yxxxd"
                       (^x (and (char? x)
                                (char-alphabetic? x)))))

(test* "next-token" '("" #\d)
       (test-parseutil next-token "xxxd" #[ax ] #[d] "next token"))
(test* "next-token" '("bc" #\d)
       (test-parseutil next-token "xxxabcd" #[ax ] #[d] "next token"))
(test* "next-token" '("aeio" #\tab)
       (test-parseutil next-token "   aeio\tnjj" #[\s] #[\s] "next token"))
(test* "next-token" (test-error)
       (test-parseutil next-token "   aeio" #[\s] #[\s] "next token"))
(test* "next-token" '("aeio" eof)
       (test-parseutil next-token "   aeio" #[\s] '(#[\s] *eof*) "next token"))
(test* "next-token" '("aeio" #\tab)
       (test-parseutil next-token "   aeio\tnjj"
                       (^x (and (char? x)
                                (char-whitespace? x)))
                       (^x (or (eof-object? x)
                               (char-whitespace? x)))
                       "next token"
                       ))

(test* "next-token-of" '("" #\x)
       (test-parseutil next-token-of "xxxd" #[a-c]))
(test* "next-token-of" '("" #\x)
       (test-parseutil next-token-of "xxxd" #[a-d]))
(test* "next-token-of" '("xxx" #\d)
       (test-parseutil next-token-of "xxxd" #[ax]))
(test* "next-token-of" '("anmb" #\-)
       (test-parseutil next-token-of "anmb-runge" #[\w]))
(test* "next-token-of" '("rnge!rg0#$@" #\space)
       (test-parseutil next-token-of "rnge!rg0#$@ bag" #[\S]))
(test* "next-token-of" '("xxx" #\d)
       (test-parseutil next-token-of "xxxd"
                       (^x (eqv? x #\x))))
(test* "next-token-of" '("xxxx" eof)
       (test-parseutil next-token-of "xxxx"
                       (^x (eqv? x #\x))))

(test* "read-string" '("aaaa" #\a)
       (test-parseutil read-string "aaaaa" 4))
(test* "read-string" '("aaaaa" eof)
       (test-parseutil read-string "aaaaa" 5))
(test* "read-string" '("aaaaa" eof)
       (test-parseutil read-string "aaaaa" 6))
(test* "read-string" '("" #\a)
       (test-parseutil read-string "aaaaa" 0))
(test* "read-string" '("" #\a)
       (test-parseutil read-string "aaaaa" -1))
(test* "read-string" '("" eof)
       (test-parseutil read-string "" 7))

;;-------------------------------------------------------------------
(test-section "progress")
(use text.progress)
(test-module 'text.progress)

;; WRITEME

;;-------------------------------------------------------------------
(test-section "sh")
(use text.sh)
(test-module 'text.sh)

(let ()
  (define (t input expected flavor)
    (test* #"shell-escape-string(~flavor) - ~input" expected
           (shell-escape-string input flavor)))

  (t ""          "\"\""              'windows)
  (t "abc"       "abc"               'windows)
  (t "a b c"     "\"a b c\""         'windows)
  (t "a \"b\" c" "\"a \\\"b\\\" c\"" 'windows)
  (t "a\\ \\\""  "\"a\\ \\\\\\\"\""  'windows)
  (t ""          "''"                'posix)
  (t "abc"       "abc"               'posix)
  (t "a b c"     "'a b c'"           'posix)
  (t "$abc"      "'$abc'"            'posix)
  (t "[abc]"     "'[abc]'"           'posix)
  (t "\\abc"     "'\\abc'"           'posix)
  (t ">abc"      "'>abc'"            'posix)
  (t "<abc"      "'<abc'"            'posix)
  (t "a\"b\"c"   "'a\"b\"c'"         'posix)
  (t "a(b)c"     "'a(b)c'"           'posix)
  (t "a{b}c"     "'a{b}c'"           'posix)
  (t "a'c"       "'a'\"'\"'c'"       'posix)
  )

(let ()
  (define (t input expected flavor)
    (test* #"shell-tokenize-string(~flavor) - ~input" expected
           (shell-tokenize-string input flavor)))

  (t ""                    '()                         'posix)
  (t "   "                 '()                         'posix)
  (t "abc"                 '("abc")                    'posix)
  (t "  abc "              '("abc")                    'posix)
  (t "ab   c d"            '("ab" "c" "d")             'posix)
  (t "ab\\ c\\ d"          '("ab c d")                 'posix)
  (t "ab\\'c\\\"d"         '("ab'c\"d")                'posix)
  (t "'ab c d' ef \"g h\"" '("ab c d" "ef" "g h")      'posix)
  (t "'ab\\\\cd' \"ab\\\\cd\"" '("ab\\\\cd" "ab\\cd")  'posix)
  (t "'ab\\xcd' \"ab\\xcd\"" '("ab\\xcd" "ab\\xcd")    'posix)
  (t "a\"\"b"              '("ab")                     'posix)
  (t "a''b"                '("ab")                     'posix)
  (t "a'\"'b"              '("a\"b")                   'posix)
  (t "a\"'\"b"             '("a'b")                    'posix)

  (t "$abc"                (test-error)                'posix)
  (t "\"$abc\""            (test-error)                'posix)
  (t "'$abc'"              '("$abc")                   'posix)
  (t "abc >z"              (test-error)                'posix)
  (t "abc \">z\""          '("abc" ">z")               'posix)
  (t "abc \"`z`\""         (test-error)                'posix)
  (t "abc '`z`'"           '("abc" "`z`")              'posix)

  (t ""                    '()                         'windows)
  (t "   "                 '()                         'windows)
  (t "abc"                 '("abc")                    'windows)
  (t "  abc "              '("abc")                    'windows)
  (t "ab   c d"            '("ab" "c" "d")             'windows)
  (t "\"a b c\" d e"       '("a b c" "d" "e")          'windows)
  (t "\"ab\\\"c\" \"\\\\\" d" '("ab\"c" "\\" "d")      'windows)
  (t "a\\\\\\b d\"e f\"g h" '("a\\\\\\b" "de fg" "h")  'windows)
  (t "a\\\\\\\"b c d"      '("a\\\"b" "c" "d")         'windows)
  (t "a\\\\\\\\\"b c\" d e" '("a\\\\b c" "d" "e")      'windows)
  (t "\""                  '("")                       'windows)
  (t "\"\""                '("")                       'windows)
  (t "\"\"\""              '("\"")                     'windows)
  (t "\"\"\"\""            '("\"")                     'windows)
  (t "\"\"\"\"\""          '("\"")                     'windows)
  (t "\"\"\"\"\"\""        '("\"\"")                   'windows)
  (t "\"\"\"\"\"\"\""      '("\"\"")                   'windows)
  (t "a\"b\"\" c"          '("ab\"" "c")               'windows)
  (t "a\"b\"\"\" c"        '("ab\" c")                 'windows)
  (t "a\"b\"\"\"\" c"      '("ab\"" "c")               'windows)
  )

(let ()
  (define (t-case input expect)
    (test* #"shell-case: ~input"
           expect
           ($ shell-case input
              ["foo"  'foo]
              ["foo?" 'foo?]
              ["foo*" 'foo*]
              ["*foo" '*foo]
              [("bar*" "baz*") 'barz]
              [else   'else])))
  (t-case "foo" 'foo)
  (t-case "foof" 'foo?)
  (t-case "foogh" 'foo*)
  (t-case "fufoo" '*foo)
  (t-case "bazooka" 'barz)
  (t-case "zbar" 'else)
  (t-case "zfooz" 'else)
  )

;;-------------------------------------------------------------------
(test-section "sql")
(use text.sql)
(test-module 'text.sql)

(test* "sql-tokenize" '("select" "tab" #\. "x" #\, "tab" #\. "y" "as" "foo"
                        "from" "tab" "where" "tab" #\. "z" < (number "30"))
       (sql-tokenize "select tab.x, tab.y as foo from tab\nwhere tab.z<30"))

(test* "sql-tokenize (literal numberes)" '((number "0")
                                           (number "-12")
                                           (number "+12")
                                           (number ".123")
                                           (number "123.")
                                           (number "123.45")
                                           (number "-.123")
                                           (number "-123.")
                                           (number "-123.45")
                                           (number "+.123")
                                           (number "+123.")
                                           (number "+123.45")
                                           (number "0E0")
                                           (number "-1E3")
                                           (number "-1.E3")
                                           (number "-.1E3")
                                           (number "-1.2E3")
                                           (number "1E-3")
                                           (number "1.E-3")
                                           (number ".1E-3")
                                           - #\. "E" (number "-3")
                                           (number "1.2") (number ".3")
                                           )

       (sql-tokenize "0 -12 +12 .123 123. 123.45 -.123 -123. -123.45
                      +.123 +123. +123.45 0E0 -1E3 -1.E3 -.1E3
                      -1.2E3 1E-3 1.E-3 .1E-3 -.E-3 1.2.3"))

(test* "sql-tokenize (literal strings)" '((string "abc")
                                          (string "ab'c")
                                          (string "'abc")
                                          (string "abc'")
                                          (string "")
                                          (string "'")
                                          (string "a'b'c'"))
       (sql-tokenize "'abc' 'ab''c' '''abc' 'abc''' '' '''' 'a''b''c'''"))

(test* "sql-tokenize (unterminated literal)" (test-error <sql-parse-error>)
       (sql-tokenize "'abc def"))

(test* "sql-tokenize (unterminated literal)" (test-error <sql-parse-error>)
       (sql-tokenize "'abc''def"))

(test* "sql-tokenize (other stuff)" '((bitstring "0")
                                      (bitstring "010101")
                                      (hexstring "0")
                                      (hexstring "1aBc9")
                                      (delimited "run \"run\" run"))
       (sql-tokenize "B'0' B'010101' X'0' X'1aBc9' \"run \"\"run\"\" run\""))

(test* "sql-tokenize (parameters)" '((parameter 0) #\,
                                     (parameter 1) #\,
                                     (parameter "foo") #\,
                                     (parameter "bar") #\,
                                     (parameter 2))
       (sql-tokenize "?,?,:foo, :bar , ?"))

;;-------------------------------------------------------------------
(test-section "pager")
(use text.pager)
(test-module 'text.pager)

;;-------------------------------------------------------------------
(test-section "segmented-match")
(use text.segmented-match)
(test-module 'text.segmented-match)

(let ([data '(;; pattern (success-word ...) (fail-word ...)
              ("a-b-c"
               ("a-b-c" "a-b-c-d" "a-b-c-d-e" "a-b-c-"
                "abc-bcd-cde" "abc-bcd-cde-def")
               ("a-b" "ab-c" "abc-cde" "a-b-"))
              ("abc"
               ("abc" "abcd" "abc-abc" "abc-")
               ("ab" "-abc" "a-bc"))
              ("a--b"
               ("a--b" "aaa--bbb")
               ("a-b")))])
  (dolist [pattest data]
    (let ([pattern (car pattest)])
      (dolist [succ (cadr pattest)]
        (test* `(segmented-prefix ,pattern ,succ) #t
               (segmented-prefix? pattern succ)))
      (dolist [fail (caddr pattest)]
        (test* `(segmented-prefix ,pattern ,fail) #f
               (segmented-prefix? pattern fail)))
      ))
  )

(test* "segmented match (alternative separator)" #t
       (segmented-prefix? "/u/b/g" "/usr/bin/gosh" #\/))

;;-------------------------------------------------------------------
(test-section "template")
(use text.template)
(test-module 'text.template)

(test* "expand-template-string"
       "abc 9 ghi mno3e8"
       (expand-template-string
        "abc ~def ghi ~(jkl \"mno~x\" pqr)"
        (make-template-environment
         :bindings `(abc 3 def 9 jkl ,format pqr 1000))))

(test*/diff "expand-template-file"
            "<html><head><title>Test</title></head><body><p><a href=\"foo\">bar</a\n>baz</p\n></body></html>\n"
            (expand-template-file
             "template.txt"
             (make-template-environment
              :imports '(text.tree)
              :bindings `(title "Test"
                                body ,(html:p (html:a :href "foo" "bar") "baz")))
             '("../tests/data")))

;;-------------------------------------------------------------------
(test-section "tree")
(use text.tree)
(test-module 'text.tree)

(test* "tree->string" "" (tree->string '()))
(test* "tree->string" "" (tree->string ""))
(test* "tree->string" "ab" (tree->string "ab"))
(test* "tree->string" "ab" (tree->string 'ab))
(test* "tree->string" "ab" (tree->string '(a . b)))
(test* "tree->string" "ab" (tree->string '(a b)))
(test* "tree->string" "ab" (tree->string '((((() ())) . a) ((((b)))))))
(test* "tree->string"
       (if (symbol? :b) "A:b" "Ab") ; transient during symbol-keyword integration
       (tree->string '(|A| . :b)))

;;-------------------------------------------------------------------
(test-section "unicode.ucd")
(use text.unicode.ucd)
(test-module 'text.unicode.ucd)

(test-section "unicode.codeset")
(use text.unicode.codeset)
(test-module 'text.unicode.codeset)

(let ([cs (make <char-code-set>)])
  ;; testing overlapped ranges
  (add-code-range! cs 64 127)
  (add-code-range! cs 8 80)
  (add-code-range! cs 100 1000)
  (add-code-range! cs 200 210)   ; totally subsumed
  (add-code-range! cs 1500 2000) ; independent

  (test* "add-code-range! (bitmap)"
         #xffff_ffff_ffff_ffff_ffff_ffff_ffff_ff00
         (~ cs'small-map))

  (test* "add-code-range! (subsumed)"
         '((128 . 1000) (1500 . 2000))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 1800 2100) ; partially overlap
  (add-code-range! cs 1400 1600)
  (test* "add-code-range! (partially overlap)"
         '((128 . 1000) (1400 . 2100))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 1300 1400) ; adjacent
  (add-code-range! cs 1000 1100) ; adjacent
  (add-code-range! cs 2100 2200) ; adjacent
  (test* "add-code-range! (adjacent)"
         '((128 . 1100) (1300 . 2200))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 2500 2600)
  (add-code-range! cs 2700 2800)
  (add-code-range! cs 2900 3000)
  (add-code-range! cs 3100 3200)
  (add-code-range! cs 3300 3400)
  (add-code-range! cs 2550 3050)
  (test* "add-code-range! (multiple)"
         '((128 . 1100) (1300 . 2200) (2500 . 3050) (3100 . 3200) (3300 . 3400))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 3090 3300)
  (test* "add-code-range! (multiple)"
         '((128 . 1100) (1300 . 2200) (2500 . 3050) (3090 . 3400))
         (tree-map->alist (~ cs'large-map)))

  (add-code! cs 3401)
  (add-code! cs 3089)
  (test* "add-code! (next)"
         '((128 . 1100) (1300 . 2200) (2500 . 3050) (3089 . 3401))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 3402 3500)
  (test* "add-code-range! (next)"
         '((128 . 1100) (1300 . 2200) (2500 . 3050) (3089 . 3500))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 3052 3088)
  (test* "add-code-range! (next)"
         '((128 . 1100) (1300 . 2200) (2500 . 3050) (3052 . 3500))
         (tree-map->alist (~ cs'large-map)))

  (add-code! cs 3051)
  (test* "add-code! (fill)"
         '((128 . 1100) (1300 . 2200) (2500 . 3500))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 1101 1299)
  (test* "add-code-range! (fill)"
         '((128 . 2200) (2500 . 3500))
         (tree-map->alist (~ cs'large-map)))

  (add-code-range! cs 4000 4500)
  (add-code-range! cs 2300 3999)
  (test* "add-code-range! (fill)"
         '((128 . 2200) (2300 . 4500))
         (tree-map->alist (~ cs'large-map)))
  )

(let ([cs1 (make <char-code-set>)]
      [cs2 (make <char-code-set>)])
  (add-code-range! cs1 8 15)
  (add-code-range! cs1 120 200)
  (add-code-range! cs1 300 400)
  (add-code! cs1 500)
  (add-code! cs1 600)
  (add-code-range! cs1 1000 2000)
  (add-code-range! cs1 3000 4000)
  (add-code-range! cs1 5000 6000)
  (add-code-range! cs1 7000 8000)

  (add-code-range! cs2 24 31)
  (add-code-range! cs2 128 250)
  (add-code-range! cs2 300 500)
  (add-code-range! cs2 600 900)
  (add-code-range! cs2 1100 5100)
  (add-code-range! cs2 5800 9000)

  (let1 cs (code-set-union #f cs1 cs2)
    (test* "code-set-union (bitmap)"
           #xff00_0000_0000_0000_0000_0000_ff00_ff00
           (~ cs'small-map))
    (test* "code-set-union (large-map"
           '((128 . 250) (300 . 500) (600 . 900) (1000 . 9000))
           (tree-map->alist (~ cs'large-map))))
  )

(test-end)
