From ffa46c17ba91b898ea84d4bf20f2ee0b13e72008 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Thu, 24 Sep 2026 00:55:18 +0100 Subject: Test example scripts. --- tests/examples.scm | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 94 insertions(+) create mode 100644 tests/examples.scm (limited to 'tests') 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 +;;; +;;; 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 +;;; . + +(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") -- cgit 1.4.1