diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | tests/examples.scm | 94 |
2 files changed, 95 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 891952b..6d2e476 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/smoketest.scm tests/xapian.scm +test_files = tests/examples.scm tests/smoketest.scm tests/xapian.scm check-local: $(builddir)/pre-inst-env $(GUILE_RUN64) $(test_files) 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") |