cgit.sxemacs.org Git - sxemacs/blob - tests/automated/database-tests.el

   1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   2
   3 ;; Author: Martin Buchholz <martin@xemacs.org>
   4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
   5 ;; Created: 1998
   6 ;; Keywords: tests, database
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by the
  12 ;; Free Software Foundation, either version 3 of the License, or (at your
  13 ;; option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be
  16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;;; Test database functionality
  28 ;;; See test-harness.el
  29
  30 (condition-case nil
  31     (require 'test-harness)
  32   (file-error
  33    (when (and (boundp 'load-file-name) (stringp load-file-name))
  34      (push (file-name-directory load-file-name) load-path)
  35      (require 'test-harness))))
  36
  37 (flet ((delete-database-files (filename)
  38         (dolist (fn (list filename
  39                           (concat filename ".db")
  40                           (concat filename ".pag")
  41                           (concat filename ".dir")))
  42           (ignore-file-errors (delete-file fn))))
  43
  44        (test-database (db)
  45         (Assert (databasep db))
  46         (put-database "key1" "val1" db)
  47         (Assert (equal "val1" (get-database "key1" db)))
  48         (remove-database "key1" db)
  49         (Assert (equal nil (get-database "key1" db)))
  50         (close-database db)
  51         (Assert (not (database-live-p db)))
  52         (Assert (databasep db))))
  53
  54   (let ((filename (expand-file-name "test-harness" (temp-directory))))
  55
  56     (dolist (db-type '(dbm berkeley-db))
  57       (when (featurep db-type)
  58         (princ "\n")
  59         (delete-database-files filename)
  60         (test-database (open-database filename db-type))
  61         (delete-database-files filename)))))