path: root/tests/smoketest.scm

;;; guile-xapian --- Guile bindings for Xapian
;;; Copyright © 2026 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guile-xapian.
;;;
;;; guile-xapian is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; guile-xapian is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-xapian.  If not, see
;;; <https://www.gnu.org/licenses/>.

;;; This test suite is a more or less faithful port of
;;; xapian-bindings/python3/smoketest.py from v1.4.32 of the xapian
;;; repo. Keep this updated with new releases of xapian.

(use-modules (srfi srfi-26)
             (srfi srfi-64)
             (ice-9 ftw)
             (xapian xapian)
             ;; Prefix with xapian: to avoid overriding guile core
             ;; bindings.
             ((xapian wrap) #:select (major-version minor-version) #:prefix xapian:)
             ((xapian wrap) #:select (revision
                                      version-string
                                      BAD-VALUENO
                                      new-Query
                                      Query-MatchAll
                                      Query-MatchNothing
                                      Query-OP-AND
                                      Query-OP-ELITE-SET
                                      Query-OP-VALUE-RANGE
                                      Query-OP-WILDCARD
                                      Query-OP-SCALE-WEIGHT
                                      Stem-apply
                                      Stem-get-description
                                      Query-get-description
                                      Database-get-metadata
                                      WritableDatabase-set-metadata
                                      Document-add-posting
                                      Enquire-set-collapse-key
                                      Enquire-set-sort-by-value)))

(define (fold-count item result)
  (1+ result))

