diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/smoketest.scm | 315 |
1 files changed, 315 insertions, 0 deletions
diff --git a/tests/smoketest.scm b/tests/smoketest.scm new file mode 100644 index 0000000..a718d64 --- /dev/null +++ b/tests/smoketest.scm @@ -0,0 +1,315 @@ +;;; 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") |