Changeset 11759


Ignore:
Timestamp:
Feb 23, 2009, 12:41:46 PM (11 years ago)
Author:
gb
Message:

Windows: if CreateProcess? fails, signal the completion semaphore (so
that the caller doesn't wait forever for it.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/linux-files.lisp

    r11744 r11759  
    17041704                                     si
    17051705                                     proc-info))
    1706           (setf (external-process-%status proc) :error
    1707                 (external-process-%exit-code proc) (#_GetLastError))
     1706          (progn
     1707            (setf (external-process-%status proc) :error
     1708                  (external-process-%exit-code proc) (#_GetLastError))
     1709            (signal-semaphore (external-process-completed proc)))
    17081710          (#_CloseHandle (pref proc-info #>PROCESS_INFORMATION.hThread)))
    17091711        (pref proc-info #>PROCESS_INFORMATION.hProcess))))
     
    17341736  ;;; So, this tries to loop until the process handle is signaled and
    17351737  ;;; all data has been read.
    1736  (defun monitor-external-process (p)
     1738  (defun monitor-external-process (p)
    17371739    (let* ((in-fds (external-process-watched-fds p))
    17381740           (out-streams (external-process-watched-streams p))
     
    17701772              (%stack-block ((buf 1024))
    17711773                (let* ((n (fd-read in-fd buf 1024)))
    1772                     (declare (fixnum n))
    1773                     (if (<= n 0)
    1774                       (progn
    1775                         (without-interrupts
    1776                          (decf (car token))
    1777                          (fd-close in-fd)
    1778                          (setf (car p) nil changed t)))
    1779 
    1780                       (let* ((string (make-string 1024)))
    1781                         (declare (dynamic-extent string))
    1782                         (%str-from-ptr buf n string)
    1783                         (write-sequence string out-stream :end n))))))))
     1774                  (declare (fixnum n))
     1775                  (if (<= n 0)
     1776                    (progn
     1777                      (without-interrupts
     1778                       (decf (car token))
     1779                       (fd-close in-fd)
     1780                       (setf (car p) nil changed t)))
     1781
     1782                    (let* ((string (make-string 1024)))
     1783                      (declare (dynamic-extent string))
     1784                      (%str-from-ptr buf n string)
     1785                      (write-sequence string out-stream :end n))))))))
    17841786        (unless terminated
    17851787          (setq terminated (eql (#_WaitForSingleObjectEx
Note: See TracChangeset for help on using the changeset viewer.