From ef61e6c46ca429b84a61e90efcd7ac11261f92c7 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 1 May 2012 14:30:55 +0300 Subject: [PATCH] add SB-UNIX:UNIX-EXIT back, use the deprecation framwork for it and SB-EXT:QUIT Also extend the deprecation framwork to support multiple replacements: SB-EXT:QUIT should be replaced either by SB-EXT:EXIT or SB-EXT:ABORT-THREAD, depending on the way it was being used. --- package-data-list.lisp-expr | 4 ++- src/code/cold-init.lisp | 6 ++--- src/code/condition.lisp | 19 +++++++++----- src/code/early-extensions.lisp | 57 ++++++++++++++++++++++++---------------- src/code/unix.lisp | 6 +++++ 5 files changed, 58 insertions(+), 34 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 3a6b84a..cbc0b4a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2469,7 +2469,9 @@ no guarantees of interface stability." "UNIX-CLOSEDIR" "UNIX-DIRENT-NAME" "UNIX-DUP" "UNIX-FILE-MODE" "UNIX-FSTAT" "UNIX-GETHOSTNAME" "UNIX-GETPID" "UNIX-GETRUSAGE" - "UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID" "UNIX-IOCTL" + "UNIX-GETTIMEOFDAY" "UNIX-GETUID" "UNIX-GID" + "UNIX-EXIT" + "UNIX-IOCTL" "UNIX-ISATTY" "UNIX-LSEEK" "UNIX-LSTAT" "UNIX-MKDIR" "UNIX-OPEN" "UNIX-OPENDIR" "UNIX-PATHNAME" "UNIX-PID" "UNIX-PIPE" "UNIX-SIMPLE-POLL" "UNIX-READ" "UNIX-READDIR" "UNIX-READLINK" "UNIX-REALPATH" diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index df0c1ce..28ee7a8 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -274,10 +274,8 @@ (toplevel-init) (critically-unreachable "after TOPLEVEL-INIT"))) -(defun quit (&key recklessly-p (unix-status 0)) - #!+sb-doc - "Deprecated. See: SB-EXT:EXIT, SB-THREAD:RETURN-FROM-THREAD, -SB-THREAD:ABORT-THREAD." +(define-deprecated-function :early "1.0.56.55" quit (exit sb!thread:abort-thread) + (&key recklessly-p (unix-status 0)) (if (or recklessly-p (sb!thread:main-thread-p)) (exit :code unix-status :abort recklessly-p) (sb!thread:abort-thread)) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index bbeac70..3e7e84e 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1614,7 +1614,7 @@ the usual naming convention (names like *FOO*) for special variables" (define-condition deprecation-condition () ((name :initarg :name :reader deprecated-name) - (replacement :initarg :replacement :reader deprecated-name-replacement) + (replacements :initarg :replacements :reader deprecated-name-replacements) (since :initarg :since :reader deprecated-since) (runtime-error :initarg :runtime-error :reader deprecated-name-runtime-error))) @@ -1622,14 +1622,21 @@ the usual naming convention (names like *FOO*) for special variables" (let ((*package* (find-package :keyword))) (if *print-escape* (print-unreadable-object (condition stream :type t) - (format stream "~S is deprecated~@[, use ~S~]" + (apply #'format + stream "~S is deprecated.~ + ~#[~; Use ~S instead.~; ~ + Use ~S or ~S instead.~:; ~ + Use~@{~#[~; or~] ~S~^,~} instead.~]" (deprecated-name condition) - (deprecated-name-replacement condition))) - (format stream "~@<~S has been deprecated as of SBCL ~A~ - ~@[, use ~S instead~].~:@>" + (deprecated-name-replacements condition))) + (apply #'format + stream "~@<~S has been deprecated as of SBCL ~A.~ + ~#[~; Use ~S instead.~; ~ + Use ~S or ~S instead.~:; ~ + Use~@{~#[~; or~] ~S~^,~:_~} instead.~]~:@>" (deprecated-name condition) (deprecated-since condition) - (deprecated-name-replacement condition))))) + (deprecated-name-replacements condition))))) (define-condition early-deprecation-warning (style-warning deprecation-condition) ()) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 0927619..1d297c3 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -1089,52 +1089,63 @@ ;;;; Deprecating stuff -(defun deprecation-error (since name replacement) +(defun normalize-deprecation-replacements (replacements) + (if (or (not (listp replacements)) + (eq 'setf (car replacements))) + (list replacements) + replacements)) + +(defun deprecation-error (since name replacements) (error 'deprecation-error :name name - :replacement replacement + :replacements (normalize-deprecation-replacements replacements) :since since)) -(defun deprecation-warning (state since name replacement +(defun deprecation-warning (state since name replacements &key (runtime-error (neq :early state))) (warn (ecase state (:early 'early-deprecation-warning) (:late 'late-deprecation-warning) (:final 'final-deprecation-warning)) :name name - :replacement replacement + :replacements (normalize-deprecation-replacements replacements) :since since :runtime-error runtime-error)) -(defun deprecated-function (since name replacement) +(defun deprecated-function (since name replacements) (lambda (&rest deprecated-function-args) (declare (ignore deprecated-function-args)) - (deprecation-error since name replacement))) + (deprecation-error since name replacements))) -(defun deprecation-compiler-macro (state since name replacement) +(defun deprecation-compiler-macro (state since name replacements) (lambda (form env) (declare (ignore env)) - (deprecation-warning state since name replacement) + (deprecation-warning state since name replacements) form)) -(defmacro define-deprecated-function (state since name replacement lambda-list &body body) - (let ((doc (let ((*package* (find-package :keyword))) - (format nil "~@<~S has been deprecated as of SBCL ~A~@[, use ~S instead~].~:>" - name since replacement)))) +(defmacro define-deprecated-function (state since name replacements lambda-list &body body) + (let* ((replacements (normalize-deprecation-replacements replacements)) + (doc (let ((*package* (find-package :keyword))) + (apply #'format nil + "~@<~S has been deprecated as of SBCL ~A.~ + ~#[~; Use ~S instead.~; ~ + Use ~S or ~S instead.~:; ~ + Use~@{~#[~; or~] ~S~^,~} instead.~]~@:>" + name since replacements)))) `(progn ,(ecase state - ((:early :late) - `(defun ,name ,lambda-list - ,doc - ,@body)) - ((:final) - `(progn - (declaim (ftype (function * nil) ,name)) - (setf (fdefinition ',name) - (deprecated-function ',name ',replacement ,since)) - (setf (documentation ',name 'function) ,doc)))) + ((:early :late) + `(defun ,name ,lambda-list + ,doc + ,@body)) + ((:final) + `(progn + (declaim (ftype (function * nil) ,name)) + (setf (fdefinition ',name) + (deprecated-function ',name ',replacements ,since)) + (setf (documentation ',name 'function) ,doc)))) (setf (compiler-macro-function ',name) - (deprecation-compiler-macro ,state ,since ',name ',replacement))))) + (deprecation-compiler-macro ,state ,since ',name ',replacements))))) ;;; Anaphoric macros (defmacro awhen (test &body body) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 2373feb..7a1a628 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -430,12 +430,18 @@ corresponds to NAME, or NIL if there is none." (deftype exit-code () `(signed-byte 32)) (defun os-exit (code &key abort) + #!+sb-doc + "Exit the process with CODE. If ABORT is true, exit is performed using _exit(2), +avoiding atexit(3) hooks, etc. Otherwise exit(2) is called." (unless (typep code 'exit-code) (setf code (if abort 1 0))) (if abort (void-syscall ("_exit" int) code) (void-syscall ("exit" int) code))) +(define-deprecated-function :early "1.0.56.55" unix-exit os-exit (code) + (os-exit code)) + ;;; Return the process id of the current process. (define-alien-routine ("getpid" unix-getpid) int) -- 1.7.10.4