;; Tests of .bst parsing and functionality, using only the externally
;; visible functions.  For more thorough tests, see test-btxhak-internal.scm
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

(module "s7unit.scm" 'bst 'unicode 'subtex)

;; the following locale setting is a no-op when we're not using
;; ICU, but with it, the POSIX order ensures that uppercase
;; consistently sorts before lower
(unicode-set-locale! "en_US_POSIX")

(test-suite
 "Working .bst programs"
 (assert-equal
  (with-output-to-string
    (λ ()
      (process-bibs/bst 'all '("bib-t01-simple.bib") "bst-t01-minimal.bst")))
  #"""

\bibitem{T1-2:UPPERCASE}
Type: book -- authors=Another Author; title=Book title; date=Januarius 2000; global.var=1.

\bibitem{t1-1}
Article: authors=Sample {Author} and First Last, title=Article title, date=1999.

\bibitem{t3}
Article: authors=<absent>, title=<absent>, date=9999.

\bibitem{t4}
Article: authors=<absent>, title=<absent>, date=9999.
""")

 ;; the same, but with an explicit list of symbol citations
 (assert-equal
  (with-output-to-string
    (λ ()
      (process-bibs/bst '(t1-1) '("bib-t01-simple.bib") "bst-t01-minimal.bst")))
  #"""

\bibitem{t1-1}
Article: authors=Sample {Author} and First Last, title=Article title, date=1999.
"""))

(test-suite
 "Failing .bst programs"
 ;; a program which tries to dereference an empty stack
 (catch #t
        (λ ()
          (process-bibs/bst 'all
                            '("bib-t01-simple.bib")
                            ;; string starting "!" means literal .bst
                            ;; see process-bibs/bst special case
                            "!\n\nfunction{test1}\n{#1 +}\nread\niterate{test1}\n")
          (eprintf "bad succeed (1)~%")
          (assert-fail "bst program should have failed (1)"))
        (λ (tag info)
          (assert-equal tag 'beastie)
          ;; the precise error message doesn't much matter, nor the
          ;; content of the 'calls item in the assoc, but they should
          ;; be something like this
          (assert-equal info '("stack empty when calling +"
                               ((subtag . bst-stack)
                                (calls . "+ <- test1:4 <- iterate:6"))))))

 ;; wrong type argument to chr.to.int$, detected inside an inner block
 (catch #t
        (λ ()
          (process-bibs/bst 'all
                            '("bib-t01-simple.bib")
                            "!% stuff\n\nfunction{test2}\n{ #1 #1 =\n  {#1 chr.to.int$}\n {\"\" write$ }\nif$}\nread\niterate{test2}")
          (eprintf "bad succeed (2)~%")
          (assert-fail "bst program should have failed (2)"))
        (λ (tag info)
          (assert-equal tag 'beastie)
          (assert-equal info
                        '("calling chr.to.int$ with stack (1): expected ustring? for item 1, got 1"
                          ((subtag . bst-stack)
                           (calls . "chr.to.int$ <- {}:5 <- test2:4 <- iterate:9")))))))

(test-suite
 "string manipulations"                 ;(other than SRFI ones)

 ;; The following tests of *case-string/bst overlap with the tests of
 ;; change.case$ in test-btxhak.scm, but have a different interface.
 ;; Those tests also confirm that this implementation matches BibTeX.
 (assert-equal (lowercase-string/bst #"oNe: TWO: three") #"one: two: three")
 (assert-equal (uppercase-string/bst #"oNe: TWO: three") #"ONE: TWO: THREE")
 ;; here, note that the 'O' of "ONE" and 'T' characters are left
 ;; alone, rather than being lowercased, because they come after colon+space
 (assert-equal (titlecase-string/bst #"oNe: TWO: three") #"one: Two: three")
 (assert-equal (titlecase-string/bst #"ONE: TWO: THREE") #"One: Two: Three")
 ;; multiple spaces following colon
 (assert-equal (titlecase-string/bst #"ONE:   TWO:   THREE") #"One:   Two:   Three")
 ;; a character immediately following a colon
 ;; (ie, not a ‘colon and then nonnull white space‘)
 ;; isn't excepted from the lowercasing
 (assert-equal (titlecase-string/bst #"O:ABC:abc") #"O:abc:abc")
 ;; Now with braces.
 ;; Also, give the input as a string rather than ustring,
 ;; to verify that we accept (and convert) that.
 (assert-equal (titlecase-string/bst "{ONE}: {two}: {THREE}") #"{ONE}: {two}: {THREE}")
 (assert-equal (uppercase-string/bst "{ONE}: {two}: {THREE}") #"{ONE}: {two}: {THREE}")
 (assert-equal (lowercase-string/bst "{ONE}: {two}: {THREE}") #"{ONE}: {two}: {THREE}")

 ;; the following cases typically won't occur within BibTeX,
 ;; but this is sensible behaviour -- at any rate these arguments shouldn't cause errors
 (assert-false (titlecase-string/bst #f))
 (assert-false (uppercase-string/bst #f))
 (assert-false (lowercase-string/bst #f))

 ;; (assert-equal (string->symbol/downcase "HeLlO") 'hello)
 ;; (assert-equal (string->symbol/downcase "Élàn") 'élàn)

 (assert-equal (map string->page-range
                    '("1" "2-3" "4–5" "6-" "7+"))
               '(("1" . single)
                 ("2" . "3")
                 ("4" . "5")
                 ("6" . inf)
                 ("7" . inf)))
 (assert-equal (map string->page-range
                    '("10=" "-11" "12-13--14" "foo" symbol))
               '(#f #f #f #f #f))
 (assert-equal (map en-dashify
                    '("1"               ;no punctuation
                      "1-" "1--"        ;hyphens
                      "1–"              ;unicode 'EN DASH', U+2013
                      ;;"-2"        ;invalid in btxdoc terms, we should object
                      ;;"--2"
                      ;;"–2"              ;EN DASH, again
                      "3-4" "3--4"
                      "3–4"             ;EN DASH
                      "3-4--3"          ;hyphen then double-hyphen
                      1                 ;not a string
                      "5+"))
               ;; btxdoc doesn't indicate what "-2" or "1-2-3" should turn into.
               ;; The following seem reasonable, and are here to avoid regressions.
               ;; What we are comparing with here is the implementation of n.dashify in plain.bst
               ;; (see test-btxhak-internal.scm):
               ;;   "1-2" n.dashify -> "1--2"
               ;;   "1--2" n.dashify -> "1--2"
               ;;   "1+" n.dashify -> "1+" (unhelpful)
               ;;   "1-2-3" n.dashify -> "1--2--3" (but more-or-less by accident, I think)
               '("1" "1–" "1–" "1–"     ;all en-dashes
                 ;"2" "2" "2"
                 "3–4" "3–4" "3–4"
                 #f ;not "3–4"
                 #f
                 "5–"))
 ;; should I make this a built-in function?
 (define (first-page-number s)
   (let ((range (string->page-range s)))
     (if range
         (car range)
         #f)))
 (assert-equal (map first-page-number
                    '("1" "11-22"
                      "11–22"           ;en-dash
                      "111+"
                      'foo              ;not a string
                      "foo"))           ;no digits
               '("1" "11" "11" "111" #f #f))

 (let ((us #"ab~c{d}"))
   (assert-equal (ustring-uppercase us)
                 #"AB~C{D}")
   (assert-equal (bstring->ustring
                  (list->bstring
                   (map uchar-upcase
                        (ustring-iterator/bstrings us))))
                 #"AB~C{d}")))