Commit 19b4935e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Define and use not-implemented-error and parameter-error

parent d8aa1757
......@@ -125,8 +125,8 @@
(resolve-dependency-combination component (car dep-spec) (cdr dep-spec)))))
(defmethod resolve-dependency-combination (component combinator arguments)
(error (compatfmt "~@<Bad dependency ~S for ~S~@:>")
(cons combinator arguments) component))
(parameter-error (compatfmt "~@<In ~S, bad dependency ~S for ~S~@:>")
'resolve-dependency-combination (cons combinator arguments) component))
(defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments)
(when (featurep (first arguments))
......
......@@ -203,8 +203,9 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)
(unless (and (length=n-p arguments 1)
(typep (car arguments) '(or string (and symbol (not null)))))
(error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes one argument, a string or non-null symbol~@:>")
(cons combinator arguments) component combinator))
(parameter-error (compatfmt "~@<In ~S, bad dependency ~S for ~S. ~S takes one argument, a string or non-null symbol~@:>")
'resolve-dependency-combination
(cons combinator arguments) component combinator))
;; :require must be prepared for some implementations providing modules using ASDF,
;; as SBCL used to do, and others may might do. Thus, the system provided in the end
;; would be a downcased name as per module-provide-asdf above. For the same reason,
......
......@@ -622,7 +622,7 @@ in an atomic way if the implementation allows."
`(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname)))
#+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname)))
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl)
(error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera
(not-implemented-error 'delete-empty-directory "(on your platform)")) ; genera
(defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error))
"Delete a directory including all its recursive contents, aka rm -rf.
......
......@@ -232,7 +232,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+sbcl sb-ext:*posix-argv*
#+xcl system:*argv*
#-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
(error "raw-command-line-arguments not implemented yet"))
(not-implemented-error 'raw-command-line-arguments))
(defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
"Extract user arguments from command-line invocation of current process.
......@@ -422,7 +422,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
;; Is it meaningful to run these in the current environment?
;; only if we also track the object files that constitute the "current" image,
;; and otherwise simulate dump-image, including quitting at the end.
#-(or clasp ecl mkcl) (error "~S not implemented for your implementation (yet)" 'create-image)
#-(or clasp ecl mkcl) (not-implemented-error 'create-image)
#+(or clasp ecl mkcl)
(let ((epilogue-code
(if no-uiop
......
......@@ -30,10 +30,11 @@
#:list-to-hash-set #:ensure-gethash ;; hash-table
#:ensure-function #:access-at #:access-at-count ;; functions
#:call-function #:call-functions #:register-hook-function
#:lexicographic< #:lexicographic<= ;; version
#:parse-version #:unparse-version #:version< #:version<= #:version-compatible-p
#:match-condition-p #:match-any-condition-p ;; conditions
#:call-with-muffled-conditions #:with-muffled-conditions
#:lexicographic< #:lexicographic<=
#:parse-version #:unparse-version #:version< #:version<= #:version-compatible-p)) ;; version
#:not-implemented-error #:parameter-error))
(in-package :uiop/utility)
;;;; Defining functions in a way compatible with hot-upgrade:
......@@ -619,3 +620,41 @@ or a string describing the format-control of a simple-condition."
"Shorthand syntax for CALL-WITH-MUFFLED-CONDITIONS"
`(call-with-muffled-conditions #'(lambda () ,@body) ,conditions)))
;;; Conditions
(with-upgradability ()
(define-condition not-implemented-error (error)
((functionality :initarg :functionality)
(format-control :initarg :format-control)
(format-arguments :initarg :format-arguments))
(:report (lambda (condition stream)
(format stream "Not implemented: ~s~@[ ~?~]"
(slot-value condition 'functionality)
(slot-value condition 'format-control)
(slot-value condition 'format-arguments)))))
(defun not-implemented-error (functionality &optional format-control &rest format-arguments)
(error 'not-implemented-error
:functionality functionality
:format-control format-control
:format-arguments format-arguments))
(define-condition parameter-error (error)
((functionality :initarg :functionality)
(format-control :initarg :format-control)
(format-arguments :initarg :format-arguments))
(:report (lambda (condition stream)
(apply 'format stream
(slot-value condition 'format-control)
(slot-value condition 'functionality)
(slot-value condition 'format-arguments)))))
;; Note that functionality MUST be passed as the second argument to parameter-error, just after
;; the format-control. If you want it to not appear in first position in actual message, use
;; ~* and ~:* to adjust parameter order.
(defun parameter-error (format-control functionality &rest format-arguments)
(error 'parameter-error
:functionality functionality
:format-control format-control
:format-arguments format-arguments)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment