;;; guile-xapian --- Guile bindings for Xapian ;;; Copyright © 2026 Arun Isaac ;;; ;;; 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 ;;; . ;;; 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()" (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(( 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(( 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")