[PATCH] avoid compiler notes about unreachable code

Luis Oliveira <[email protected]> Mon, 10 Dec 2007 19:06:26 +0000
Newsgroups gmane.lisp.cclan.general
Message-ID <[email protected]>
Hello,

Currently, using the :PATHNAME keyword argument for DEFSYSTEM under SBCL
causes 2 compiler notes:

* (asdf:defsystem foo :pathname #p"/tmp/")
[...]
; note: deleting unreachable code
[...] 
; note: deleting unreachable code
; 
; compilation unit finished
;   printed 2 notes

#<ASDF:SYSTEM "foo" {119E7BA9}>

The attached patch should fix that minor annoyance.


-- 
Luís Oliveira
http://student.dei.uc.pt/~lmoliv/

-------------------------------------------------------------------------
SF.Net email is sponsored by: 
Check out the new SourceForge.net Marketplace.
It's the best place to buy or sell services for
just about anything Open Source.
http://sourceforge.net/services/buy/index.php

_______________________________________________
cclan-list mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/cclan-list
asdf-avoid-unreachable-code.patch (text/x-patch, 1.3 KB)
Index: asdf.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf/asdf.lisp,v
retrieving revision 1.110
diff -u -r1.110 asdf.lisp
--- asdf.lisp	27 Sep 2007 13:15:06 -0000	1.110
+++ asdf.lisp	10 Dec 2007 15:07:55 -0000
@@ -971,7 +971,9 @@
     (aux key arglist)))
 
 (defmacro defsystem (name &body options)
-  (destructuring-bind (&key pathname (class 'system) &allow-other-keys) options
+  (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system)
+                            &allow-other-keys)
+      options
     (let ((component-options (remove-keyword :class options)))
       `(progn
 	;; system must be registered before we parse the body, otherwise
@@ -992,11 +994,13 @@
 				   #'list
 				   :module (coerce-name ',name)
 				   :pathname
-				   (or ,pathname
-				       (when *load-truename*
-					 (pathname-sans-name+type
-					  (resolve-symlinks  *load-truename*)))
-				       *default-pathname-defaults*)
+				   ;; to avoid a note about unreachable code
+				   ,(if pathname-arg-p
+				        pathname
+				        `(or (when *load-truename*
+				               (pathname-sans-name+type
+				                (resolve-symlinks *load-truename*)))
+				             *default-pathname-defaults*))
 				   ',component-options))))))