Fix a recently-introduced delete-process race condition.

* callproc.c, process.h (record_kill_process):
New function, containing part of the old call_process_kill.
(call_process_kill): Use it.
This does not change call_process_kill's behavior.
* process.c (Fdelete_process): Use record_kill_process to fix a
race condition that could cause Emacs to lose track of a child.

src/ChangeLog

@@ -1,3 +1,13 @@
+2012-12-06  Paul Eggert  <eggert@cs.ucla.edu>
+
+	Fix a recently-introduced delete-process race condition.
+	* callproc.c, process.h (record_kill_process):
+	New function, containing part of the old call_process_kill.
+	(call_process_kill): Use it.
+	This does not change call_process_kill's behavior.
+	* process.c (Fdelete_process): Use record_kill_process to fix a
+	race condition that could cause Emacs to lose track of a child.
+
 2012-12-06  Dmitry Antipov  <dmantipov@yandex.ru>
 
 	Avoid code duplication between prev_frame and next_frame.

src/callproc.c

@@ -105,6 +105,25 @@ unblock_child_signal (void)
 #endif
 }
 
+/* If P is reapable, record it as a deleted process and kill it.
+   Do this in a critical section.  Unless PID is wedged it will be
+   reaped on receipt of the first SIGCHLD after the critical section.  */
+
+void
+record_kill_process (struct Lisp_Process *p)
+{
+  block_child_signal ();
+
+  if (p->alive)
+    {
+      p->alive = 0;
+      record_deleted_pid (p->pid);
+      EMACS_KILLPG (p->pid, SIGKILL);
+    }
+
+  unblock_child_signal ();
+}
+
 /* Clean up when exiting call_process_cleanup.  */
 
 static Lisp_Object
@@ -113,15 +132,12 @@ call_process_kill (Lisp_Object ignored)
   if (0 <= synch_process_fd)
     emacs_close (synch_process_fd);
 
-  /* If PID is reapable, kill it and record it as a deleted process.
-     Do this in a critical section.  Unless PID is wedged it will be
-     reaped on receipt of the first SIGCHLD after the critical section.  */
   if (synch_process_pid)
     {
-      block_child_signal ();
-      record_deleted_pid (synch_process_pid);
-      EMACS_KILLPG (synch_process_pid, SIGKILL);
-      unblock_child_signal ();
+      struct Lisp_Process proc;
+      proc.alive = 1;
+      proc.pid = synch_process_pid;
+      record_kill_process (&proc);
     }
 
   return Qnil;

src/process.c

@@ -813,30 +813,22 @@ nil, indicating the current buffer's process.  */)
       status_notify (p);
       redisplay_preserve_echo_area (13);
     }
-  else if (p->infd >= 0)
+  else
     {
-#ifdef SIGCHLD
-      Lisp_Object symbol;
-      pid_t pid = p->pid;
+      if (p->alive)
+	record_kill_process (p);
 
-      /* No problem storing the pid here, as it is still in Vprocess_alist.  */
-      record_deleted_pid (pid);
-      /* If the process has already signaled, remove it from the list.  */
-      if (p->raw_status_new)
-	update_status (p);
-      symbol = p->status;
-      if (CONSP (p->status))
-	symbol = XCAR (p->status);
-      if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
-	deleted_pid_list
-	  = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
-      else
-#endif
+      if (p->infd >= 0)
 	{
-	  Fkill_process (process, Qnil);
-	  /* Do this now, since remove_process will make the
-	     SIGCHLD handler do nothing.  */
-	  pset_status (p, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)));
+	  /* Update P's status, since record_kill_process will make the
+	     SIGCHLD handler update deleted_pid_list, not *P.  */
+	  Lisp_Object symbol;
+	  if (p->raw_status_new)
+	    update_status (p);
+	  symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
+	  if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
+	    pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
+
 	  p->tick = ++process_tick;
 	  status_notify (p);
 	  redisplay_preserve_echo_area (13);

src/process.h

@@ -198,6 +198,12 @@ extern Lisp_Object QCspeed;
 extern Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
 extern Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
 
+/* Defined in callproc.c.  */
+
+extern void record_kill_process (struct Lisp_Process *);
+
+/* Defined in process.c.  */
+
 extern Lisp_Object list_system_processes (void);
 extern Lisp_Object system_process_attributes (Lisp_Object);