;; TODO: Do this with an in-memory database so that we have less
;; cleanup to do.
(define (call-with-temporary-writable-database path proc)
  "Like @code{call-with-writable-database}, but delete the database
after."
  (dynamic-wind
    (const #t)
    (cut call-with-writable-database path proc)
    (lambda ()
      (for-each (lambda (file)
                  (delete-file (string-append path "/" file)))
                (scandir path (negate (cut member <> (list "." "..")))))
      (rmdir path))))

(test-begin "smoketest")

(test-equal "version number reporting"
  (string-join (map number->string (list (xapian:major-version)
                                         (xapian:minor-version)
                                         (revision)))
               ".")
  (version-string))

(test-equal "stemmer description"
  "Xapian::Stem(english)"
  (Stem-get-description (make-stem "english")))

(test-expect-fail "document does not transparently handle a zero byte")
(let* ((data "a\0b")
       (doc (make-document #:data data)))
  (test-equal "document does not transparently handle a zero byte"
    data
    (document-data (make-document #:data data))))

(call-with-temporary-writable-database "/tmp/xapian-db"
  (lambda (db)
    (let ((doc (make-document #:data "is there anybody out there?")))
      (add-document! db doc)
      (test-equal "document count"
        1
        (database-document-count db)))))

(test-equal "OR query description 1"
  "Query((smoke OR test OR terms))"
  (Query-get-description (query-or (query "smoke") (query "test") (query "terms"))))

(test-equal "OR query description 2"
  "Query((a OR b))"
  (Query-get-description (query-or (query "a") (query "b"))))

(test-equal "value range query description"
  "Query(VALUE_RANGE 0 1 4)"
  (Query-get-description (new-Query (Query-OP-VALUE-RANGE) 0 "1" "4")))

(let* ((query1 (query-phrase (query "smoke")
                             (query "test")
                             (query "tuple")))
       (query2 (query-xor (query "smoke")
                          query1
                          (query "string"))))
  (test-equal "phrase query description"
    "Query((smoke PHRASE 3 test PHRASE 3 tuple))"
    (Query-get-description query1))

  (test-equal "XOR query description"
    "Query((smoke XOR (smoke PHRASE 3 test PHRASE 3 tuple) XOR string))"
    (Query-get-description query2))

  (test-equal "number of terms"
    4
    (termlist-fold fold-count
                   0
                   (query-terms query2))))

;; TODO: Check error reporting of database opening functions as in
;; smoketest.py.

(test-equal "match all query description"
  "Query(<alldocuments>)"
  (Query-get-description (Query-MatchAll)))

(test-equal "match nothing query description"
  "Query()"
  (Query-get-description (Query-MatchNothing)))

(test-equal "wildcard query description 1"
  "Query(WILDCARD SYNONYM wild)"
  (Query-get-description (new-Query (Query-OP-WILDCARD) "wild")))

(test-equal "wildcard query description 2"
  "Query(WILDCARD SYNONYM wild)"
  (Query-get-description (new-Query (Query-OP-WILDCARD) "wild" 0)))

(call-with-temporary-writable-database "/tmp/xapian-db"
  (lambda (db)
    (let ((enq (enquire db (query-or (query "there") (query "is"))))
          (doc (make-document #:data "is there anybody out there?")))
      (test-assert "set BAD_VALUENO collapse key"
        (Enquire-set-collapse-key enq (BAD-VALUENO)))
      (Document-add-posting doc "is" 1)
      (Document-add-posting doc "there" 2)
      (Document-add-posting doc "anybody" 3)
      (Document-add-posting doc "out" 4)
      (Document-add-posting doc "there" 5)
      (add-document! db doc)
      (test-equal "mset size"
        1
        (mset-fold fold-count
                   0
                   (enquire-mset enq #:maximum-items 10)))
      ;; TODO: Test matching terms.
      ;; TODO: Test mset size.
      ;; TODO: Test expand terms.
      ;; TODO: Test number of terms in database.
      ;; TODO: Test number of terms in database allterms.
      ;; TODO: Test database postlist.
      ;; TODO: Test database postlist with empty term.
      ;; TODO: Test database termlist.
      ;; TODO: Test term iterator skip_to.
      ;; TODO: Test number of document values.
      ;; TODO: Check exception handling for Xapian::DocNotFoundError.
      )))

(test-equal "value of OP_ELITE_SET"
  10
  (Query-OP-ELITE-SET))

;; TODO: Test match decider.
;; TODO: Test expand decider.
;; TODO: Check min_wt argument to get_eset() works.
;; TODO: Check QueryParser parsing error.

(test-equal "parse pure NOT query"
  "Query((<alldocuments> AND_NOT test@1))"
  (Query-get-description (parse-query "NOT test"
                                      #:stemmer (make-stem "none")
                                      #:boolean? #t
                                      #:pure-not? #t)))

(test-equal "parse query with partial matching 1"
  "Query((Zfoo@1 AND (WILDCARD SYNONYM o OR Zo@2)))"
  (Query-get-description (parse-query "foo o"
                                      #:stemmer (make-stem "en")
                                      #:default-operator (Query-OP-AND)
                                      #:partial? #t)))

(test-equal "parse query with partial matching 2"
  "Query((Zfoo@1 AND (WILDCARD SYNONYM outside OR Zoutsid@2)))"
  (Query-get-description (parse-query "foo outside"
                                      #:stemmer (make-stem "en")
                                      #:default-operator (Query-OP-AND)
                                      #:partial? #t)))

(test-equal "unicode query description"
  "Query((foo OR bar£))"
  (Query-get-description (query-or (query "foo") (query "bar£"))))

(test-equal "parse query with unicode characters"
  "Query((<alldocuments> AND_NOT Zt\u00e9st@1))"
  (Query-get-description (parse-query "NOT tést"
                                      #:stemmer (make-stem "en")
                                      #:boolean? #t
                                      #:pure-not? #t)))

(let* ((data "Unicode with an accént")
       (doc (make-document #:data data)))
  (Document-add-posting doc
                        (Stem-apply (make-stem "en") "outér")
                        1)
  (test-equal "unicode document data"
    data
    (document-data doc))

  (test-equal "unicode document termlist"
    (list "outér")
    (termlist-fold (lambda (term result)
                     (cons (term-string term)
                           result))
                   '()
                   (document-termlist doc))))

;; TODO: Check simple stopper.
;; TODO: custom Stopper

(test-equal "index text"
  '(("foo" 2 (1 4))
    ("baz" 1 (3))
    ("bar" 1 (2)))
  (let* ((doc (make-document))
         (term-generator (make-term-generator #:stem (make-stem "none")
                                              #:document doc)))
    (index-text! term-generator "foo bar baz foo")
    (termlist-fold (lambda (term result)
                     (cons (list (term-string term)
                                 (term-wdf term)
                                 (reverse
                                  (positionlist-fold (lambda (position result)
                                                       (cons (position-termpos position)
                                                             result))
                                                     '()
                                                     (term-positionlist term))))
                           result))
                   '()
                   (document-termlist doc))))

(test-equal "date value range query description"
  "Query(VALUE_RANGE 1 19991203 20011204)"
  (Query-get-description
   (parse-query "12/03/99..12/04/01"
                #:stemmer (make-stem "none")
                #:range-processors (list (prefixed-date-range-processor 1 #:prefer-mdy? #t)))))

;; TODO: Test NumberValueRangeProcessor.

(let* ((test-field-processor
        (field-processor (lambda (str)
                           (if (string= str "spam")
                               (error "already spam")
                               (query "spam")))))
       (prefixes `(("spam" . ,test-field-processor)))
       (boolean-prefixes `(("boolspam" . ,test-field-processor))))
  (test-equal "field processor"
    "Query(spam)"
    (Query-get-description
     (parse-query "spam:ignored"
                  #:stemmer (make-stem "none")
                  #:prefixes prefixes
                  ;; TODO: Add boolean prefixes with other options
                  ;; too.
                  #:boolean-prefixes boolean-prefixes)))

  (test-error "failing field processor"
    &error
    (parse-query "spam:spam"
                 #:stemmer (make-stem "none")
                 #:prefixes prefixes
                 #:boolean-prefixes boolean-prefixes)))

(call-with-temporary-writable-database "/tmp/xapian-db"
  (lambda (db)
    (test-equal "get empty database metadata"
      ""
      (Database-get-metadata db "foo"))

    (WritableDatabase-set-metadata db "foo" "foo")

    (test-equal "get database metadata"
      "foo"
      (Database-get-metadata db "foo"))

    ;; TODO: Test empty metadata keys.
    ))

(test-equal "scale weight query description"
  "Query(5 * foo)"
  (Query-get-description (new-Query (Query-OP-SCALE-WEIGHT)
                                    (query "foo")
                                    5)))

;; TODO: Test custom stemmer.

(test-end "smoketest")