;; Run bib-parsing test cases.
;;
;; Each .bib file passed as argument must have a (check ...) form in it,
;; the body of which is evaluated in a context in which DB
;; is the parsed database.
;;
;; If no file names are given as arguments (the usual case), then read
;; all of the files bib-*.bib
;;
;; 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" 'bibtex 'authors 'unicode 'json)

(print-warning 'push #f)
(set! (*s7* 'stacktrace-defaults) '(6 45 80 45 #f)) ;no effect?

;; helper functions

(define/provide (entry->list/debug e)
  ;(eprintf "entry->list/debug: ~s~%" e)
  `(,(entry-type e)
    ,(entry-key e)
    . ,(let ((l (entry-fields/alist e)))
         (sort! l
                (λ (a b)
                  (symbol<? (car a) (car b)))))))

;; the tests...

(test-suite
 "bib lexing"
 (module/expose 'parse-bib2*)           ;for make-biblex*

 (define (drain-lexemes lexer)
   (let ((l (lexer)))
     (if (eof-object? l)
         '()
         (cons l (drain-lexemes lexer)))))

 (define-macro (assert-lexemes str lexeme-list)
   `(let ((res (drain-lexemes (make-biblex* (make-unicode-reader/string ,str)))))
      (assert-equal ,str res ,lexeme-list)))

 (assert-lexemes "@article{key}"        ;simple base-case
                 '((entry-type . #"article")
                   (entry-open-brace)
                   (unquoted-string . #"key")
                   (entry-close-brace)))
 (assert-lexemes "omitted @ ARTICLE {foo,=#\"bar\" \"\" {}} @book" ;inter-entry text, no entry after @-part
                 '((entry-type . #"ARTICLE")
                   (entry-open-brace)
                   (unquoted-string . #"foo")
                   (comma)
                   (equals)
                   (hash)
                   (quoted-string . #"bar")
                   (quoted-string . #"")
                   (quoted-string . #"")
                   (entry-close-brace)
                   (entry-type . #"book")))
 (assert-lexemes "a @comment (x @b }(foo) %x\n) @a{} @CoMmEnT @b {} @COMMENT   (x }) @commen {x} @COMMENTX {}@d"
                 '((entry-type . #"a")            ;various comments and nearly-comments
                   (entry-open-brace)
                   (entry-close-brace)
                   (entry-type . #"b")
                   (entry-open-brace)
                   (entry-close-brace)
                   (entry-type . #"commen")
                   (entry-open-brace)
                   (unquoted-string . #"x")
                   (entry-close-brace)
                   (entry-type . #"COMMENTX")
                   (entry-open-brace)
                   (entry-close-brace)
                   (entry-type . #"d")))
 (assert-lexemes "@preamble  {} @include{foo} @string{}"
                 '((preamble)
                   (entry-open-brace) (entry-close-brace)
                   (include) (entry-open-brace) (unquoted-string . #"foo") (entry-close-brace)
                   (stringdef) (entry-open-brace) (entry-close-brace)))
 (assert-lexemes "ignored @{} @ @ article{} @1{}"
                 ;; an @ followed by a non-letter is regarded as inter-entry text,
                 ;; and ignored
                 '((entry-type . #"article")
                   (entry-open-brace)
                   (entry-close-brace)))

 ;; braces immediately inside "quotes"
 (assert-lexemes "@article{\"{braced}\" content}"
                 '((entry-type . #"article")
                   (entry-open-brace)
                   (quoted-string . #"{braced}")
                   (unquoted-string . #"content")
                   (entry-close-brace)))

 (define (->utf8 . rest)
   (apply string-append
          (map (λ (s/i)
                 (if (string? s/i)
                     s/i
                     (unicode-encode1/utf8 s/i)))
               rest)))
 ;; assorted %-comments
 (assert-lexemes (->utf8 "@a{  % ignored\n  b%x\n  =  %x\r\n\"c\"%x\n" ;whitespace around comments
                         "%," #xa       ;terminates a comment
                         "c2\n"
                         "d%d1" #xb     ;VT
                         "d2\n"         ;should see this, since the VT terminated the comment
                         "e%e1" #xc     ;FF
                         "e2\n"
                         "f%f1" #x85    ;NEL
                         "f2\n"
                         "g%g1" #x2028  ;LS
                         "g2\n"
                         "h%h1" #x2029  ;PS
                         "h2\n"
                         "{i" #xb       ;in a string
                         "j" #xc        ;VT
                         "k" #xd        ;FF
                         "l" #x85       ;NEL
                         "m" #x2028
                         "n" #x2029
                         "o} }")
                 `((entry-type . #"a")
                   (entry-open-brace)
                   (unquoted-string . #"b")
                   (equals)
                   (quoted-string . #"c")
                   (unquoted-string . #"c2")
                   (unquoted-string . #"d") (unquoted-string . #"d2")
                   (unquoted-string . #"e") (unquoted-string . #"e2")
                   (unquoted-string . #"f") (unquoted-string . #"f2")
                   (unquoted-string . #"g") (unquoted-string . #"g2")
                   (unquoted-string . #"h") (unquoted-string . #"h2")
                   (quoted-string . ,(make-ustring
                                      (->utf8 "i" #xb
                                              "j" #xc
                                              "k" #xd
                                              "l" #x85
                                              "m" #x2028
                                              "n" #x2029
                                              "o")))
                   (entry-close-brace)))
 (assert-lexemes "@a(b,c={d{e)}f},g=\"}h\")" ;end-braces inside quoted-strings
                 '((entry-type . #"a")
                   (entry-open-brace)
                   (unquoted-string . #"b")
                   (comma)
                   (unquoted-string . #"c")
                   (equals)
                   (quoted-string . #"d{e)}f")
                   (comma)
                   (unquoted-string . #"g")
                   (equals)
                   (quoted-string . #"}h")
                   (entry-close-brace)))
 (assert-lexemes "@book{key, a={F{\\o}o\\\"\\}}, b=\"a\\\\\\\"b[]\"}}"
                 '((entry-type . #"book")
                   (entry-open-brace)
                   (unquoted-string . #"key")
                   (comma)
                   (unquoted-string . #"a")
                   (equals)
                   (quoted-string . #"F{\\o}o\\\"\\}")
                   (comma)
                   (unquoted-string . #"b")
                   (equals)
                   (quoted-string . #"a\\\\\\\"b[]")
                   (entry-close-brace)))
 ;; see discussion of these characters below:
 ;; '¢' is a symbol, 'ߧ' and 'अ' are letters
 (assert-lexemes "@book{¢ߧअ , ¢ߧअ={¢ߧअ}}"
                 '((entry-type . #"book")
                   (entry-open-brace)
                   (unquoted-string . #"¢ߧअ")
                   (comma)
                   (unquoted-string . #"¢ߧअ")
                   (equals)
                   (quoted-string . #"¢ߧअ")
                   (entry-close-brace)))
 (assert-lexemes "@a{"                  ;EOF in entry
                 '((entry-type . #"a")
                   (entry-open-brace)))
 (assert-lexemes "@a{{value"            ;EOF in quoted-string
                 '((entry-type . #"a")
                   (entry-open-brace)))

 ;; proper EOF behaviour
 (for-each (λ (str)
             (assert-equal ((make-biblex* (make-unicode-reader/string str))) #<eof>))
           '(""
             "@comment"
             "@comment {"
             "\"foo"
             "{foo")))

;; parse the collection of test/*.bib files, and run the tests internal to them

;; parsing things to a list is more convenient to test
;; than the hash that comes back from parse-bibtex-string
(define (parse-bibtex-string/list s)
  (map cdr (parse-bibtex-string s)))

;; macro CHECK: evaluate the body, which will include calls to
;; (assert-equal ...), which calls bail-out if there's an error.
;; Returns the actual and expected consed together.
(define-macro (check . body)
  `(lambda (DB label)
     (test-suite label . ,body)))

;; The following has to be a macro,
;; since macro assert-equal works only inside a test-suite.
(define-macro (assert-field entry key expected-string-value . label)
`(let ((f (entry-field ,entry ,key)))
   (if f
       ,(if (null? label)
            `(assert-equal f ,expected-string-value)
            `(assert-equal ,(car label) f ,expected-string-value))
       (begin
         ;; this is either a badly-written test, or (what prompted
         ;; its addition) a mysteriously missing value
         (eprintf "assert-field: key ~s unexpectedly missing from entry ~s~%"
                  ,key ,entry)
         (assert-fail ,label)))))

(test-suite
 "bib files"

 ;; *command-line* at this point is ("test-bib.scm" ...),
 ;; or ("s7unit.scm" "test-bib.scm" ...)
 ;; or ("s7unit.scm" "test-bib.scm:bib files").
 ;; Discover if there are some bib files named in the command line,
 ;; and test them if so;
 ;; otherwise, test all of the files bib-*.bib in the current directory.
 (catch
     #t
   (lambda ()
     (define (is-bib-test-file? fn)
       ;; does the file name match "bib-*.bib"?
       (let ((fnlen (string-length fn)))
         (and (> fnlen 8)
              (string=? (substring fn 0 4) "bib-")
              (string=? (substring fn (- fnlen 4) fnlen) ".bib"))))
     (let ((arg-bib-files (filter is-bib-test-file? *command-line*)))
       (for-each (lambda (bibfilename)
                   (clear-preamble*!)
                   (bib-string-table '*reset-for-tests*) ;magic value
                   (let ((bib (parse-bibtex-file bibfilename)))
                     ;; bib is a hash symbol? -> entry?
                     (if bib
                         (let* ((testcases ;read the (check ...) form at the top of the file
                                 (with-input-from-file bibfilename read))
                                (body (eval testcases)))
                           (body bib bibfilename))
                         (eprintf "can't parse test file ~a !~%" bibfilename))))
                 (if (null? arg-bib-files)
                     (sort! (filter is-bib-test-file? (directory->list "."))
                            string<?)
                     arg-bib-files))))
   (lambda (tag fmt . rest)
     ;; I think I have become inconsistent about what enclosed errors throw,
     ;; so don't be clever here
     (format (current-error-port)
             "unexpected error processing bib file:~%  tag=~s~%  fmt=~s~%  rest=~s~%"
             tag fmt rest)
     ;; (let ((msg (apply format #f fmt)))
     ;;   (format (current-error-port) "unexpected error (~a) processing bib file: ~a~%~a~%"
     ;;           tag msg (stacktrace)))
     #f)))

(test-suite
 "tortured line-endings"
 ;; check that we can successfully parse bib-t03-torture.bib with different line-endings
 (let* ((fn "bib-t03-torture.bib")
        (tests (eval (with-input-from-file fn read)))
        (lines (file->list-of-lines fn)))
   (for-each (λ (newline)
               (let ((bib (sort! (parse-bibtex-string/list (string-join lines newline)) entry<?)))
                 (assert-equal "torture-with-newlines"
                               (and (not (null? bib))
                                    (entry->list/debug (car bib)))
                               '(article cite-key (author . #"Poussin") (number . #"99")))))
             (list "\r"
                   "\r\n"
                   (unicode-encode1/utf8 #x85)   ;NEL
                   (unicode-encode1/utf8 #x2028) ;LINE SEPARATOR
                   (unicode-encode1/utf8 #x2029))))) ;PARAGRAPH SEPARATOR

;; further tests, on the entry-related functions defined in runtime.scm
(test-suite
 "entry-* functions"
 (let* ((el (parse-bibtex-string/list
             "@article{citation1, a1={First Last}}"))
        (e0 (car el)))

   (assert-true (entry? e0))
   (assert-equal (entry-type e0) 'article)
   (assert-equal (entry-key e0) 'citation1)

   (assert-field e0 'a1 #"First Last")
   (assert-false (entry-get-local-variable e0 'a1))
   (entry-set-local-variable! e0 'a1 "att1")        ;same name as field
   (assert-field e0 'a1 #"First Last") ;still
   (assert-equal (entry-get-local-variable e0 'a1) "att1")

   (assert-false (entry-get-local-variable e0 'unknown))))

(test-suite
 "other parsing tests"

 ;; quotes at brace-level 1 don't end the string
 (let* ((el (parse-bibtex-string/list
             "@book(key,author={Aloysius Bloggs}, title=\"Things {\"said\"}\")"))
        (e0 (car el)))
   (assert-equal (entry-key e0) 'key)
   (assert-field e0 'author #"Aloysius Bloggs")
   ;(assert-field e0 'title  "Things {\"said\"}")
   (assert-field e0 'title #"Things {\"said\"}"))

 (let* ((el (parse-bibtex-string/list
             "@article{key,author=\"{Al Bloggs}\", title={\"Title\"}, journal={{Journal}}}"))
        (e0 (car el)))
   (assert-field e0 'author #"{Al Bloggs}")
   (assert-field e0 'title #"\"Title\"")
   (assert-field e0 'journal #"{Journal}"))

 ;; other more or less odd cases (more to come...)
 ;; odd but valid citation keys
 (let ((el (parse-bibtex-string/list
            "@book(a&s_:.+/, author=\"Bloggs\")")))
   (if el
       (assert-equal (entry-key (car el)) (string->symbol "a&s_:.+/"))
       (assert-fail "can't parse interesting characters as citation keys")))
 ;; odd but valid field names
 (let ((el (parse-bibtex-string/list
            "@book{key, Aa-ö={value}, a-b_c.d:e={value}}")))
   (assert-false (null? el))
   (assert-equal (entry-field (car el) 'aa-ö) #"value")
   (assert-false (entry-field (car el) 'Aa-ö))
   ;; we accept both [-_] in field names (now)
   (assert-equal (entry-field (car el) 'a-b_c.d:e) #"value"))
 ;; sample invalid citation key and field names
 (let ((el (parse-bibtex-string/list
            "@book{key#, author=\"Bloggs\"}")))
   ;; '#' isn't allowed in a key
   (assert-true (null? el)))
 (let ((el (parse-bibtex-string/list
            "@book{key, author#name = {value}}")))
   ;; '#' isn't allowed in a field name
   (assert-true (null? el)))

 ;; If we try to define a string in terms of itself --
 ;; that is, @string{s = "foo" # s} --
 ;; then we currently silently regard the 's' as undefined,
 ;; so the above would define 's' as "foos".
 ;; A reasonable alternative would be to raise an error.
 ;; btxdoc.pdf doesn't say what happens in this case.
 ;;
 ;; We should regard this as currently unspecified, and not test it either way.
 #;(assert-exception (parse-bibtex-string/list
                    "@string{s4 = \"hello\" # s4} @article{key, author=s4}"))

 ;; accented characters:
 ;;
 ;; The contents of .bib fields are lexed by parse-bib,
 ;; and internally to that they are promptly
 ;; re-parsed using the parse-subtex parser.  It's
 ;; therefore slightly intricate what should come out of the other
 ;; end, but the idea is that this is as TeX-decoded as we want or
 ;; need to be at this stage.  The tests below are _slightly_
 ;; provisional, therefore, as they're also me working out what is
 ;; right and wrong here.
 ;;
 ;; Note that BibTeX documents itself as behaving differently when
 ;; escape sequences are in specifically one level of braces.  Because
 ;; of the escaping/conversion we do here, I don't think we have to
 ;; care about that -- it's mostly there so that BIbTeX can count
 ;; characters in a particular way.  The tests next after these ones
 ;; represent an earlier version of the logic here (prior to September
 ;; 2024), which I'll retain for reference, until I'm more certain
 ;; that the current logic is a better way of doing things.
 ;;
 ;; The tests here overlap with similar ones in test-subtex.scm, but
 ;; we're additionally testing the interaction with surrounding
 ;; braces, quotes and bib parse failures.
 (let ((cmp (macro (bibstring expected-author)
              `(let ((e (car (parse-bibtex-string/list ,bibstring))))
                (assert-field e 'author ,expected-author ,bibstring)))))
   (cmp "@book{key, author={B\\aa b G\\\"odel}}" #"Båb Gödel")
   (cmp "@book{key, author=\"B{\\aa}b {G{\\\"o}del}\"}" #"Båb {Gödel}")
   ;; escaped double-quote and '}'
   ;; FIXME: doesn't work – see 'escaped braces' test in test-subtex.scm
   ;; (cmp "@book{key, author={F{\\o}o\\\"\\}}}" "Føo[\\\"{[\\}]}]")
   ;; ;; ditto ...inside a quoted field
   ;; (cmp "@book{key, author=\"F\\o o\\\"\\}\"}" "Føo[\\\"{[\\}]}]")
   ;; inside maths, nothing should be expanded
   (cmp "@book{key, author={B\\aa r$1\\\"e\\\"$}}" #"Bår$1\\\"e\\\"$")
   ;; and we don't get confused by unmatched $...$
   (cmp "@book{key, author={Bar$1\\\"e\\\"}}" #"Bar$1\\\"e\\\"")
   ;; the following test represents the current behaviour,
   ;; but as long as this doesn't collapse, I'm not particularly
   ;; committed to one result, rather than an unexpanded one
   (cmp "@book{key, author={B\\aa r$e}}" #"Bår$e")
   )

 ;; Unicode entry keys, and various other unicode tests.
 ;; I've taken inspiration from the tests collected by Markus Kuhn at
 ;; https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt
 ;;
 ;; '¢'=U+A2 or '£'=U+A3 are the lowest letter-like codepoints
 ;; (U+A0 is NBSP, which I'm uncertain about  permitting, and U+A1 is
 ;; upside-down-exclamation);  character 'ߧ'=U+07e7 is 'NKO LETTER NYA
 ;; WOLOSO' and is nearly the last 2-byte-encoded letter, 'अ'=U+0905
 ;; is the first uncomplicated letter encoded into 3 bytes, and
 ;; '𐀀𐀀'=U+10000 is 'LINEAR B SYLLABLE B008 A', and is the first encoded in 4 bytes
 ;; We do not deem the latter to be a letter, so it's not allowed to be in an entry key.
 ;; The cent sign, '¢', is a symbol, and so is allowed in a key (but not in a field name)
 ;;
 ;; 'عنوان' is (I think) Arabic for 'title'.
 ;;
 ;; On that theme, 'शीर्षक' is Hindi for 'title'.
 ;; Complication: this word includes character U+094d (DEVANAGARI SIGN VIRAMA),
 ;; which is used to cancel the vowel inherent in a character,
 ;; but which the UCD says is not an alphabetic character (it's class Mn).
 ;; This case is why there is a function `uchar-word-character?`,
 ;; distinct from `uchar-alphabetic?`.
 (let ((db (parse-bibtex-string
            "@booka{éa¢, शीर्षक={Hindi}} @bookb{   a~é, عنوان={Arabic}} @bookc{\n¢ߧअ, ߧअ={¢ߧअ𐀀}}")))
   (let ((e (db 'éa¢)))
     (assert-true e)
     (assert-field e 'शीर्षक #"Hindi"))
   (let ((e (db 'a~é)))
     (assert-true e)
     (assert-field e 'عنوان #"Arabic"))
   (let ((e (db '¢ߧअ)))
     (assert-true e)
     (assert-field e ' ߧअ #"¢ߧअ𐀀")))

 ;; entry types and field names are downcased when they are converted to symbols;
 ;; keys and string content are not
 (let ((el (car (parse-bibtex-string/list "@ÉAb{ÉAb, ÉAb={ÉAb}}"))))
   (assert-equal (entry-type el) 'éab)
   (assert-equal (entry-key el) 'ÉAb)
   (assert-false (entry-field el 'ÉAb))
   (assert-field el 'éab #"ÉAb"))

 ;; empty values
 (let ((el (car (parse-bibtex-string/list "@article{k, title={T}, author={}, editor=\"\"}"))))
   (assert-field el 'title #"T") ;...as usual
   (assert-field el 'author #"")
   (assert-field el 'editor #""))

 ;; the following are various errors and pathological cases

 ;; (string/bytes "foo" 1) is converted to a string containing bytes (#x66 #x69 #x69 #x1)
 (define (string/bytes . s/i)           ;s/i is string or integer
   (byte-vector->string
    (apply byte-vector
           (apply append
                  (map (λ (b)
                         (if (string? b)
                             (map char->integer (string->list b))
                             (list b)))
                       s/i)))))
 (define (parse-bibtex-string/bytes . s/i)
   (parse-bibtex-string/list
    (apply string/bytes s/i)))

 ;; These equality tests have to be done by ustring=?, as above
 ;; (the ICU decoder does end up producing a lot of replacement-characters!)
 (define (dblist->fields db)
   (cddar db))

 (let ((fields
        (dblist->fields
         (map entry->list/debug
              (parse-bibtex-string/bytes "@book{k, a={over"
                                         #xe0 #x80 #xaf ;overlong sequence
                                         "long}}")))))
   ;; The input to dblist->fields is
   ;; '((book k (a . "over�long"))) or '((book k (a . "over���long")))
   ;; depending on whether this is ICU or not.
   ;; The following test cases match the ICU version, because the
   ;; :collapse-replacements option doesn't work in that case.
   (assert-true (ustring=? (cdar fields)
                           #"over���long"
                           :collapse-replacements)))

 (let ((fields
        (dblist->fields
         (map entry->list/debug
              (parse-bibtex-string/bytes "@book{k, a={surrogate"
                                         #xed #xa0 #x80 #xed #xb0 #x80
                                         "pair}}")))))
   (assert-true (ustring=? (cdar fields)
                           #"surrogate������pair"
                           :collapse-replacements)))

 (let ((fields
        (dblist->fields
         (map entry->list/debug
                    (parse-bibtex-string/bytes "@book{k, a={out of"
                                               #xf4 #x90 #x80 #x80
                                               ;; decodes to U+110000, out of range
                                               "range}}")))))
   (assert-true (ustring=? (cdar fields)
                           "out of����range"
                           :collapse-replacements)))
 (assert-equal "malformed start byte"
               ;; It wouldn't be unreasonable to return #f here, indicating a parse
               ;; failure, on the grounds that this is simply flatly wrong unicode.
               ;; In fact, we recover with the replacement character, as above.
               (map entry->list/debug
                    (parse-bibtex-string/bytes "@book{k, a={bad"
                                               #xff ;unexpected: not #b11110xxx
                                               "start}}"))
               '((book k (a . #"bad�start"))))

 ;; (config 'bib-scan-all-extra 1)
 ;; (let ((el (parse-bibtex-string/list "@book(key, author={{G{\\\"o}del}})")))
 ;;   (assert-equal (entry-field (car el) 'author) "{Gödel}"))
 ;; (config 'bib-scan-all-extra #f)

 ;; Various malformed ones: confirm these do fail, with warnings.
 ;; I'm not 100% sure that the error behaviour is right here,
 ;; and wonder if these should throw (or rather, let through) the
 ;; exception, rather than simply discarding them
 ;;
 ;; missing citation key
 (assert-equal (parse-bibtex-string/list "@book{author=\"Fred\"}") '())
 ;; 'citation key' is a string
 (assert-equal (parse-bibtex-string/list "@book{\"key\", author=\"Fred\"}") '())
 ;; missing final brace to entry
 (assert-equal (parse-bibtex-string/list "@book{key, author={Unmatched}") '())
 ;; invalid characters in the key, which can be alnum, symbol or in the set [:.+/_&-]
 (assert-equal (parse-bibtex-string/list "@book{k*, a={b}}") '())
 ;; '§' is Unicode punctuation, so can't be in a key
 (assert-equal (parse-bibtex-string/list "@book{k§, a={b}}") '())
 ;; '¢' is a symbol, so can't be in a field name
 (assert-equal (parse-bibtex-string/list "@book{k, a*={b}}") '())
 (assert-equal (parse-bibtex-string/list "@book{k, a¢={b}}") '())

 ;; Non-errors:
 ;; these are things which are arguably errors, and which were caught
 ;; in earlier versions of this parse, but which this version doesn't
 ;; object to.  Perhaps it should, or perhaps these are things which
 ;; we should leave to be caught as TeX errors downstream.
 ;;
 ;; Retain the tests for reference, or for future changes of mind.

 ;; extra trailing brace -- no, not an error, since the trailing brace
 ;; is parsed as inter-entry-text
 ;(assert-equal (parse-bibtex-string/list "@book{key, author={Extra}}}") '())

 ;; missing final brace within value
 ;(assert-exception (parse-bibtex-string/list "@book{key, author=\"{Unmatched\"}"))

 ;; extra final brace in value
 ;(assert-exception (parse-bibtex-string/list "@book{key, author=\"{Unmatched}}\"}"))
 )

(test-suite
 "check-missing, and writing"
 (let ((entries
        (parse-bibtex-string
                #"""
@article{r1, author={r1author}, title={r1title},
             journal={r1journal}, year={r1year}}
               note: complete
@article{r2, author={r2author}, title={r2title}, journal={r2journal}}
               note: missing year
@inbook{r3,  author={r3author}, title={r3title}, chapter={r3chapter},
             publisher={r3publisher}, year={r3year},
             volume={r3volume}, unknown={r3unknown}}
               note: complete; volume not required, plus unknown field
@inbook{r4,  editor={r4editor}, title={r4title}, pages={r4pages},
             publisher={r4publisher}, year={r4year}}
               note: complete
@inbook{r5,  title={r5title}, pages={r5pages},
             publisher={r5publisher}, year={r5year}}
               note: missing author/editor
@inbook{r6,  editor={r6editor}, title={r6title},
             publisher={r6publisher}, year={r6year}}
               note: missing chapter/pages
@software{r7, author={r7author}}
               note: non-standard entry type, so deemed complete
""")))
   (assert-equal (entry-missing-fields (entries 'r1)) #f)
   (assert-equal (entry-missing-fields (entries 'r2)) '(year))
   (assert-equal (entry-missing-fields (entries 'r3)) #f)
   (assert-equal (entry-missing-fields (entries 'r4)) #f)
   (assert-equal (entry-missing-fields (entries 'r5)) '((author editor)))
   (assert-equal (entry-missing-fields (entries 'r6)) '((chapter pages)))
   (assert-equal (entry-missing-fields (entries 'r7)) #f))

 (let* ((db (parse-bibtex-string
                  #"""
                  @string{ t1 = "the titl{\'e} and \more"}
                  @article{r1, author={r1author}, title=t1,
                    monthyear = feb # "1999", month=feb, year=1999}
                  """))
        (entries (map cdr db)))
   (assert-true (list? entries))
   (let ((e1 (car entries)))
     ;; The following test is partly testing formatting, so is fragile
     ;; (the precise formatting doesn't much matter).
     ;;
     ;; Note that the fact that the 'feb' was a string doesn't round-trip.
     ;; Is that a bad thing?  I feel it possibly is,
     ;; but I'm not sure how much I want to care about it.
     ;; It would require quite a substantial rewrite of
     ;; parse-bib2.scm to change this.
     (assert-equal (with-output-to-string
                     (λ ()
                       (entry-print! e1)))
                   #"""
                   @article{r1,
                     author = {r1author},
                     title = {the titlé and \more},
                     year = {1999},
                     month = {feb},
                     monthyear = {feb1999}}

                   """)

     (with-fields-from-entry e1
         (author)                       ;present -- no warning
         (missing)                      ;absent but optional -- no warning
       (assert-equal author #"r1author")
       (assert-false missing))
     (let ((nw (print-warning 'get-count)))
       (with-fields-from-entry e1
           (missing author)             ;one missing -- prints a warning
           ()
         (assert-equal missing #"MISSING") ;ensure required value is non-#f
         (assert-equal author #"r1author"))
       (with-fields-from-entry e1
           ((foo author bar))         ;only one is missing -- no warning
           ()
         (assert-false foo)
         (assert-equal author #"r1author")
         (assert-false bar))
       (with-fields-from-entry e1
           ((foo bar))               ;both missing -- prints a warning
           ()
         (assert-equal foo #"FOO")       ;...and one evaluates non-#f
         (assert-false bar))
       (assert-equal (print-warning 'get-count) (+ nw 2)))

     ;; The following tests don't have to be elaborate (and they are fragile),
     ;; but we want to check that they don't fail,
     ;; and produce something plausible.
     (let ((json-string (with-output-to-string
                          (λ ()
                            (write-bibtex/json! db)))))
       ;;(printf "json-string: ~s~%" json-string)
       ;; json-string is [{"key": ..., "type": ..., "fields": { ...}}]
       (let ((reparsed (parse-json-string json-string)))
         ;;(printf "  -> ~s~%" reparsed)
         (let ((e1 (car reparsed)))
           (assert-equal (e1 'key) #"r1")
           (assert-equal (e1 'type) #"article")
           (assert-equal (sort! (map values (e1 'fields))
                                (λ (v1 v2)
                                  (symbol<? (car v1) (car v2))))
                         '((author    . #"r1author")
                           (month     . #"feb")
                           (monthyear . #"feb1999") ;FIXME: not really correct
                           (title     . #"the titlé and \\more")
                           (year      . #"1999"))))))

     (assert-equal (with-output-to-string
                     (λ ()
                       (write-bibtex/sexp! db)))
                   ;; the "feb1999" isn't really correct here, but
                   ;; should do for an export format
                   #"""((r1 article
                     (author . "r1author")
                     (month . "feb")
                     (monthyear . "feb1999")
                     (title . "the titlé and \\more")
                     (year . "1999"))
                   )
                   """))))

(test-suite
 "useful functions"

 (define (all-true? l)
  (cond ((null? l) #t)
        ((car l) (all-true? (cdr l)))
        (else #f)))

 ;; maybe-list and maybe-sprintf, and friends
 ;; Note: I have changed my mind at least once about what should count
 ;; as falsy: I think that 0 and 0.0 should _not_ count as falsy in a
 ;; bibliographic context, since (although it's a bit of a stretch) we
 ;; might want to print "authors=0" and not have that deleted as being 'false'.
 (assert-true (all-true? (map falsy  '(#f () "" #""))))
 (assert-true (all-true? (map truthy '(#t (boo) (()) 0 0.0 "x" #"x"))))

 ;; the function true/list*? is exposed but undocumented
 (assert-true (true/list*? '(x (y 1))))
 (assert-false (true/list*? '(x 1 (()))))
 ;;(assert-false (true/list*? '(x 1 ((0))))) ; 0 is not false, currently
 (assert-false (true/list*? '(() 1 2)))

 (let ((a 1)
       (b 2))
   (assert-equal (maybe-list a `(b ,b)) '(1 (b 2)))
   (assert-equal (maybe-list/qq ,a (b ,b)) '(1 (b 2)))
   (assert-equal (maybe-sprintf "a=~s b=~s" a b) "a=1 b=2")
   (assert-equal (maybe-sprintf "a=~a b=~a" "x1" "x2") "a=x1 b=x2")
   (assert-equal (maybe-sprintf "a=~a b=~a" "x" "") #f)
   (assert-equal (maybe-sprintf "a=~a b=~a" #"x" #"") #f)
   (assert-equal (maybe-sprintf "a=~a" 0) "a=0")

   ;; At some point, I've marked sprintf/true as deprecated in favour of maybe-sprintf
   (assert-equal (sprintf/true "a=~a b=~a" "x1" "x2") "a=x1 b=x2")
   (assert-equal (sprintf/true "a=~a b=~a" "x" "") "")
   (assert-equal (sprintf/true "a=~a b=~a" #"x" #"") "")

   (let ((a #f))
     (assert-equal (maybe-list a `(b ,b)) '())
     (assert-equal (maybe-list/qq ,a (b ,b)) '())
     (assert-equal (maybe-sprintf "a=~s b=~s" a b) #f))
   (let ((b #f))
     (assert-equal (maybe-list a `(b ,b)) '())
     (assert-equal (maybe-list/qq ,a (b ,b)) '())
     (assert-equal (maybe-sprintf "a=~s b=~s" a b) #f)))

 (let ((a "boo")
       (missing #f)
       (empty-list '())
       (empty-string ""))
   ;; below, simply appending the ". " to the last string would work, too
   (assert-equal (sentence "1" ,a) '("1" "boo" ". "))
   (assert-equal (sentence "2" ,missing) '("2" ". "))
   (assert-equal (sentence "3" ,empty-list) '("3" ". "))
   (assert-equal (sentence "4") '("4" ". "))
   (assert-equal (sentence "5,  ") '("5" ". "))
   (assert-equal (sentence nbsp) '(nbsp ". "))
   (assert-equal (sentence "6, " "two, ;") '("6, " "two" ". "))
   (assert-equal (sentence "7" nbsp) '("7" nbsp ". "))
   (assert-equal (sentence "8" (one (two #f)) (three "") (four "five")) '("8" (four "five") ". "))
   (assert-equal (sentence) '())        ;degenerate case, but not an error
   (assert-equal (sentence ,missing ,empty-list ,empty-string) '())
   ;; last string is _only_ punctuation
   (assert-equal (sentence #f ", " #f) '())))

(exit/failures)