[asdf-devel] 1.374

[Samium Gromoff]

From: Samium Gromoff <_deepfire at feelingofgreen.ru>
> From: "Tobias C. Rittweiler" <tcr at freebits.de>
>> Faré wrote
>> 
>>> 2009/12/21 Samium Gromoff 
>>>> Fare,
>>>>
>>>> Please consider the patch in the 'missing-definition' branch in
>>>>
>>>>   git://git.feelingofgreen.ru/asdf
>>>>
>>> Applied in my development repo, master branch:
>>>    http://common-lisp.net/project/xcvb/git/asdf.git
>>>
>>> Candidate for immediate release, if no one else disagrees.
>> 
>> (The above link is pretty useless.)
>> 
>> What does the patch do?
> 
> I'm sorry, obviously the burden was upon me to properly describe
> the proposed modification.
> 
> Basically, ASDF:FIND-SYSTEM assumed that SYSTEM-DEFINITION-PATHNAME
> returns a valid pathname.  But, of course, the reality is that ASDF
> doesn't have any leverage upon what is returned by the functions
> in the ASDF:*SYSTEM-DEFINITION-SEARCH-FUNCTIONS* list.
> 
> The implication is that if any function in that list screws up,
> by returninig a bogus pathname, the subsequent call to LOAD
> will fail with a relatively cryptic FILE-ERROR.
> 
> The proposed modification intercedes before the precious information
> is lost, by checking for presence of the referenced file, and
> signalling a more structured condition in case it does not exist.

I guess I also should provide the patch inline:


commit 2ca055895fb18aadcdbb3ab29f696c9fa63c1b62
Author: Samium Gromoff <_deepfire at feelingofgreen.ru>
Date:   Mon Dec 21 15:07:37 2009 +0300

    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.

diff --git a/asdf.lisp b/asdf.lisp
index 4a85132..a1cc31c 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


regards,
  Samium Gromoff
--
                                 _deepfire-at-feelingofgreen.ru
O< ascii ribbon campaign - stop html mail - www.asciiribbon.org