Test example scripts.

1 files changed, 94 insertions, 0 deletions

diff --git a/tests/examples.scm b/tests/examples.scm
new file mode 100644
index 0000000..3abb348
--- /dev/null
+++ b/tests/examples.scm
@@ -0,0 +1,94 @@
+;;; 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/>.
+
+(use-modules (rnrs io ports)
+             (srfi srfi-26)
+             (srfi srfi-64)
+             (ice-9 match)
+             (ice-9 popen))
+
+(define (call-with-input-pipe command proc)
+  "Call @var{proc} with input pipe to @var{command}. @var{command} is a
+list of program arguments."
+  (match command
+    ((prog args ...)
+     (let ((port #f))
+       (dynamic-wind
+         (lambda ()
+           (set! port (apply open-pipe* OPEN_READ prog args)))
+         (cut proc port)
+         (lambda ()
+           (unless (zero? (close-pipe port))
+             (error "Command invocation failed" command))))))))
+
+(define (search . query)
+  (call-with-input-pipe (cons* "guile" "examples/search.scm" "/tmp/db" query)
+    (lambda (port)
+      ;; port-transduce might be shorter and more preferable. But we'd
+      ;; like to support guile 2.2, and port-transduce does not exist
+      ;; in guile 2.2.
+      (let loop ((result '()))
+        (let ((line (get-line port)))
+          (if (eof-object? line)
+              (reverse result)
+              (loop (cons line result))))))))
+
+(test-begin "examples")
+
+(test-equal "index"
+  0
+  (status:exit-val
+   (system* "guile"
+            "examples/index.scm"
+            "examples/100-objects.sexp"
+            "/tmp/db")))
+
+(test-equal "search watch"
+  (list "0: #004 Watch with Chinese duplex escapement"
+        "1: #018 Solar/Sidereal verge watch with epicyclic maintaining power"
+        "2: #013 Watch timer by P"
+        "3: #033 A device by Favag of Neuchatel which enables a stop watch to"
+        "4: #015 Ingersoll \"Dan Dare\" automaton pocket watch with pin-pallet"
+        "5: #036 Universal 'Tri-Compax' chronographic wrist watch"
+        "6: #046 Model by Dent of mechanism for setting hands and winding up")
+  (search "watch"))
+
+(test-equal "search Dent watch"
+  (list "0: #046 Model by Dent of mechanism for setting hands and winding up"
+        "1: #004 Watch with Chinese duplex escapement"
+        "2: #018 Solar/Sidereal verge watch with epicyclic maintaining power"
+        "3: #013 Watch timer by P"
+        "4: #094 Model of a Lever Escapement , 1850-1883"
+        "5: #093 Model of Graham's Cylinder Escapement, 1850-1883"
+        "6: #033 A device by Favag of Neuchatel which enables a stop watch to"
+        "7: #015 Ingersoll \"Dan Dare\" automaton pocket watch with pin-pallet"
+        "8: #086 Model representing Earnshaw's detent chronometer escapement, 1950-1883"
+        "9: #036 Universal 'Tri-Compax' chronographic wrist watch")
+  (search "Dent" "watch"))
+
+(test-equal "search title:sunwatch"
+  (list "0: #001 Ansonia Sunwatch (pocket compas dial)")
+  (search "title:sunwatch"))
+
+(test-equal "search description:\"leather case\" AND title:sundial"
+  (list "0: #055 Silver altitude sundial in leather case"
+        "1: #084 Magnetic sundial in brass case")
+  (search "description:leather case" "AND" "title:sundial"))
+
+(test-end "examples")