From 5c22c9e74892f3f1feaf80525cf42cf54ea37205 Mon Sep 17 00:00:00 2001
From: Gary King <gwking@metabang.com>
Date: Fri, 14 Dec 2007 18:10:01 +0000
Subject: [PATCH] Applied patch from Luis Oliveira to prevent unnecessary
 unreachable code warnings under SBCL when using the :pathname argument in
 defsystem.

---
 asdf.lisp | 59 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 32 insertions(+), 27 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index 81b0aa6f..07da6789 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  $Revision: 1.110 $
+;;; This is asdf: Another System Definition Facility.  $Revision: 1.111 $
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -115,7 +115,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "$Revision: 1.110 $")
+(defvar *asdf-revision* (let* ((v "$Revision: 1.111 $")
 			       (colon (or (position #\: v) -1))
 			       (dot (position #\. v)))
 			  (and v colon dot 
@@ -971,33 +971,38 @@ method.")
     (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
-	;; we recur when trying to find an existing system of the same name
-	;; to reuse options (e.g. pathname) from
-	(let ((s (system-registered-p ',name)))
-	  (cond ((and s (eq (type-of (cdr s)) ',class))
-		 (setf (car s) (get-universal-time)))
-		(s
-		 #+clisp
-		 (sysdef-error "Cannot redefine the existing system ~A with a different class" s)
-		 #-clisp
-		 (change-class (cdr s) ',class))
-		(t
-		 (register-system (quote ,name)
-				  (make-instance ',class :name ',name)))))
-	(parse-component-form nil (apply
-				   #'list
-				   :module (coerce-name ',name)
-				   :pathname
-				   (or ,pathname
-				       (when *load-truename*
-					 (pathname-sans-name+type
-					  (resolve-symlinks  *load-truename*)))
-				       *default-pathname-defaults*)
-				   ',component-options))))))
+	 ;; system must be registered before we parse the body, otherwise
+	 ;; we recur when trying to find an existing system of the same name
+	 ;; to reuse options (e.g. pathname) from
+	 (let ((s (system-registered-p ',name)))
+	   (cond ((and s (eq (type-of (cdr s)) ',class))
+		  (setf (car s) (get-universal-time)))
+		 (s
+		  #+clisp
+		  (sysdef-error "Cannot redefine the existing system ~A with a different class" s)
+		  #-clisp
+		  (change-class (cdr s) ',class))
+		 (t
+		  (register-system (quote ,name)
+				   (make-instance ',class :name ',name)))))
+	 (parse-component-form nil (apply
+				    #'list
+				    :module (coerce-name ',name)
+				    :pathname
+				    ;; 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))))))
   
 
 (defun class-for-type (parent type)
-- 
GitLab