From 2ca055895fb18aadcdbb3ab29f696c9fa63c1b62 Mon Sep 17 00:00:00 2001 From: Samium Gromoff <_deepfire@feelingofgreen.ru> Date: Mon, 21 Dec 2009 15:07:37 +0300 Subject: [PATCH] New condition, MISSING-DEFINITION, signalled when a sysdef locator fails. Thanks to Nikodemus Siivola for coming up with a portable way to check for file existence. Dead symlinks defeat all things like CL-FAD:FILE-EXISTS-P. --- asdf.lisp | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 4a851322..a1cc31c7 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -109,6 +109,9 @@ #:*resolve-symlinks* #:operation-error #:compile-failed #:compile-warned #:compile-error + #:error-name + #:error-pathname + #:missing-definition #:error-component #:error-operation #:system-definition-error #:missing-component @@ -421,6 +424,14 @@ and NIL NAME and TYPE components" (:report (lambda (c s) (apply #'format s (format-control c) (format-arguments c))))) +(define-condition missing-definition (system-definition-error) + ((name :initarg :name :reader error-name) + (pathname :initarg :pathname :reader error-pathname)) + (:report (lambda (c s) + (format s "~@<Definition search function returned a wrong pathname ~A ~ + in search of a definition for system ~A.~@:>" + (error-pathname c) (error-name c))))) + (define-condition circular-dependency (system-definition-error) ((components :initarg :components :reader circular-dependency-components))) @@ -746,14 +757,17 @@ to `~a` which is not a directory.~@:>" (< (car in-memory) (safe-file-write-date on-disk)))) (let ((package (make-temporary-package))) (unwind-protect - (let ((*package* package)) - (asdf-message - "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%" - ;; FIXME: This wants to be (ENOUGH-NAMESTRING - ;; ON-DISK), but CMUCL barfs on that. - on-disk - *package*) - (load on-disk)) + (with-open-file (asd on-disk :if-does-not-exist nil) + (if asd + (let ((*package* package)) + (asdf-message + "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%" + ;; FIXME: This wants to be (ENOUGH-NAMESTRING + ;; ON-DISK), but CMUCL barfs on that. + on-disk + *package*) + (load asd)) + (error 'missing-definition :name name :pathname on-disk))) (delete-package package)))) (let ((in-memory (system-registered-p name))) (if in-memory -- GitLab