;;; 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 v2.1.0 of the xapian
;;; repo. Keep this updated with new releases of xapian.
(use-modules ((rnrs conditions) #:select (&error) #:prefix rnrs:)
(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))
(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-in-memory-database
(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-termlist 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-in-memory-database
(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((0 * <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 ox OR Zox@2)))"
(Query-get-description (parse-query "foo ox"
#: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((0 * <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)))))
(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"
rnrs:&error
(parse-query "spam:spam"
#:stemmer (make-stem "none")
#:prefixes prefixes
#:boolean-prefixes boolean-prefixes)))
(call-with-in-memory-database
(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")