From 9259a065590233a0e3eaa8c7ac71b3ee6e220cd6 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Fri, 29 Oct 2010 06:11:01 -0700 Subject: [PATCH] 2.147: improve things somewhat for gcl. Merge two u-i-f-r-c methods for smaller output. --- asdf.lisp | 31 ++++++++++++++----------------- test/asdf-pathname-test.script | 9 ++++----- 2 files changed, 18 insertions(+), 22 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 43757f6f..2ffaeeb3 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -49,6 +49,8 @@ (cl:in-package :cl-user) +#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this + (eval-when (:compile-toplevel :load-toplevel :execute) ;;; make package if it doesn't exist yet. ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it. @@ -71,7 +73,7 @@ (eval-when (:load-toplevel :compile-toplevel :execute) (defvar *asdf-version* nil) (defvar *upgraded-p* nil) - (let* ((asdf-version "2.146") ;; bump this version when you modify this file. + (let* ((asdf-version "2.147") ;; bump this version when you modify this file. (existing-asdf (fboundp 'find-system)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -323,19 +325,14 @@ (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p))))) (when (find-class 'module nil) (eval - '(progn - (defmethod update-instance-for-redefined-class :after - ((m module) added deleted plist &key) - (declare (ignorable deleted plist)) - (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m)) - (when (member 'components-by-name added) - (compute-module-components-by-name m))) - (defmethod update-instance-for-redefined-class :after - ((s system) added deleted plist &key) - (declare (ignorable deleted plist)) - (when *asdf-verbose* (format *trace-output* "Updating ~A~%" s)) - (when (member 'source-file added) - (%set-system-source-file (probe-asd (component-name s) (component-pathname s)) s))))))) + '(defmethod update-instance-for-redefined-class :after + ((m module) added deleted plist &key) + (declare (ignorable deleted plist)) + (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m)) + (when (member 'components-by-name added) + (compute-module-components-by-name m)) + (when (and (typep m 'system) (member 'source-file added)) + (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m)))))) ;;;; ------------------------------------------------------------------------- ;;;; User-visible parameters @@ -535,11 +532,11 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (directory (pathname-directory specified)) (directory (cond - #-(or sbcl cmu) + #-(or sbcl cmu scl) ((stringp directory) `(:absolute ,directory) directory) #+gcl - ((and (consp directory) (stringp (first directory))) - `(:absolute ,@directory)) + ((and (consp directory) (not (member (first directory) '(:absolute :relative)))) + `(:relative ,@directory)) ((or (null directory) (and (consp directory) (member (first directory) '(:absolute :relative)))) directory) diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script index 0e2a0f52..50dd95ad 100644 --- a/test/asdf-pathname-test.script +++ b/test/asdf-pathname-test.script @@ -64,7 +64,6 @@ ("**;*.*.*" ,(make-pathname :directory (src-dir :wild-inferiors) :name :wild :type :wild)))) - (let ((failures nil) (systems `(,(make-pathname :directory (src-dir "system1") :name nil :type nil) ,(make-pathname :host "ASDFTEST" :directory '(:absolute "system1")) @@ -209,13 +208,12 @@ pathname)) (test-module (module) (incf directory-count) - (unless #-clisp (probe-file (asdf:component-pathname module)) - #+clisp (ext:probe-directory (asdf:component-pathname module)) + (unless (asdf::probe-file* (asdf:component-pathname module)) (incf directory-failures) (push (list (type-of module) (asdf:component-name module) (translate-if-needed (asdf:component-pathname module)) configuration - (list (when (asdf:component-parent module) (asdf:component-pathname (asdf:component-parent module))))) + (list (when (asdf:component-parent module) (asdf:component-pathname (asdf:component-parent module))))) failures))) (test-file (file) (incf file-count) @@ -280,7 +278,8 @@ (asdf:initialize-output-translations) (format t "output translations: ~S~%" (asdf::output-translations)) - #-(or clisp ecl) ; clisp has problem with the first one having :version :newest + #+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*))) + (progn ; 1- we're testing with unix, are we not? (assert (equal (asdf::resolve-location '(:home)) (truename (user-homedir-pathname)))) (assert (equal (asdf::resolve-location '("/foo" "bar" "baz")) #p"/foo/bar/baz")) -- GitLab