Changeset 9854

Timestamp:

Jun 30, 2008, 5:00:02 PM (12 years ago)

Author:

gb

Message:

Define the SERIOUS-CONDITION EXTERNAL-PROCESS-CREATION-FAILURE.

Add *SILENTLY-IGNORE-CATASTROPHIC-FAILURE-IN-RUN-PROGRAM, initialize
it to T on this branch.

Add :SILENTLY-IGNORE-CATASTROPHIC-FAILURE arg to RUN-PROGRAM. When
true, an EXTERNAL-PROCESS with status :ERROR and some exit code
(and a null PID) is returned, as if that was a reasonable thing
to do. If catastrophic failure (#_fork error) isn't silently
ignored, a serious condition of type EXTERNAL-PROCESS-CREATION-FAILURE
is signaled.

Make things that expect EXTERNAL-PROCESS-PID to be non-NIL handle
the possibilit that catastrophic falures have been ignored.

Location:

branches/working-0711/ccl/level-1

Files:

• l1-error-system.lisp (modified) (1 diff)
• linux-files.lisp (modified) (5 diffs)

branches/working-0711/ccl/level-1/l1-error-system.lisp

@@ -491 +491 @@
                   (apply #'format stream (simple-condition-format-control c)
                          (simple-condition-format-arguments c)))))
+
+(define-condition external-process-creation-failure (serious-condition)
+  ((proc :initarg :proc))
+  (:report (lambda (c stream)
+             (with-slots (proc) c
+               (let* ((code (external-process-%exit-code proc)))
+                 (format stream "Fork failed in ~s: ~a. " proc (if (eql code -1) "random lisp error" (%strerror code))))))))
+   
                          
 (defun restartp (thing) 

branches/working-0711/ccl/level-1/linux-files.lisp

@@ -883 +883 @@
                    (remove-external-process p)
                    (setq terminated t)))))))))
-      
+
+
 (defun run-external-process (proc in-fd out-fd error-fd argv &optional env)
   (let* ((signaled nil))
@@ -915 +916 @@
         (signal-semaphore (external-process-signal proc))))))
 
-                
+(defparameter *silently-ignore-catastrophic-failure-in-run-program*
+  #+ccl-0711 t #-ccl-0711 nil)
+
 (defun run-program (program args &key
                             (wait t) pty
@@ -922 +925 @@
                             (error :output) (if-error-exists :error)
                             status-hook (element-type 'character)
-                            env)
+                            env
+                            (silently-ignore-catastrophic-failures
+                             *silently-ignore-catastrophic-failure-in-run-program*))
   "Invoke an external program as an OS subprocess of lisp."
   (declare (ignore pty))
@@ -986 +991 @@
             (wait-on-semaphore (external-process-completed proc))))
       (if (eq (external-process-%status proc) :error)
-        (error "Fork failed in ~s: ~s" proc (%strerror (external-process-%exit-code proc))))
-      (and (external-process-pid proc)
-           proc)))
+        (if silently-ignore-catastrophic-failures
+          proc
+          (error 'external-process-creation-failure proc))
+        (and (external-process-pid proc)
+             proc))))
 
 
@@ -1071 +1078 @@
   "Send the specified signal to the specified external process.  (Typically,
 it would only be useful to call this function if the EXTERNAL-PROCESS was
-created with :WAIT NIL.) Return T if successful; signal an error otherwise."
+created with :WAIT NIL.) Return T if successful, NIL if the process wasn't
+created successfully, and signal an error otherwise."
   (require-type proc 'external-process)
-  (let* ((pid (external-process-pid proc))
-         (error (syscall syscalls::kill pid signal)))
-    (or (eql error 0)
-        (%errno-disp error))))
+  (let* ((pid (external-process-pid proc)))
+    (when pid
+      (let* ((error (syscall syscalls::kill pid signal)))
+        (or (eql error 0)
+            (%errno-disp error))))))
 
 ;;; EOF on a TTY is transient, but I'm less sure of other cases.