;; 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" 'authors 'unicode 'subtex)

;; There is also some testing of internal functions in
;; parse-btxhak-internal.scm, because it seems tidier to keep such
;; internal grubbing around in one place.

(print-warning 'push #f)

;; The list of 'odd' names at the bottom was assembled from odd names
;; that occurred to me when writing this.  I could doubtless be more
;; systematic about assembling all of the allowed possibilities.

;; parse an author string, and turn an author struct into a list for testing
(define (parse/test s)
  (let ((parsed (parse-author-list (parse-subtex s))))
    ;(eprintf "parsed ~s -> ~s~%" s parsed)
    (if parsed
        (map (lambda (a)
               (cond ((eqv? a 'others) 'others)
                     (else (author->list a))))
             parsed)
        '())))

;; From btxdoc:
;;
;;    To summarize, BibTEX allows three possible forms for the name:
;;         "First von Last"
;;         "von Last, First"
;;         "von Last, Jr, First"
(test-suite
 "Name parsing"
 (assert-equal (parse/test "First Last")
               '((("First") #f ("Last") #f)))

 ;; multiple forenames and surnames:
 ;; Maxwell had a two-word, but not hyphenated, surname (Per Brinch
 ;; Hansen is another example here, noted in the btxdoc
 ;; documentation).    Though the btxdoc documentation doesn't say so,
 ;; it seems obvious that `Per Brinch~Hansen` should be parsed in a
 ;; compatible way (here, as a single-token surname).
 (assert-equal (parse/test "James Clerk Maxwell and James Clerk~Maxwell and Clerk Maxwell, James")
               '((("James" "Clerk") #f ("Maxwell") #f) ;bibliographically wrong
                 (("James") #f ("Clerk~Maxwell") #f) ;note, tilde rather than NBSP
                 (("James") #f ("Clerk" "Maxwell") #f)))

 (assert-equal (parse/test "John von Neumann and von Richthofen, Jr Rtd, Baron and von Last, First and Gates, III, William Henry")
               '((("John") ("von") ("Neumann") #f)
                 (("Baron") ("von") ("Richthofen") ("Jr" "Rtd"))
                 (("First") ("von") ("Last") #f)
                 (("William" "Henry") #f ("Gates") ("III"))))

 ;; the following isn't one of the 'three possible forms' for a name,
 ;; but bibtex parses it OK
 (assert-equal (parse/test "von Neumann")
               '((#f ("von") ("Neumann") #f)))

 ;; The following is probably an error on the user's part,
 ;; which we recover from by regarding "von" as a surname.
 ;; This isn't going to make much sense in bibliographic terms,
 ;; but that's the user's problem, not ours.
 (assert-equal (parse/test "John von")
               '((("John") #f ("von") #f)))

 ;; braces escape 'and', and the result ends up being a surname
 (assert-equal (parse/test "{Barnes and Noble, Inc.}")
               '((#f #f ("{Barnes and Noble, Inc.}") #f)))
 ;; the gratuitous braces here shouldn't stop this being recognised as
 ;; a surname
 (assert-equal (parse/test "First {Last}")
               '((("First") #f ("{Last}") #f)))
 ;; I'm slightly uncertain what the following should produce.  It makes
 ;; sense that the capitalised first _letter_ in "{Middle}" should
 ;; make this be parsed as an uppercase string, as here, but I have at
 ;; one time concluded that it made sense for all braced material to
 ;; be regarded as lowercase, even though I can't now reconstruct why
 ;; I thought that.  At any rate, this behaviour more closely matches
 ;; what BibTeX does (see the corresponding testbtx test below).
 (assert-equal (parse/test "First {Middle} Last")
               '((("First" "{Middle}") #f ("Last") #f)))
 (assert-equal (parse/test "First {von} Last")
               '((("First") ("{von}") ("Last") #f)))

 ;; we should be able to handle traditionally accented characters
 ;; (Chuck of Chick Valley is mentioned here because he's referred to
 ;; as a multi-component name in the BibTeX docs, but although the
 ;; docs doesn't assert that it's talking about anyone in particular,
 ;; (a) it appears from the Wikipedia entry that he's Joseph-Xavier
 ;; rather than the other way around, and
 ;; (b) he's less famous than his mathematician son, Charles-Jean).
 ;; None of the above detail matters, of course, but we're in a picky
 ;; mood, here amongst the bibliographic test cases.
 (assert-equal (parse/test "Charles Louis Xavier Joseph d{\\\"{u}} la Vall{\\'e}e Poussin")
               '((("Charles" "Louis" "Xavier" "Joseph")
                  ("dü" "la")
                  ("Vallée" "Poussin")
                  #f)))

 ;; multiple von-parts
 (assert-equal (parse/test "Bill Aloysius von der Bailey de Beers")
               '((("Bill" "Aloysius")
                  ("von" "der")
                  ("Bailey" "de" "Beers")
                  #f)))
 ;; ... and with von-like first names
 (assert-equal (parse/test "von der Bailey de Beers, Bill de Grasse")
               '((("Bill" "de" "Grasse")
                  ("von" "der")
                  ("Bailey" "de" "Beers")
                  #f)))
 ;; ...and with juniors
 (assert-equal (parse/test "von der Bailey de Beers, Jr (retd), Bill de Grasse")
               '((("Bill" "de" "Grasse")
                  ("von" "der")
                  ("Bailey" "de" "Beers")
                  ("Jr" "(retd)"))))

 ;; escape sequences at brace-level 0, both valid...
 (assert-equal (parse/test "B\\'eb\\'{e} d\\' u Bébé")
               '((("Bébé") ("dú") ("Bébé") #f)))
 ;; ...and invalid:
 ;; there isn't a \'{x} sequence recognised, nor \foo:
 ;; this shouldn't break parsing
 (assert-equal (parse/test "V\\'xt Novotn\\' {x}")
               '((("V\\'{x}t") #f ("Novotn\\'{x}")  #f)))

 ;; The following are cases I don't think I need to worry about here.
 ;;
 ;; At one point, I did have the bstring parser passing parsed
 ;; commands through, so that it was possible and reasonable to
 ;; implement the following (and since these command were appearing
 ;; here, it was necessary to do _something_).  But now unrecognised
 ;; TeX commands are simply passed through as strings, so, for
 ;; example, a space following one becomes significant again.
 ;;
 ;; It was never terribly clear what the correct thing to do was,
 ;; here, and the BibTeX manual doesn't provide any clues.  So the
 ;; best thing to do seems to be to ignore it.  The tests are here
 ;; partly in case I change my mind again, or to support this note.
 ;;
 ;; C\foo Bar should be a single word
 ;; (assert-equal (parse/test "A\\foo oot B{\\foo}oot C\\foo Bar")
 ;;               '((("A\\foo oot" "B{\\foo}oot") #f ("C\\foo Bar")  #f)))
 ;; The following is a two-word string, so the second should end up as
 ;; the surname (I haven't seen something like this in practice, but
 ;; it could I suppose arise from someone equivocating about spellings
 ;; of 'Mac' or 'Mc').
 ;; On experiment, bibtex consistently parses '\mc' as a von-part
 ;; -- I think that's a mistake
 ;; (assert-equal (parse/test "Finn \\mc Cool")
 ;;               '((("Finn") #f ("\\mc Cool") #f)))
 ;; The following is possibly a bit silly...
 ;; (so skip it: there's not an obvious correct thing to do here)
 ;; (assert-equal (parse/test "Finn \\mc Cool and \\fionn \\mc Cool and \\mc Cool, Finn and \\mc Cool, \\fionn")
 ;;               '((("Finn") #f ("\\mc Cool") #f)
 ;;                 (#f ("\\fionn") ("\\mc Cool") #f) ;can't avoid this
 ;;                 (("Finn") #f ("\\mc Cool") #f)
 ;;                 (("\\fionn") #f ("\\mc Cool") #f)))

 ;; unconventional capitalisations:
 ;; bibtex parses 'bell hooks' with 'bell' being a von-part
 ;; -- I think we just put this down as an unavoidable special-case,
 ;; if necessary, but in fact we can not-quite-special-case this as
 ;; givenname and surname.
 ;;
 ;; (by the way: Cummings did _not_ in fact prefer to lowercase his name --
 ;; that was just a bit of typography which became a habit)
 ;;
 ;; I'm not sure what's the correct thing to do with a lowercase mononym:
 ;; parse it the same way as an uppercased one
 (assert-equal (parse/test "bell hooks and {bell} hooks and e e cummings and modest")
               '((("bell") #f ("hooks") #f)
                 (("{bell}") #f ("hooks") #f)
                 (("e" "e") #f ("cummings") #f)
                 (#f #f ("modest") #f)))
 ;; in this context, I feel I ought to be able to come up with cases
 ;; where the nominal case of a macro matters, but I can't right now

 ;; If there are more than four comma-separated parts, then warn but ignore them
 (assert-equal (parse/test "von Last, Jr, First, Extra")
               '((("First") ("von") ("Last") ("Jr"))))

 ;; ...as well as already-encoded ones
 (assert-equal (parse/test "Chuckïe dü Vallée")
               '((("Chuckïe") ("dü") ("Vallée") #f)))

 ;; delete...
 ;; ...but these shouldn't appear often, since the .bib parser decodes them:
 ;; (let ((el (parse-bibtex-string "@book{key, author={Charles Louis Xavier Joseph d{\\\"{u}} la Vall{\\'e}e Poussin}}")))
 ;;   (assert-equal (map author->list (parse-author-list (entry-field (car el) 'author)))
 ;;                 '((("Charles" "Louis" "Xavier" "Joseph")
 ;;                    ("dü" "la")
 ;;                    ("Vallée" "Poussin")
 ;;                    #f))))

 ;; ;; How about accehted characters at brace-level 0
 ;; (assert-equal (parse/test "G\\\"odel, Kurt and H{\\\"o}del, Jurt and {I{\\\"o}del}, Iurt")
 ;;               '((("Kurt") #f ("Gödel") #f)
 ;;                 (("Jurt") #f ("Hödel") #f)
 ;;                 (("Iurt") #f ("{Iödel}") #f)))
 ;; (config 'bib-authorlist-bracelevel1 1)
 ;; (assert-equal (parse/test "G\\\"odel, Kurt and H{\\\"o}del, Jurt and {I{\\\"o}del}, Iurt")
 ;;               '((("Kurt") #f ("G\\\"odel") #f)
 ;;                 (("Jurt") #f ("Hödel") #f)
 ;;                 (("Iurt") #f ("{I{\\\"}odel}") #f)))
 ;; (config 'bib-authorlist-bracelevel1 #f)

 ;; I think we have by now already tested everything in this following
 ;; one, as far as non-ASCII characters are concerned, but let's have
 ;; a go at a bit of a christmas-tree entry.
 ;;
 ;; Note that, here, the character "ý" is parsed as a lowercase letter.
 ;; Though I'm not currently aware of
 ;; any 'von' particles which start with accented letters.
 ;; Also, Chloë is included as Unicode directly.
 (assert-equal (parse/test "{\\TH}or {\\'y} {\\AA}ngstr{\\o}m and Chloë from Łodz")
               '((("Þor") ("ý") ("Ångstrøm") #f)
                 (("Chloë") ("from") ("Łodz") #f)))

 ;; Superfluous braces shouldn't get in the way
 (assert-equal (parse/test "Norman Gray and Norman {Gray} and {Gray}, Norman and Gray, Norman and others")
               '((("Norman") #f ("Gray") #f)
                 (("Norman") #f ("{Gray}") #f)
                 (("Norman") #f ("{Gray}") #f)
                 (("Norman") #f ("Gray") #f)
                 others))

 ;; I don't think the following is how you spell either of these in practice,
 ;; but it shouldn't throw off the parser
 (assert-equal (parse/test "LLoyd LLama")
               '((("LLoyd") #f ("LLama") #f)))

 ;; (expect-failure
 ;;  (parse-author-to-list "Norman Gray and others and Someone Else"))

 ;; work through a list of more or less odd names
 (assert-equal (parse/test "Ludwig von Beethoven")
               '((("Ludwig") ("von") ("Beethoven") #f)))
 (assert-equal (parse/test "van Beethovel, Lucius")
               '((("Lucius") ("van") ("Beethovel") #f)))
 (assert-equal (parse/test "{von Beethoven}, Ludwig")
               ;;(historically incorrect) overriding of von-part
               '((("Ludwig") #f ("{von Beethoven}") #f)))
 (assert-equal (parse/test "de Beethovini, Jr, Luciano")
               ;; von and junior
               '((("Luciano") ("de") ("Beethovini") ("Jr"))))
 (assert-equal (parse/test "d{\\'e}l Beethovini, Jr, Luciano and Bill d{\\'e}L Beethoven")
               ;; von-part including bstring-string and capitals
               '((("Luciano") ("dél") ("Beethovini") ("Jr"))
                 (("Bill") ("déL") ("Beethoven") #f)))
 ;; I think this is not supposed to work
 ;; (as a consequence of the {von Beethoven} behaviour, I think)
 ;; ("{d\\'al} Beethovini, Jr, Luciano"
 ;;  ("Beethovini") ("Luciano") ("{d\\'al}") ("Jr")))
 (assert-equal (parse/test "Jan van den Oort") ;multiple von-parts
               '((("Jan") ("van" "den") ("Oort") #f)))
 (assert-equal (parse/test "van den Oort, Josef") ;ditto, with comma
               '((("Josef") ("van" "den") ("Oort") #f)))

 (assert-equal (parse/test "Wayne von Thurn und Taxis")
               '((("Wayne") ("von") ("Thurn" "und" "Taxis") #f)))

 ;; The following looks right, but it doesn't appear to be specified
 ;; in the BibTeX spec (the 'y' isn't a von-part).
 ;; BibTeX parses this as having von-part "Riuz y" and Last "Picasso",
 ;; which I think is simply incorrect.
 (assert-equal (parse/test "Riuz y Picasso, Pablo de Paula")
               '((("Pablo" "de" "Paula") #f ("Riuz" "y" "Picasso") #f)))
 (assert-equal (parse/test "Riuz y Picasso, Jr, Pablo")
               '((("Pablo") #f ("Riuz" "y" "Picasso") ("Jr"))))

 ;; It seems that styling surname-initial double-F in lowercase is
 ;; either an affectation or a paleographical mistake, but we
 ;; shouldn't second-guess folk here.
 (assert-equal (parse/test "Fred ffoulkes")
               '((("Fred") #f ("ffoulkes") #f)))
 (assert-equal (parse/test "ffoulkes Maxwell, James")
               '((("James") ("ffoulkes") ("Maxwell") #f)))
 (assert-equal (parse/test "{ffoulkes} Maxwell, James")
               '((("James") ("{ffoulkes}") ("Maxwell") #f)))
 (assert-equal (parse/test "{ffoulkes Maxwell}, James")
               '((("James") #f ("{ffoulkes Maxwell}") #f)))

 ;;von-part with multiple surnames
 (assert-equal (parse/test "Nonsense von Brinch Hansen")
               '((("Nonsense") ("von") ("Brinch" "Hansen") #f)))


 ;; We do accept dots in names, so that "Jr." and dotted middle initials are OK
 (assert-equal (parse/test "Ford, Jr, Henry") ;suffix
               '((("Henry") #f ("Ford") ("Jr"))))
 (assert-equal (parse/test "Guy L. {Steele Jr.}") ;comma-less suffix
               '((("Guy" "L.") #f ("{Steele Jr.}") #f)))
 (assert-equal (parse/test "{Steele Also}, Guy L.")
               '((("Guy" "L.") #f ("{Steele Also}") #f)))
 (assert-equal (parse/test "Ford, the Third, Henry") ;lowercase Jr
               '((("Henry") #f ("Ford") ("the" "Third"))))

 (assert-equal (parse/test "Kurt G{\\\"o}del")
               '((("Kurt") #f ("Gödel") #f)))
 ;; I think I probably should allow the following, but BibTeX doesn't,
 ;; so we can avoid that lexing intricacy for the moment.
 ;; (assert-equal (parse/test "Kurt G\\\"odel") ;\" command not in braces
 ;;               '((("Kurt") #f ("G\\\"odel") #f)))
 ;; (assert-equal (parse/test "Stanis\\l{}av Lem") ;command with letter
 ;;               '((("Stanis\\l{}av") #f ("Lem") #f)))
 ;; (assert-equal (parse/test "Stanis\\polishL{}av Lem") ;long command with letters
 ;;               ;; (no, this command doesn't actually exist)
 ;;               '((("Stanis\\polishL{}av") #f ("Lem") #f)))
 (assert-equal (parse/test "Stanis{\\polishL}av Lem") ;and in braces
               '((("Stanis{\\polishL}av") #f ("Lem") #f)))

 ;; below, the dell'Agnello is not a von-part
 (assert-equal (parse/test "dell'Agnello, Luciano")
               '((("Luciano") #f ("dell'Agnello") #f)))
 (assert-equal (parse/test "Jones Smith dell'Agnello, Luciano")
               '((("Luciano") #f ("Jones" "Smith" "dell'Agnello") #f)))
 (assert-equal (parse/test "Jones Smith dell'Agnello, Jr Rtd, Luciano")
               '((("Luciano") #f ("Jones" "Smith" "dell'Agnello") ("Jr" "Rtd"))))
 (assert-equal (parse/test "dell'Agnello, Minimus, Luciano")
               '((("Luciano") #f ("dell'Agnello") ("Minimus"))))
 (assert-equal (parse/test "Luisa dell'Agnello")
               '((("Luisa") #f ("dell'Agnello") #f)))

 ;; The following two cases do not parse quite as I expect/hope, but since
 ;; it's an artificial case, I don't feel it's necessary to worry
 ;; about it
 ;; Similarly, I don't know what "von Last du Pont, First" should parse to!
 ;; (assert-equal (parse/test "dell'Agnello del'Angelus, Luciano") ;nor this
 ;;               '((("Luciano") #f ("dell'Agnello" "del'Angelus") #f)))
 ;; (assert-equal (parse/test "dell'Agnello del'Angelus, Minimus, Luciano") ; nor this
 ;;               '((("Luciano") #f ("dell'Agnello" "del'Angelus") ("Minimus"))))

 ;; The following is how ADS formats Lidia van Driel-Gesztelyi's name.
 ;; I assert that they're wrong about this (and I've reported it to
 ;; them), but we should aim not to fail in this case, and should probably
 ;; produce the same result as BibTeX.  See notes in dpc/beastie.md.
 (assert-equal (parse/test "{Driel-Gesztelyi}, Lidia van")
               '((("Lidia" "van") #f ("{Driel-Gesztelyi}") #f)))
 ;; Myles na gCopaleen is hard, not least because I don't know what
 ;; the correct analysis _should_ be, in language terms.  I think that
 ;; 'na' is a genitive particle, therefore similar to 'mac/nic' and 'von'.
 ;; I think.
 ;; In BibTeX terms, however (which are here the only ones that
 ;; matter), the following is how BibTeX parses this.  The key thing
 ;; from BibTeX's point of view (I think) is that there is _always_ a
 ;; Last name, even if it looks like a von-particle, starting with a
 ;; lowercase letter.
 (assert-equal (parse/test "Myles na gCopaleen")
               '((("Myles") ("na") ("gCopaleen") #f)))
 (assert-equal (parse/test "na gCopaleen, Myles")
               '((("Myles") ("na") ("gCopaleen") #f)))
 (assert-equal (parse/test "Myles na gCopaleen Smith")
               '((("Myles") ("na" "gCopaleen") ("Smith") #f)))
 (assert-equal (parse/test "na gCopaleen Smith, Myles")
               '((("Myles") ("na" "gCopaleen") ("Smith") #f)))
 (assert-equal (parse/test "na gCopaleen, XIV, Myles")
               '((("Myles") ("na") ("gCopaleen") ("XIV"))))

 (assert-equal (parse/test "Paidr{\\'{i}}g O{'}Donnell")
               ;;not a particularly sensible way of writing it...
               '((("Paidríg") #f ("O{'}Donnell") #f)))
 (assert-equal (parse/test "Billy {O'}Donnell")
               '((("Billy") #f ("{O'}Donnell") #f)))
 (assert-equal (parse/test "Fritz von {O'}Donnell")
               '((("Fritz") ("von") ("{O'}Donnell") #f)))

 ;; lots of odd whitespace
 (assert-equal (parse/test "Sidney   de   la  \t Spacey    Spider")
               '((("Sidney") ("de" "la") ("Spacey" "Spider") #f)))
 (assert-equal (parse/test "Launcelot
von
\tder
  Stepping  
Stone")
               '((("Launcelot") ("von" "der") ("Stepping" "Stone") #f)))

 (assert-equal (parse/test "Fran{\\c c}ois A Fa{\\c c}ade")
               ;;escape sequence with letter
               '((("François" "A") #f ("Façade") #f)))
 (assert-equal (parse/test "Fa{\\c c}ade, Fran{\\c c}ois B")
               '((("François" "B") #f ("Façade") #f)))
 (assert-equal (parse/test "{cummings}, {e e}")
               ;; names starting with lowercase letters
               '((("{e e}") #f ("{cummings}") #f)))
 (assert-equal (parse/test "{someone@teh.internets}")
               ;;marginal, but I think we should allow this
               '((#f #f ("{someone@teh.internets}") #f)))

 ;; A slightly tricky one, with 'and's here and there.
 ;;
 ;; I'd like "Andrew And and John Smith" to parse as Messrs And and Smith.
 ;; The btxdoc document (and the LaTeX Book and LaTeX Companion)
 ;; say that names are separated by "and": it doesn't mention anything
 ;; about case, but bibtex-the-program matches this _case-insensitively_,
 ;; and doesn't object to two "and" tokens in a row,
 ;; so parses this as Mr Andrew, a blank entry, and Mr Smith
 ;; (I can find no evidence of ‘And’ being an in-use surname,
 ;; but if there are people surnamed ‘Null’, there's bound to be
 ;; someone surnamed ‘And’).
 ;; I think this is nuts, and so Beastie defects from BibTeX in this
 ;; respect: "and" is matched only case-sensitively.
 ;; The same is true for "others", the ‘et al.’ marker.
 ;;
 ;; Having 'anders' as a von-part is obviously artificial,
 ;; but I should obviously still detect it as such.
 ;;
 ;; See also the bibtex-matching tests at the bottom.
 (assert-equal (parse/test "Bill Sand and Andrew And Andreas {Thurn and Taxis} and anders Surname, Sven")
               '((("Bill") #f ("Sand") #f)
                 (("Andrew" "And" "Andreas") #f ("{Thurn and Taxis}") #f)
                 (("Sven") ("anders") ("Surname") #f)))
 (assert-equal (parse/test "Bill Others and otherstone Surname, Ben and others")
               '((("Bill") #f ("Others") #f)
                 (("Ben") ("otherstone") ("Surname") #f)
                 others))

 ;; Reggie: a rather splendid person with a challenging surname.
 ;; I _think_ this is how this name should be split.
 (assert-equal (parse/test "Reginald von Zugbach de Sugg")
               '((("Reginald") ("von") ("Zugbach" "de" "Sugg") #f)))

 ;; this should also produce a warning
 (assert-equal (parse/test "") '())
)

(test-suite
 "Name formatting"
 (let ((test-name (car (parse-author-list "Aloysius Beowulf Zig"))))
   (assert-true (author? test-name))
   ;; (eprintf "Zig -> ~s and ~s~%" (map object->string (author-last test-name))
   ;;          (map object->string '(#{Zig})))
   (assert-equal (author-last test-name) '(#"Zig"))
   (assert-false (author-von test-name))

   (assert-exception (format-name "hello" test-name))
   (assert-equal (format-name '("before"
                                ("f(" first/i ")")
                                "1"
                                ("v(" von/i ")") ;shouldn't appear
                                "2"
                                ("l(" last/i ")")
                                "after")
                              test-name)
                 #"beforef(A.~B)12l(Z)after")
   ;; now with initials, and to-be-bstring format strings
   (assert-equal (format-name '("béfore"
                                ("f(" first ")" :sep "¶")
                                "1"
                                ("v(" von ")")
                                "2"
                                ("ł(" last ")")
                                "after")
                              test-name)
                 #"béforef(Aloysius¶Beowulf)12ł(Zig)after")
   (assert-equal (format-name '((first) (von) (last)) test-name)
                 #"Aloysius BeowulfZig")
   (assert-equal (format-name '((first/i) (von/i) (last/i) (last)) test-name)
                 #"A.~BZZig")
   (assert-equal (format-name '((first/i :sep ":") (:sep "+" "-" first) ("=" last)) test-name)
                 #"A:B-Aloysius+Beowulf=Zig"))

 (let ((aa (parse-author-list "Aloysius Zig and {Barnes and Noble} and others")))
   (assert-equal (map (λ (n)
                        (format-name '(("f(" first ")")
                                       ("v(" von ")")
                                       ("l(" last ")"))
                                     n))
                      aa)
                 '(#"f(Aloysius)l(Zig)"
                   #"l({Barnes and Noble})"
                   #"et al.")))

 ;; btxdoc.pdf describes the following
 (let ((test-name (car (parse-author-list "Jean-Paul Fred-Claude-Percy Sartre"))))
   (assert-equal (format-name '((first/i) ". " (last)) test-name)
                 #"J.-P. F.-C.-P. Sartre")))

(test-suite
 "Parsing format-strings"

 ;; the test below includes brace-level-0 NONFMTLETTER, FMTLETTER, OTHERCHAR,
 ;; and then all three (cf, lexer)
 (assert-equal (parse-fmtstring "a{vv~}f{ll}~{, jj}af~{, f}?")
               '("a" (von nbsp?) "f" (last) "~" (", " junior) "af~" (", " first/i) "?"))
 (assert-equal (parse-fmtstring "{v{}}{l{}}")
               '((von/i :sep "") (last/i :sep "")))

 ;; 'f' is not a format-spec at brace-level-2
 (assert-equal (parse-fmtstring "a{f{xf}}b")
               '("a" (first/i :sep "xf") "b"))

 ;; the following format strings are invalid, so we should
 ;; evaluate to a default format, plus a warning in each case,
 ;; and the result should be the default format
 (let ((nw (print-warning 'get-count)))
   (assert-equal (parse-fmtstring "1{{3}ff~}5")
                 ;; separator before format-spec
                 '((first) (von) (last) (", " junior)))
   (assert-equal (parse-fmtstring "a{fl}b") ;two format-symbols: fails
                 '((first) (von) (last) (", " junior)))
   (assert-equal (parse-fmtstring "")   ;empty
                 '((first) (von) (last) (", " junior)))
   (assert-equal (parse-fmtstring "a{}b") ;missing format-spec in braces
                 '((first) (von) (last) (", " junior)))

   (assert-equal (- (print-warning 'get-count) nw) 4)))

(define (do-format-name btx-format-string idx author-string)
  (let ((author-list (parse-author-list author-string))
        (fmtstring (parse-fmtstring btx-format-string)))
    (let ((res (format-name fmtstring (list-ref author-list (- idx 1)))))
      #;(eprintf "format.name$: ~s -> ~s~%  ~s -> ~s~%  -> ~s~%"
               author-string author-list
               btx-format-string fmtstring
               res)
      (list res))))

;; Within btx-test-suite, the macro (testbtx label btx-function stack expected)
;; applies the btx-function to the given stack, and expects the given result.
;; For visual clarity, 'expected' is given as a string, to be converted to a ustring.
(define-macro (btx-test-suite label . body)
  `(let ((format.name$ do-format-name)
         (testbtx (macro (label func input expected)
                    `(testbtx* ,label
                               (,func . ,input)
                               (map make-ustring (quote ,expected))))))
     (test-suite ,label
                 (define (testbtx* label actual expected)
                   (assert-equal label actual expected))
                 . ,body)))

(btx-test-suite
 "Matching formatting with BibTeX"
 ;; from btxhak: compared to bibtex 0.993
 ;;
 ;; The precise details of what BibTeX produces aren't crucial,
 ;; in part because btxhak is studiously vague about what it's
 ;; supposed to do (‘if it thinks there's a need for one’), and the
 ;; BibTeX element of this test is mostly to discover what BibTeX
 ;; thinks is sane here.  The tests here should match what beastie
 ;; produces, rather than necessarily what BibTeX does.  To confirm
 ;; what bibtex actually does, though, do (cd test;make bibtex-comparison) and
 ;; look at the 'failing' tests in tmp-comparison/test-authorlist.blg
 ;;
 ;; The cases where BibTeX behaves differently are
 ;; marked with "bibtex: xxx" below.
 (testbtx "ABCDOuse1"
          format.name$
          ("{f~~}{vv~}{ll}" 1 "Aloysius Beauchamp Cholmondeley Derek von der Ouse")
          ;; bibtex: A.~B. C.~D~von~der Ouse
          ;; I don't understand why there's the tie between 'von' and
          ;; 'der', because BibTeX (fragment 417) seems to regard
          ;; three characters as 'long'.
          ;; I'm happy to regard BibTeX as mad here.
          ("A.~B. C.~D~von der Ouse"))
 (testbtx "ABCDOuse2"
          format.name$
          ("{f~}{vv~~}{ll}" 1 "Aloysius Beauchamp Cholmondeley Derek von der Ouse")
          ;; bibtex: A.~B. C.~D von~der~Ouse
          ;; (ditto)
          ("A.~B. C.~D von der~Ouse"))
 (testbtx "Poussin"
          format.name$
          ("{vv~}{ll}{, jj}{, f}?" 1 "Charles Louis Xavier Joseph de la Vallée Poussin")
          ;; bibtex: "de~la Vall{\’e}e~Poussin, C. L. X.~J?"
          ;; ...but the tie between the surnames seems entirely redundant.
          ;;
          ;; Also, btxhak, describing this precise case, says that it
          ;; should produce "de~la Vall{\’e}e~Poussin, C.~L. X.~J?"
          ("de~la Vallée Poussin, C.~L. X.~J?"))
 (testbtx "braced-middle"
          format.name$
          ("{vv}|{ll}|{ff}" 1 "First {Middle} Last")
          ;; bibtex: |Last|First~{Middle}
          ;; I more-or-less match BibTeX here (but see the discussion
          ;; above).  I don't really see the point of that tie,
          ;; though, so I'm not going to exert myself to match it
          ;; until I do.
          ("|Last|First {Middle}"))
 ;; the next two tests are from tugboat.bst (qv)
 (testbtx "tugboat0"
          format.name$
          ("{f~}{vv~}{ll}{, jj}" 1 "Alpha Bravo Charlie")
          ("A.~B Charlie"))
 (testbtx "tugboat1"
          format.name$
          ("{f{.}.~}{vv~}{ll}{, jj}" 1 "Alpha Bravo Charlie")
          ("A.B. Charlie"))
 (testbtx "tugboat2"
          format.name$
          ("{f{.}.~~}{vv~}{ll}{, jj}" 1 "Alpha Bravo Charlie")
          ("A.B.~Charlie"))
 (testbtx "jean-paul"
          format.name$
          ("{f{.}~}{ll}" 1 "Jean-Paul Sartre")
          ;; bibtex: J.P Sartre
          ;; See discussion in format-name-part*, within authors.scm.
          ("J.-P Sartre"))

 ;; As above, I have decided _not_ to follow BibTeX in identifying
 ;; "and" as an author-separator case-insensitively.
 ;; Now, only "and" separates authors.
 ;;
 ;; All three of the following therefore don't match BibTeX's behaviour
 (let ((aa #"Andrew And and Andreas {Thurn and Taxis} and anders Surname, Sven")
       (fmt "{ff}|{vv}|{ll}"))
   (testbtx "Andrews1"
            format.name$
            (fmt 1 aa)
            ;; bibtex: ||Andrew
            ("Andrew||And"))
   (testbtx "Andrews2"
            format.name$
            (fmt 2 aa)
            ;; bibtex: ||
            ("Andreas||{Thurn and Taxis}"))
   (testbtx "Andrews3"
            format.name$
            (fmt 3 aa)
            ;; bibtex: Andreas||{Thurn and Taxis}
            ("Sven|anders|Surname")))

 )

(exit/failures)
