Commit 9259a065 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.147: improve things somewhat for gcl. Merge two u-i-f-r-c methods for smaller output.

parent 69019dda
......@@ -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)
......
......@@ -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"))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment