named entity test

gistfile1.lisp

(defun test-names ()
  (flet ((test-case (expected modifier-alist)
           (unwind-protect
                (let ((e (create-entity :comment expected)))
                  (unwind-protect
                       (loop for (name . value) in modifier-alist
                          do (add-modifier e name value)
                          finally (assert (string= (full-name e) expected) ()
                                          "Full name was ~S" (full-name e)))
                    (with-db ()
                      (query (:delete-from 'modifier :where (:= 'entity-id e)))
                      (query (:delete-from 'entity :where (:= 'id e)))))))))
    (test-case "a little teapot"
               '((base-name . "teapot")
                 (use-article-p . t)
                 (adjectives . #("little"))))
    (test-case "a little, short, and stout teapot"
               '((base-name . "teapot")
                 (use-article-p . t)
                 (adjectives . #("little" "short" "stout"))))
    (test-case "a male servant" '((base-name . "servant")
                                  (use-article-p . t)
                                  (adjectives . #("male"))))
    (test-case "Godot" '((base-name . "Godot")))
    (test-case "John Doe" '((base-name . "Doe")
                            (first-name . "John")))
    (test-case "Count Chocula" '((base-name . "Chocula")
                                 (titles . #("Count"))))
    (test-case "Supreme Commander John Doe" '((base-name . "Doe")
                                              (first-name . "John")
                                              (titles . #("Supreme" "Commander"))))
    (test-case "Commander John Doe Jr" '((base-name . "Doe")
                                         (first-name . "John")
                                         (titles . #("Commander"))
                                         (suffix . "Jr")))
    (test-case "Commander John Doe, PhD" '((base-name . "Doe")
                                         (first-name . "John")
                                         (titles . #("Commander"))
                                         (suffix-titles . #("PhD"))))
    (test-case "Commander John Doe Jr, PhD, Esq" '((base-name . "Doe")
                                                   (first-name . "John")
                                                   (titles . #("Commander"))
                                                   (suffix . "Jr")
                                                   (suffix-titles . #("PhD" "Esq"))))
    ;; TODO, maybe
    #+nil(test-case "the captain of the guard" '())))