0.6.11.12:
authorWilliam Harold Newman <william.newman@airmail.net>
Mon, 5 Mar 2001 01:30:08 +0000 (01:30 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Mon, 5 Mar 2001 01:30:08 +0000 (01:30 +0000)
moved !PACKAGE-COLD-INIT earlier in cold init so that KEYWORDP
will work earlier
tidied up UNIX-SIGNAL machinery: no more DEFCONSTANTs,
no more re-interning, no more descriptions
tweaked RUN-PROGRAM to use UNIX-SIGNAL-NUMBER function instead
of old bare SIGFOO constants
It's easier and nicer just to coerce all RUN-PROGRAM args
than to require that they be SIMPLE-STRINGs.
made test/*.test.sh use local sbcl, not installed sbcl, just
as other tests do

12 files changed:
package-data-list.lisp-expr
src/code/cold-init.lisp
src/code/late-type.lisp
src/code/run-program.lisp
src/code/signal.lisp
src/code/target-signal.lisp
tests/foreign.test.sh
tests/run-program.test.sh
tests/run-tests.sh
tests/side-effectful-pathnames.test.sh
tests/type.impure.lisp
version.lisp-expr

index afcc413..bf39cd6 100644 (file)
@@ -1516,7 +1516,7 @@ no guarantees of interface stability."
              "UNIX-UID" "UNIX-UNLINK" "UNIX-UTIMES" "UNIX-WRITE" "WINSIZE"
              "WRITEGRP" "WRITEOTH" "WRITEOWN" "WS-COL" "WS-ROW" "WS-XPIXEL"
              "WS-YPIXEL" "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO"
-             "SIGEMSG" "SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2"
+             "SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2"
              "EALREADY" "SIGPIPE" "EACCES" "CHECK" "SIGXCPU" "EOPNOTSUPP"
              "SIGFPE" "SIGHUP" "ENOTSOCK" "OPEN-DIR" "SIGMASK" "EINTR"
              "SIGCONT" "UNIX-RESOLVE-LINKS" "SIGKILL" "EMSGSIZE" "ERANGE"
@@ -1527,7 +1527,7 @@ no guarantees of interface stability."
              "UNIX-FAST-GETRUSAGE" "EPERM" "SIGINT" "EXDEV" "EDEADLK"
              "ENOSPC" "ECONNREFUSED" "SIGWINCH" "ENOPROTOOPT" "ESRCH"
              "EUSERS" "SIGVTALRM" "ENOTCONN" "ESUCCESS" "EPIPE"
-             "UNIX-SIMPLIFY-PATHNAME" "EISCONN" "FD-ISSET" "SIGMSG"
+             "UNIX-SIMPLIFY-PATHNAME" "EISCONN" "FD-ISSET"
              "ESHUTDOWN" "EBUSY" "SIGTERM" "ENAMETOOLONG" "EMLINK"
              "EADDRINUSE" "SIGBUS" "ERESTART" "TTY-PROCESS-GROUP"
              "UNIX-SIGNAL-NAME" "ETIMEDOUT" "ECHILD" "EFBIG" "SIGTRAP"
@@ -1535,7 +1535,7 @@ no guarantees of interface stability."
              "EHOSTUNREACH" "EBADF" "EINVAL" "FD-SET" "CLOSE-DIR" "EISDIR"
              "SIGTTIN" "UNIX-KILL" "ENOTDIR" "EHOSTDOWN" "E2BIG" "ESPIPE"
              "UNIX-FAST-SELECT" "ENXIO" "ENOTTY" "ELOOP" "LTCHARS"
-             "UNIX-SIGNAL-DESCRIPTION" "SIGXFSZ" "EINPROGRESS" "ENOENT"
+             "SIGXFSZ" "EINPROGRESS" "ENOENT"
              "EPROTONOSUPPORT" "UNIX-SIGBLOCK" "SIGIO" "ENOMEM" "SIGEMT"
              "EFAULT" "ENODEV" "EIO" "EVICEERR" "ETXTBSY" "EWOULDBLOCK"
              "EAGAIN" "EDESTADDRREQ" "ENOEXEC" "ENETUNREACH" "ENOTEMPTY"
index 7bcaca1..a14e269 100644 (file)
   ;; this to be initialized, so we initialize it right away.
   (show-and-call !random-cold-init)
 
+  (show-and-call !package-cold-init)
+
   ;; All sorts of things need INFO and/or (SETF INFO).
   (/show0 "about to SHOW-AND-CALL !GLOBALDB-COLD-INIT")
   (show-and-call !globaldb-cold-init)
   ;; functions are called in the same relative order as the toplevel
   ;; forms of the corresponding source files.
 
-  (show-and-call !package-cold-init)
+  ;;(show-and-call !package-cold-init)
   (show-and-call !policy-cold-init-or-resanify)
   (/show0 "back from !POLICY-COLD-INIT-OR-RESANIFY")
 
index edd81f7..3371b95 100644 (file)
             (type-components type2)))))
 
 (!def-type-translator and (&whole whole &rest type-specifiers)
-  ;; Note: Between the behavior of SIMPLIFY-INTERSECTION-TYPE (which
-  ;; will reduce to a 1-element list any list of types which CMU CL
-  ;; could've represented) and MAKE-INTERSECTION-TYPE-OR-SOMETHING
-  ;; (which knows to treat a 1-element intersection as the element
-  ;; itself) we should recover CMU CL's behavior for anything which it
-  ;; could handle usefully (i.e. could without punting to HAIRY-TYPE).
+
   (/show0 "entering type translator for AND")
-  (if *xtype?* 
-      (make-intersection-type-or-something
-       (mapcar #'specifier-type type-specifiers))
-      (let ((res *wild-type*))
-       (dolist (type-specifier type-specifiers res)
-         (let ((ctype (specifier-type type-specifier)))
-           (multiple-value-bind (int win) (type-intersection res ctype)
-             (unless win
-               (return (make-hairy-type :specifier whole)))
-             (setq res int)))))))
+
+  ;; FIXME: doesn't work (causes cold boot to fail), should probably
+  ;; be replaced by something based on simplification of all possible
+  ;; pairs
+  #|
+  (make-intersection-type-or-something
+   (mapcar #'specifier-type type-specifiers))
+  |#
+
+  ;; substantially the old CMU CL code
+  ;;
+  ;; FIXME: should be replaced by something based on simplification
+  ;; of all pairs, not just adjacent pairs
+  (let ((res *wild-type*))
+    (dolist (type-specifier type-specifiers res)
+      (let ((ctype (specifier-type type-specifier)))
+       (multiple-value-bind (int win) (type-intersection res ctype)
+         (unless win
+           (return (make-hairy-type :specifier whole)))
+         (setq res int))))))
 \f
 ;;;; union types
 
index 59b2e6e..b00f92e 100644 (file)
          (t
           (let ((signal (ldb (byte 7 0) status)))
             (values pid
-                    (if (or (eql signal sb-unix:sigstop)
-                            (eql signal sb-unix:sigtstp)
-                            (eql signal sb-unix:sigttin)
-                            (eql signal sb-unix:sigttou))
+                    (if (position signal
+                                  #.(vector
+                                     (sb-unix:unix-signal-number :sigstop)
+                                     (sb-unix:unix-signal-number :sigtstp)
+                                     (sb-unix:unix-signal-number :sigttin)
+                                     (sb-unix:unix-signal-number :sigttou)))
                         :stopped
                         :signaled)
                     signal
       (cond ((not okay)
             (values nil errno))
            ((and (eql pid (process-pid proc))
-                 (= (sb-unix:unix-signal-number signal) sb-unix:sigcont))
+                 (= (sb-unix:unix-signal-number signal)
+                    (sb-unix:unix-signal-number :sigcont)))
             (setf (process-%status proc) :running)
             (setf (process-exit-code proc) nil)
             (when (process-status-hook proc)
    (setf *active-processes* (delete proc *active-processes*)))
   proc)
 
-;;; the handler for sigchld signals that RUN-PROGRAM establishes
+;;; the handler for SIGCHLD signals that RUN-PROGRAM establishes
 (defun sigchld-handler (ignore1 ignore2 ignore3)
   (declare (ignore ignore1 ignore2 ignore3))
   (get-processes-status-changes))
            (setf (process-core-dumped proc) core)
            (when (process-status-hook proc)
              (funcall (process-status-hook proc) proc))
-           (when (or (eq what :exited)
-                     (eq what :signaled))
+           (when (position what #(:exited :signaled))
              (sb-sys:without-interrupts
               (setf *active-processes*
                     (delete proc *active-processes*)))))))))
 \f
 ;;;; RUN-PROGRAM and close friends
 
-(defvar *close-on-error* nil
-  "List of file descriptors to close when RUN-PROGRAM exits due to an error.")
-(defvar *close-in-parent* nil
-  "List of file descriptors to close when RUN-PROGRAM returns in the parent.")
-(defvar *handlers-installed* nil
-  "List of handlers installed by RUN-PROGRAM.")
+;;; list of file descriptors to close when RUN-PROGRAM exits due to an error
+(defvar *close-on-error* nil)
+
+;;; list of file descriptors to close when RUN-PROGRAM returns in the parent
+(defvar *close-in-parent* nil)
+
+;;; list of handlers installed by RUN-PROGRAM
+(defvar *handlers-installed* nil)
 
 #+FreeBSD
 (def-alien-type nil
          (sg-chars (array sb-c-call:char 4))
          (sg-flags sb-c-call:int)))
 
-;;; Find a pty that is not in use. Return three values: the file
-;;; descriptor for the master side of the pty, the file descriptor for
-;;; the slave side of the pty, and the name of the tty device for the
-;;; slave side.
+;;; Find an unused pty. Return three values: the file descriptor for
+;;; the master side of the pty, the file descriptor for the slave side
+;;; of the pty, and the name of the tty device for the slave side.
 (defun find-a-pty ()
   (dolist (char '(#\p #\q))
     (dotimes (digit 16)
   (when (and env-p environment-p)
     (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
   ;; Make sure that the interrupt handler is installed.
-  (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler)
-  ;; Make sure that all the args are okay.
-  (unless (every #'simple-string-p args)
-    (error "All arguments to program must be simple strings: ~S" args))
+  (sb-sys:enable-interrupt :sigchld #'sigchld-handler)
   ;; Prepend the program to the argument list.
   (push (namestring program) args)
   (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
        *close-in-parent*
        *handlers-installed*
        ;; Establish PROC at this level so that we can return it.
-       proc)
+       proc
+       ;; It's friendly to allow the caller to pass any string
+       ;; designator, but internally we'd like SIMPLE-STRINGs.
+       (simple-args (mapcar (lambda (x) (coerce x 'simple-string)) args)))
     (unwind-protect
         (let (;; FIXME: The old code here used to do
               ;;   (MERGE-PATHNAMES PROGRAM "path:"),
           (unless pfile
             (error "no such program: ~S" program))
           (multiple-value-bind (stdin input-stream)
-              (get-descriptor-for input cookie :direction :input
+              (get-descriptor-for input cookie
+                                  :direction :input
                                   :if-does-not-exist if-input-does-not-exist)
             (multiple-value-bind (stdout output-stream)
-                (get-descriptor-for output cookie :direction :output
+                (get-descriptor-for output cookie
+                                    :direction :output
                                     :if-exists if-output-exists)
               (multiple-value-bind (stderr error-stream)
                   (if (eq error :output)
                       (values stdout output-stream)
-                      (get-descriptor-for error cookie :direction :output
+                      (get-descriptor-for error cookie
+                                          :direction :output
                                           :if-exists if-error-exists))
                 (multiple-value-bind (pty-name pty-stream)
                     (open-pty pty cookie)
                   ;; death before we have installed the PROCESS
                   ;; structure in *ACTIVE-PROCESSES*.
                   (sb-sys:without-interrupts
-                   (with-c-strvec (args-vec args)
+                   (with-c-strvec (args-vec simple-args)
                      (with-c-strvec (environment-vec environment)
                        (let ((child-pid
                               (without-gcing
index ddaf73f..cc8d985 100644 (file)
 ;;;; utilities for dealing with signal names and numbers
 
 (defstruct (unix-signal
-           (:constructor make-unix-signal (%name %number %description))
+           (:constructor make-unix-signal (%name %number))
            (:copier nil))
-  %name                                    ; signal keyword
-  (%number nil :type integer)       ; UNIX signal number
-  (%description nil :type string))  ; documentation
+  ;; signal keyword (e.g. :SIGINT for the Unix SIGINT signal)
+  (%name   (required-argument) :type keyword :read-only t)
+  ;; signal number
+  (%number (required-argument) :type integer :read-only t))
 
-(defvar *unix-signals* nil
-  #!+sb-doc
-  "A list of Unix signal structures.")
-
-(defmacro def-unix-signal (name number description)
-  (let ((symbol (intern (symbol-name name))))
-    `(progn
-       ;; KLUDGE: This PUSH should be probably be something like PUSHNEW if we
-       ;; want to be able to cleanly reload this file. (Or perhaps
-       ;; *UNIX-SIGNALS* should be a hash table keyed by signal name, or a
-       ;; vector keyed by signal number?)
-       (push (make-unix-signal ,name ,number ,description) *unix-signals*)
-       ;; This is to make the new signal lookup stuff compatible with
-       ;; old code which expects the symbol with the same print name as
-       ;; our keywords to be a constant with a value equal to the signal
-       ;; number.
-       (defconstant ,symbol ,number ,description))))
-
-(defun unix-signal-or-lose (arg)
-  (let ((signal (find arg *unix-signals*
-                     :key (etypecase arg
-                            (symbol #'unix-signal-%name)
-                            (number #'unix-signal-%number)))))
-    (unless signal
-      (error "~S is not a valid signal name or number." arg))
-    signal))
-
-(defun unix-signal-name (signal)
-  #!+sb-doc
-  "Return the name of the signal as a string. Signal should be a valid
-  signal number or a keyword of the standard UNIX signal name."
-  (symbol-name (unix-signal-%name (unix-signal-or-lose signal))))
+;;; list of all defined UNIX-SIGNALs
+(defvar *unix-signals* nil)
 
-(defun unix-signal-description (signal)
-  #!+sb-doc
-  "Return a string describing signal. Signal should be a valid signal
-  number or a keyword of the standard UNIX signal name."
-  (unix-signal-%description (unix-signal-or-lose signal)))
+(defmacro !def-unix-signal (name number)
+  (declare (type keyword name))
+  (declare (type (and fixnum unsigned-byte) number))
+  `(push (make-unix-signal ,name ,number) *unix-signals*))
 
-(defun unix-signal-number (signal)
-  #!+sb-doc
-  "Return the number of the given signal. Signal should be a valid
-  signal number or a keyword of the standard UNIX signal name."
-  (unix-signal-%number (unix-signal-or-lose signal)))
+(/show0 "signal.lisp 131")
+
+(defun unix-signal-or-lose (designator)
+  (or (find designator (the list *unix-signals*)
+           :key (etypecase designator
+                  (symbol #'unix-signal-%name)
+                  (number #'unix-signal-%number)))
+      (error "not a valid signal name or number: ~S" designator)))
+
+(/show0 "signal.lisp 142")
+
+;;; Return the name of the designated signal.
+(defun unix-signal-name (designator)
+  (symbol-name (unix-signal-%name (unix-signal-or-lose designator))))
+
+(/show0 "signal.lisp 150")
+
+;;; Return the number of the designated signal.
+(defun unix-signal-number (designator)
+  (unix-signal-%number (unix-signal-or-lose designator)))
+
+(/show0 "signal.lisp 168")
 
 ;;; known signals
-(def-unix-signal :CHECK 0 "Check")
-(def-unix-signal :SIGHUP 1 "Hangup")
-(def-unix-signal :SIGINT 2 "Interrupt")
-(def-unix-signal :SIGQUIT 3 "Quit")
-(def-unix-signal :SIGILL 4 "Illegal instruction")
-(def-unix-signal :SIGTRAP 5 "Trace trap")
-(def-unix-signal :SIGIOT 6 "Iot instruction")
+(/show0 "defining Unix signals")
+(!def-unix-signal :CHECK 0) ; check
+(/show0 "done defining CHECK")
+(!def-unix-signal :SIGHUP 1) ; hangup
+(/show0 "done defining SIGHUP")
+(!def-unix-signal :SIGINT 2) ; interrupt
+(/show0 "done defining SIGINT")
+(!def-unix-signal :SIGQUIT 3) ; quit
+(!def-unix-signal :SIGILL 4) ; illegal instruction
+(!def-unix-signal :SIGTRAP 5) ; trace trap
+(!def-unix-signal :SIGIOT 6) ; IOT instruction
 #!-linux
-(def-unix-signal :SIGEMT 7 "Emt instruction")
-(def-unix-signal :SIGFPE 8 "Floating point exception")
-(def-unix-signal :SIGKILL 9 "Kill")
-(def-unix-signal :SIGBUS #!-linux 10 #!+linux 7 "Bus error")
-(def-unix-signal :SIGSEGV 11 "Segmentation violation")
+(!def-unix-signal :SIGEMT 7) ; EMT instruction
+(!def-unix-signal :SIGFPE 8) ; floating point exception
+(!def-unix-signal :SIGKILL 9) ; kill
+(!def-unix-signal :SIGBUS #!-linux 10 #!+linux 7) ; bus error
+(!def-unix-signal :SIGSEGV 11) ; segmentation violation
 #!-linux
-(def-unix-signal :SIGSYS 12 "Bad argument to system call")
-(def-unix-signal :SIGPIPE 13 "Write on a pipe with no one to read it")
-(def-unix-signal :SIGALRM 14 "Alarm clock")
-(def-unix-signal :SIGTERM 15 "Software termination signal")
+(!def-unix-signal :SIGSYS 12) ; bad argument to system call
+(!def-unix-signal :SIGPIPE 13) ; write on a pipe with no one to read it
+(!def-unix-signal :SIGALRM 14) ; alarm clock
+(!def-unix-signal :SIGTERM 15) ; software termination signal
 #!+linux
-(def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor")
-(def-unix-signal :SIGURG #!+svr4 21 #!-(or hpux svr4 linux) 16 #!+hpux 29
-  #!+linux 23 "Urgent condition present on socket")
-(def-unix-signal :SIGSTOP #!-(or hpux svr4 linux) 17 #!+hpux 24 #!+svr4 23
-  #!+linux 19 "Stop")
-(def-unix-signal :SIGTSTP #!-(or hpux svr4 linux) 18 #!+hpux 25 #!+svr4 24
-  #!+linux 20 "Stop signal generated from keyboard")
-(def-unix-signal :SIGCONT #!-(or hpux svr4 linux) 19 #!+hpux 26 #!+svr4 25
-  #!+linux 18 "Continue after stop")
-(def-unix-signal :SIGCHLD #!-(or linux hpux) 20
-  #!+hpux 18 #!+linux 17 "Child status has changed")
-(def-unix-signal :SIGTTIN #!-(or hpux svr4) 21 #!+hpux 27 #!+svr4 26
-  "Background read attempted from control terminal")
-(def-unix-signal :SIGTTOU #!-(or hpux svr4) 22 #!+hpux 28 #!+svr4 27
-  "Background write attempted to control terminal")
-(def-unix-signal :SIGIO #!-(or hpux irix linux) 23 #!+(or hpux irix) 22
-  #!+linux 29
-  "I/O is possible on a descriptor")
+(!def-unix-signal :SIGSTKFLT 16) ; stack fault on coprocessor
+(!def-unix-signal :SIGURG ; urgent condition present on socket
+  #!+svr4 21
+  #!-(or hpux svr4 linux) 16
+  #!+hpux 29
+  #!+linux 23)
+(!def-unix-signal :SIGSTOP ; stop
+  #!-(or hpux svr4 linux) 17
+  #!+hpux 24
+  #!+svr4 23
+  #!+linux 19)
+(!def-unix-signal :SIGTSTP ;  stop signal generated from keyboard
+  #!-(or hpux svr4 linux) 18
+  #!+hpux 25
+  #!+svr4 24
+  #!+linux 20)
+(!def-unix-signal :SIGCONT ; continue after stop
+  #!-(or hpux svr4 linux) 19
+  #!+hpux 26
+  #!+svr4 25
+  #!+linux 18)
+(!def-unix-signal :SIGCHLD ; Child status has changed.
+  #!-(or linux hpux) 20
+  #!+hpux 18
+  #!+linux 17)
+(!def-unix-signal :SIGTTIN ; background read attempted from control terminal
+  #!-(or hpux svr4) 21
+  #!+hpux 27
+  #!+svr4 26)
+(!def-unix-signal :SIGTTOU ; background write attempted to control terminal
+  #!-(or hpux svr4) 22
+  #!+hpux 28
+  #!+svr4 27)
+(!def-unix-signal :SIGIO ; I/O is possible on a descriptor.
+  #!-(or hpux irix linux) 23
+  #!+(or hpux irix) 22
+  #!+linux 29)
 #!-hpux
-(def-unix-signal :SIGXCPU #!-svr4 24 #!+svr4 30  "Cpu time limit exceeded")
+(!def-unix-signal :SIGXCPU ; CPU time limit exceeded
+  #!-svr4 24
+  #!+svr4 30)
 #!-hpux
-(def-unix-signal :SIGXFSZ #!-svr4 25 #!+svr4 31 "File size limit exceeded")
-(def-unix-signal :SIGVTALRM #!-(or hpux svr4) 26 #!+hpux 20 #!+svr4 28
-    "Virtual time alarm")
-(def-unix-signal :SIGPROF #!-(or hpux svr4 linux) 27 #!+hpux 21 #!+svr4 29
-  #!+linux 30 "Profiling timer alarm")
-(def-unix-signal :SIGWINCH #!-(or hpux svr4) 28 #!+hpux 23 #!+svr4 20
-    "Window size change")
-(def-unix-signal :SIGUSR1 #!-(or hpux svr4 linux) 30 #!+(or hpux svr4) 16
-  #!+linux 10 "User defined signal 1")
-(def-unix-signal :SIGUSR2 #!-(or hpux svr4 linux) 31 #!+(or hpux svr4) 17
-  #!+linux 12 "User defined signal 2")
-
-#!+mach
-(def-unix-signal :SIGEMSG 30 "Mach Emergency message")
-#!+mach
-(def-unix-signal :SIGMSG 31 "Mach message")
+(!def-unix-signal :SIGXFSZ ;  file size limit exceeded
+  #!-svr4 25
+  #!+svr4 31)
+(!def-unix-signal :SIGVTALRM ; virtual time alarm
+  #!-(or hpux svr4) 26
+  #!+hpux 20
+  #!+svr4 28)
+(!def-unix-signal :SIGPROF ;  profiling timer alarm
+  #!-(or hpux svr4 linux) 27
+  #!+hpux 21
+  #!+svr4 29
+  #!+linux 30)
+(!def-unix-signal :SIGWINCH ; window size change
+  #!-(or hpux svr4) 28
+  #!+hpux 23
+  #!+svr4 20)
+(!def-unix-signal :SIGUSR1 ;  user-defined signal 1
+  #!-(or hpux svr4 linux) 30
+  #!+(or hpux svr4) 16
+  #!+linux 10)
+(!def-unix-signal :SIGUSR2 ; user-defined signal 2
+  #!-(or hpux svr4 linux) 31
+  #!+(or hpux svr4) 17
+  #!+linux 12)
 
 ;;; SVR4 (or Solaris?) specific signals
 #!+svr4
-(def-unix-signal :SIGWAITING 32 "Process's lwps are blocked")
+(!def-unix-signal :SIGWAITING 32) ; Process's LWPs are blocked.
 
 (sb!xc:defmacro sigmask (&rest signals)
   #!+sb-doc
   "Returns a mask given a set of signals."
   (apply #'logior
-        (mapcar #'(lambda (signal)
-                    (ash 1 (1- (unix-signal-number signal))))
+        (mapcar (lambda (signal)
+                  (ash 1 (1- (unix-signal-number signal))))
                 signals)))
+
+(/show0 "done with signal.lisp")
index 7320196..04ba674 100644 (file)
 \f
 ;;;; interface to enabling and disabling signal handlers
 
-(defun enable-interrupt (signal handler)
+(defun enable-interrupt (signal-designator handler)
   (declare (type (or function (member :default :ignore)) handler))
   (without-gcing
-   (let ((result (install-handler (unix-signal-number signal)
+   (let ((result (install-handler (unix-signal-number signal-designator)
                                  (case handler
                                    (:default sig_dfl)
                                    (:ignore sig_ign)
index 69702f6..ae735b2 100644 (file)
 # absolutely no warranty. See the COPYING and CREDITS files for
 # more information.
 
+sbcl="$1"
+
 testfilestem=$TMPDIR/sbcl-foreign-test-$$
 
 echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c
 make $testfilestem.o
 ld -shared -o $testfilestem.so $testfilestem.o
 
-sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
+$sbcl <<EOF
   (load-foreign '("$testfilestem.so"))
   (def-alien-routine summish int (x int) (y int))
   (assert (= (summish 10 20) 31))
index 90e0187..12d9fa4 100644 (file)
@@ -17,7 +17,9 @@
 # one of the tests below).
 export SOMETHING_IN_THE_ENVIRONMENT='yes there is'
 
-sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
+sbcl="$1"
+
+$sbcl <<EOF
   (let ((string (with-output-to-string (stream)
                   (sb-ext:run-program "/bin/echo"
                                       '("foo" "bar")
index 90e7581..a563aaf 100644 (file)
@@ -66,7 +66,7 @@ echo //running '*.test.sh' tests
 for f in *.test.sh; do
     if [ -f $f ]; then
        echo //running $f test
-       sh $f ; tenfour
+       sh $f "$sbcl"; tenfour
     fi
 done
 
index dfd56b1..4dc3d8a 100644 (file)
@@ -1,5 +1,7 @@
 #!/bin/sh
 
+sbcl="$1"
+
 # LOADing and COMPILEing files with logical pathnames
 testdir=`pwd`"/side-effectful-pathnames-test-$$"
 testfilestem="load-test"
@@ -10,7 +12,7 @@ cat >$testfilename <<EOF
   (in-package :cl-user)
   (defparameter *loaded* :yes)
 EOF
-sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <<EOF
+$sbcl <<EOF
   (in-package :cl-user)
   (setf (logical-pathname-translations "TEST")
         (list (list "**;*.*.*" "$testdir/**/*.*")))
index 1dbf49c..9697487 100644 (file)
@@ -86,9 +86,9 @@
 (assert (not (typep 11 '(or))))
 
 ;;; bug 12: type system didn't grok nontrivial intersections
+#| ; "we gotta target, but you gotta be patient": 0.6.11.x work in progress 
 (assert (subtypep '(and symbol (satisfies keywordp)) 'symbol))
 (assert (not (subtypep '(and symbol (satisfies keywordp)) 'null)))
-#| ; "we gotta target, but you gotta be patient": 0.6.11.11 work in progress 
 (assert (subtypep 'keyword 'symbol))
 (assert (not (subtypep 'symbol 'keyword)))
 (assert (subtypep 'ratio 'real))
index 086487c..aabdc4e 100644 (file)
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.11.11"
+"0.6.11.12"