# HG changeset patch # User stephent # Date 1098963083 0 # Node ID 0b060ef357897ab48df8eb10c8144e2b52df699e # Parent 61aaa5e258b02721973e52a1729813033dc11f90 [xemacs-hg @ 2004-10-28 11:31:09 by stephent] fix and tests for call-process-region bug <87fz3z2ic0.fsf_-_@tleepslib.sk.tsukuba.ac.jp> diff -r 61aaa5e258b0 -r 0b060ef35789 lisp/ChangeLog --- a/lisp/ChangeLog Thu Oct 28 10:51:17 2004 +0000 +++ b/lisp/ChangeLog Thu Oct 28 11:31:23 2004 +0000 @@ -1,3 +1,8 @@ +2004-10-28 Stephen J. Turnbull + + * code-process.el (call-process-region): Fix region deletion bug. + Report by Katsumi Yamaoka . + 2004-10-22 Stephen J. Turnbull * XEmacs 21.5.18 "chestnut" is released. diff -r 61aaa5e258b0 -r 0b060ef35789 lisp/code-process.el --- a/lisp/code-process.el Thu Oct 28 10:51:17 2004 +0000 +++ b/lisp/code-process.el Thu Oct 28 11:31:23 2004 +0000 @@ -165,27 +165,27 @@ The read/write coding systems used for process I/O on the process are the same as for `call-process'." - ;; We used to delete the text before calling call-process; that was when - ;; a temporary file was used to pass the text to call-process. Now that - ;; we don't do that, we delete the text afterward; if it's being inserted - ;; in the same buffer, make sure we track the insertion, and don't get - ;; any of it in the deleted region. We keep marker s before the - ;; insertion and e afterward. Finally we delete the regions before - ;; and after the insertion. - (let ((s (and deletep (copy-marker (point)))) - (e (and deletep (copy-marker (point) t)))) - (let ((retval - (apply #'call-process program (list (current-buffer) start end) - buffer displayp args))) - ;; If start and end were the same originally, e will be beyond s now - (when (and deletep (> e s)) - ;; APA: Is it always correct to honor narrowing, which affects - ;; (point-min) and (point-max)? - ;; Delete region before insertion. - (delete-region (point-min) s) - ;; Delete region after insertion. - (delete-region e (point-max))) - retval))) + + ;; We can't delete the region before feeding it to `call-process', so we + ;; take care not to delete the insertion when we delete the region. START + ;; and END may not be markers; copy them. (point) will end up after the + ;; insertion. A copy of (point) tracks the beginning of the insertion. + + (let ((s (and deletep (copy-marker start))) ; Only YOU can + (e (and deletep (copy-marker end t))) ; prevent + (p (and deletep (copy-marker (point)))) ; excess consing! + (retval + (apply #'call-process program (list (current-buffer) start end) + buffer displayp args))) + (when deletep + (if (<= s p e) + ;; region was split by insertion + ;; the order checks are gilt lilies + (progn (when (< (point) e) (delete-region (point) e)) + (when (< s p) (delete-region s p))) + ;; insertion was outside of region + (delete-region s e))) + retval)) (defun start-process (name buffer program &rest program-args) "Start a program in a subprocess. Return the process object for it. diff -r 61aaa5e258b0 -r 0b060ef35789 tests/ChangeLog --- a/tests/ChangeLog Thu Oct 28 10:51:17 2004 +0000 +++ b/tests/ChangeLog Thu Oct 28 11:31:23 2004 +0000 @@ -1,11 +1,17 @@ +2004-10-28 Stephen J. Turnbull + + * automated/os-tests.el: New file. Add tests for bug reported by + Katsumi Yamaoka 2004-10-26 . Test + suggested by Katsumi Yamaoka . + 2004-10-22 Stephen J. Turnbull * XEmacs 21.5.18 "chestnut" is released. 2004-10-07 Stephen J. Turnbull - * automated/regexp-tests.el: Add tests for bug identified by - Steve Youngs 2004-09-30 + * automated/regexp-tests.el: Add tests for bug identified by Steve + Youngs 2004-09-30 . 2004-09-08 Stephen J. Turnbull diff -r 61aaa5e258b0 -r 0b060ef35789 tests/automated/os-tests.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/automated/os-tests.el Thu Oct 28 11:31:23 2004 +0000 @@ -0,0 +1,91 @@ +;;; os-tests.el --- test support for OS interaction + +;; Copyright (C) 2004 Free Software Foundation + +;; Author: Stephen J. Turnbull +;; Maintainer: Stephen J. Turnbull +;; Created: 2004 October 28 +;; Keywords: tests, process support + +;; This file is part of XEmacs. + +;; XEmacs 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, or (at your option) +;; any later version. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF. + +;;; Commentary: + +;; Test OS support. Processes, environment variables, etc. +;; See test-harness.el for instructions on how to run these tests. + +;; call-process-region bug reported by Katsumi Yamaoka on 2004-10-26 +;; in , who suggested the basic test scheme +;; in . + +;; tac works by lines, unfortunately +(let* ((original-string "a\nb\nc\nd\n") + (tac-cases (if (executable-find "tac") + '((1 . "c\nb\na\nd\n") + (3 . "a\nc\nb\nd\n") + (5 . "a\nc\nb\nd\n") + (7 . "a\nc\nb\nd\n") + (9 . "a\nd\nc\nb\n")) + nil)) + (cat-cases (if (executable-find "cat") + '((1 . "b\nc\na\nd\n") + (3 . "a\nb\nc\nd\n") + (5 . "a\nb\nc\nd\n") + (7 . "a\nb\nc\nd\n") + (9 . "a\nd\nb\nc\n")) + nil)) + cases case) + (with-temp-buffer + (Skip-Test-Unless tac-cases + "tac executable not found" + "Tests of call-process-region with region deleted after inserting +tac process output." + (setq cases tac-cases) + (while cases + (setq case (car cases) + cases (cdr cases)) + (flet ((do-test (pos result) + (erase-buffer) + (insert original-string) + (goto-char pos) + (call-process-region 3 7 "tac" t t) + (goto-char (point-min)) + (Assert (looking-at result)))) + (do-test (car case) (cdr case))))) + ;; if you're in that much of a hurry you can blow cat off + ;; if you've done tac, but I'm not going to bother + (Skip-Test-Unless cat-cases + "cat executable not found" + "Tests of call-process-region with region deleted after inserting +cat process output." + (setq cases cat-cases) + (while cases + (setq case (car cases) + cases (cdr cases)) + (flet ((do-test (pos result) + (erase-buffer) + (insert original-string) + (goto-char pos) + (call-process-region 3 7 "cat" t t) + (goto-char (point-min)) + (Assert (looking-at result)))) + (do-test (car case) (cdr case))))))) + +;;; end of os-tests.el