Port smoke test from python bindings. HEAD master

3 files changed, 318 insertions, 2 deletions

diff --git a/.dir-locals.el b/.dir-locals.el
index 3c298da..8050241 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,6 +7,7 @@
   (indent-tabs-mode t))
  (scheme-mode
   (eval put 'call-with-database 'scheme-indent-function 1)
-  (eval put 'call-with-writable-database 'scheme-indent-function 1)))
+  (eval put 'call-with-writable-database 'scheme-indent-function 1)
+  (eval put 'call-with-temporary-writable-database 'scheme-indent-function 1)))
 
 
diff --git a/Makefile.am b/Makefile.am
index fe81c4f..891952b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -79,7 +79,7 @@ xapian/xapian.go: xapian/xapian.scm libguilexapian-@GUILE_EFFECTIVE_VERSION@.la
 
 # Tests
 
-test_files = tests/xapian.scm
+test_files = tests/smoketest.scm tests/xapian.scm
 
 check-local:
 	$(builddir)/pre-inst-env $(GUILE_RUN64) $(test_files)
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")