--- 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  <stephen@xemacs.org>
+
+	* code-process.el (call-process-region): Fix region deletion bug.
+	Report by Katsumi Yamaoka <b9yvfcyuscf.fsf@jpl.org>.
+
 2004-10-22  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* XEmacs 21.5.18 "chestnut" is released.

--- 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.

--- 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  <stephen@xemacs.org>
+
+	* automated/os-tests.el: New file.  Add tests for bug reported by
+	Katsumi Yamaoka 2004-10-26 <b9yvfcyuscf.fsf@jpl.org>.  Test
+	suggested by Katsumi Yamaoka <b9yoeipvwn0.fsf@jpl.org>.
+
 2004-10-22  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* XEmacs 21.5.18 "chestnut" is released.
 
 2004-10-07  Stephen J. Turnbull  <stephen@xemacs.org>
 
-	* automated/regexp-tests.el: Add tests for bug identified by
-	Steve Youngs 2004-09-30 <microsoft-free.87ekkjhj7t.fsf@youngs.au.com>
+	* automated/regexp-tests.el: Add tests for bug identified by Steve
+	Youngs 2004-09-30 <microsoft-free.87ekkjhj7t.fsf@youngs.au.com>.
 
 2004-09-08  Stephen J. Turnbull  <stephen@xemacs.org>
 

--- /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 <stephen@xemacs.org>
+;; Maintainer: Stephen J. Turnbull <stephen@xemacs.org>
+;; 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 <b9yvfcyuscf.fsf@jpl.org>, who suggested the basic test scheme
+;; in <b9yoeipvwn0.fsf@jpl.org>.
+
+;; 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