git.chise.org Git - chise/xemacs-chise.git-/blob - tests/automated/os-tests.el

   1 ;;; os-tests.el --- test support for OS interaction
   2
   3 ;; Copyright (C) 2004 Free Software Foundation
   4
   5 ;; Author: Stephen J. Turnbull <stephen@xemacs.org>
   6 ;; Maintainer: Stephen J. Turnbull <stephen@xemacs.org>
   7 ;; Created: 2004 October 28
   8 ;; Keywords: tests, process support
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF.
  28
  29 ;;; Commentary:
  30
  31 ;; Test OS support.  Processes, environment variables, etc.
  32 ;; See test-harness.el for instructions on how to run these tests.
  33
  34 ;; call-process-region bug reported by Katsumi Yamaoka on 2004-10-26
  35 ;; in <b9yvfcyuscf.fsf@jpl.org>, who suggested the basic test scheme
  36 ;; in <b9yoeipvwn0.fsf@jpl.org>.
  37
  38 ;; tac works by lines, unfortunately
  39 (let* ((original-string "a\nb\nc\nd\n")
  40        (tac-cases (if (executable-find "tac")
  41                       '((1 . "c\nb\na\nd\n")
  42                         (3 . "a\nc\nb\nd\n")
  43                         (5 . "a\nc\nb\nd\n")
  44                         (7 . "a\nc\nb\nd\n")
  45                         (9 . "a\nd\nc\nb\n"))
  46                     nil))
  47        (cat-cases (if (executable-find "cat")
  48                       '((1 . "b\nc\na\nd\n")
  49                         (3 . "a\nb\nc\nd\n")
  50                         (5 . "a\nb\nc\nd\n")
  51                         (7 . "a\nb\nc\nd\n")
  52                         (9 . "a\nd\nb\nc\n"))
  53                     nil))
  54        cases case)
  55   (with-temp-buffer
  56     (Skip-Test-Unless tac-cases
  57          "tac executable not found"
  58          "Tests of call-process-region with region deleted after inserting
  59 tac process output."
  60       (setq cases tac-cases)
  61       (while cases
  62         (setq case (car cases)
  63               cases (cdr cases))
  64         (flet ((do-test (pos result)
  65                  (erase-buffer)
  66                  (insert original-string)
  67                  (goto-char pos)
  68                  (call-process-region 3 7 "tac" t t)
  69                  (goto-char (point-min))
  70                  (Assert (looking-at result))))
  71           (do-test (car case) (cdr case)))))
  72     ;; if you're in that much of a hurry you can blow cat off
  73     ;; if you've done tac, but I'm not going to bother
  74     (Skip-Test-Unless cat-cases
  75          "cat executable not found"
  76          "Tests of call-process-region with region deleted after inserting
  77 cat process output."
  78       (setq cases cat-cases)
  79       (while cases
  80         (setq case (car cases)
  81               cases (cdr cases))
  82         (flet ((do-test (pos result)
  83                  (erase-buffer)
  84                  (insert original-string)
  85                  (goto-char pos)
  86                  (call-process-region 3 7 "cat" t t)
  87                  (goto-char (point-min))
  88                  (Assert (looking-at result))))
  89           (do-test (car case) (cdr case)))))))
  90
  91 ;;; end of os-tests.el