:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
- :version "2.26.83" ;; to be automatically updated by bin/bump-revision
+ :version "2.26.84" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
nil)
(defmethod perform ((o load-fasl-op) (c system))
- (if-bind (it (first (input-files o c))) (load it)))
+ (perform-lisp-load-fasl o c))
(defmethod mark-operation-done :after ((o load-fasl-op) (c system))
(mark-operation-done (find-operation o 'load-op) c)) ; need we recurse on gather-components?
(declare (ignorable o))
(component-pathname c))
(defmethod perform ((o load-op) (c compiled-file))
- (declare (ignorable o))
- (load (first (input-files o c))))
+ (perform-lisp-load-fasl o c))
(defmethod perform ((o load-source-op) (c compiled-file))
(perform (find-operation o 'load-op) c))
(defmethod perform ((o load-fasl-op) (c compiled-file))
(when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 lacks output-translations and more.
(and (= system::*gcl-major-version* 2)
(< system::*gcl-minor-version* 7)))
+ (format t "Detected an old GCL 2.6. Only limited functionality available.~%")
(shadow 'type-of :asdf/compatibility)
+ (export 'with-standard-io-syntax)
(pushnew 'ignorable pcl::*variable-declarations-without-argument*)
(pushnew :gcl<2.7 *features*))
(unless (member :ansi-cl *features*)
#+gcl<2.7
(progn ;; Doesn't support either logical-pathnames or output-translations.
+ (defvar *gcl<2.7* t)
(deftype logical-pathname () nil)
(defun type-of (x) (class-name (class-of x)))
(defun wild-pathname-p (path) (declare (ignore path)) nil)
(format stream "#<~@[~S ~]" (when type (type-of object)))
(funcall thunk)
(format stream "~@[ ~X~]>" (when identity (system:address object))))
+ (defmacro with-standard-io-syntax (&body body)
+ `(progn ,@body))
(defmacro with-compilation-unit (options &body body)
(declare (ignore options)) `(progn ,@body))
(defmacro print-unreadable-object ((object stream &key type identity) &body body)
(asdf/package:define-package :asdf/find-system
(:recycle :asdf/find-system :asdf)
(:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os
- :asdf/upgrade :asdf/component :asdf/system)
+ :asdf/lisp-build :asdf/upgrade :asdf/component :asdf/system)
(:export
#:coerce-name #:find-system #:locate-system #:load-sysdef #:with-system-definitions
#:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems
(external-format (encoding-external-format (detect-encoding pathname))))
(asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
pathname package)
- (load pathname #-gcl<2.7 :external-format #-gcl<2.7 external-format)))
+ (with-controlled-loader-conditions ()
+ (load* pathname :external-format external-format))))
(delete-package package)))))
(defun* locate-system (name)
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.83: Another System Definition Facility.
+;;; This is ASDF 2.26.84: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
(component-name c)))
(perform (find-operation o 'compile-op) c)))))
(defun* perform-lisp-load-fasl (o c)
- (with-controlled-loader-conditions ()
- (load (first (input-files o c)))))
+ (if-bind (fasl (first (input-files o c)))
+ (with-controlled-loader-conditions () (load* fasl))))
(defmethod perform ((o load-op) (c cl-source-file))
(perform-lisp-load-fasl o c))
(defmethod perform ((o load-op) (c static-file))
(defun* call-with-controlled-compiler-conditions (thunk)
(call-with-muffled-uninteresting-conditions
thunk *uninteresting-compiler-conditions*))
-(defmacro with-controlled-compiler-conditions (() &body body)
+(defmacro with-controlled-compiler-conditions ((&optional) &body body)
"Run BODY where uninteresting compiler conditions are muffled"
`(call-with-controlled-compiler-conditions #'(lambda () ,@body)))
(defun* call-with-controlled-loader-conditions (thunk)
(call-with-muffled-uninteresting-conditions
thunk (append *uninteresting-compiler-conditions* *uninteresting-loader-conditions*)))
-(defmacro with-controlled-loader-conditions (() &body body)
+(defmacro with-controlled-loader-conditions ((&optional) &body body)
"Run BODY where uninteresting compiler and additional loader conditions are muffled"
`(call-with-muffled-uninteresting-conditions #'(lambda () ,@body)))
(remove-keys `(#+(and allegro (not (version>= 8 2))) :external-format
,@(unless output-file '(:output-file))) keys)))))
-(defun* load* (x &rest keys &key external-format &allow-other-keys)
- (declare (ignorable external-format))
+(defun* load* (x &rest keys &key &allow-other-keys)
(etypecase x
- ((or pathname string #-(or gcl-pre2.7 clozure allegro) stream)
+ ((or pathname string #-(or gcl<2.7 clozure allegro) stream)
(apply 'load x
#-gcl<2.7 keys #+gcl<2.7 (remove-keyword :external-format keys)))
#-(or gcl<2.7 clozure allegro)
;; ClozureCL 1.6 can only load from file input stream
;; Allegro 5, I don't remember but it must have been broken when I tested.
(stream ;; make do this way
- (let ((*load-pathname* nil)
- (*load-truename* nil)
- #+clozure (ccl::*default-external-format* external-format))
+ (let ((*package* *package*)
+ (*readtable* *readtable*)
+ (*load-pathname* nil)
+ (*load-truename* nil))
(eval-input x)))))
(defun* load-from-string (string)
(#+ecl if #+ecl (use-ecl-byte-compiler-p) #+ecl (apply 'compile-file* input-file keys)
#+mkcl progn
(let ((object-file
- (apply 'compile-file-pathname
- output-file #+ecl :type #+ecl :object #+mkcl :fasl-p #+mkcl nil)))
+ (compile-file-pathname
+ output-file #+ecl :type #+ecl :object #+mkcl :fasl-p #+mkcl nil)))
(multiple-value-bind (result flags1 flags2)
(apply 'compile-file* input-file
#+ecl :system-p #+ecl t #+mkcl :fasl-p #+mkcl nil
#:implementation-type #:operating-system #:architecture #:lisp-version-string
#:hostname #:user-homedir #:lisp-implementation-directory
#:getcwd #:chdir #:call-with-current-directory #:with-current-directory
- #:*temporary-directory* #:temporary-directory #:default-temporary-directory #:with-temporary-file))
+ #:*temporary-directory* #:temporary-directory #:default-temporary-directory
+ #:call-with-temporary-file #:with-temporary-file))
(in-package :asdf/os)
;;; Features
prefix keep (direction :io)
(element-type *default-stream-element-type*)
(external-format :default))
+ #+gcl<2.7 (declare (ignorable external-format))
(check-type direction (member :output :io))
(loop
:with prefix = (or prefix (format nil "~Atmp" (native-namestring (temporary-directory))))
;; TODO: on Unix, use CFFI and mkstemp -- but the master is precisely meant to not depend on CFFI or on anything! Grrrr.
(with-open-file (stream pathname
:direction direction
- :element-type element-type :external-format external-format
+ :element-type element-type
+ #-gcl<2.7 :external-format #-gcl<2.7 external-format
:if-exists nil :if-does-not-exist :create)
(when stream
(return
when the symbol is not found."
(block nil
(let ((package (find-package* package-designator error)))
- (when package
+ (when package ;; package error handled by find-package* already
(multiple-value-bind (symbol status) (find-symbol (string name) package)
(cond
(status (return (values symbol status)))
(defgeneric* slurp-input-stream (processor input-stream &key &allow-other-keys))
+#-(or gcl<2.7 genera)
(defmethod slurp-input-stream ((function function) input-stream &key &allow-other-keys)
(funcall function input-stream))
(defmethod slurp-input-stream ((list cons) input-stream &key &allow-other-keys)
(apply (first list) (cons input-stream (rest list))))
+#-(or gcl<2.7 genera)
(defmethod slurp-input-stream ((output-stream stream) input-stream
&key (element-type 'character) &allow-other-keys)
(copy-stream-to-stream
(declare (ignorable x))
(slurp-stream-forms stream))
+(defmethod slurp-input-stream (x stream &key (element-type 'character) &allow-other-keys)
+ (declare (ignorable stream element-type))
+ (cond
+ #+(or gcl<2.7 genera)
+ ((functionp x)
+ (funcall x stream))
+ #+(or gcl<2.7 genera)
+ ((output-stream-p x)
+ (copy-stream-to-stream stream x :element-type element-type))
+ (t
+ (error "Invalid ~S destination ~S" 'slurp-input-stream x))))
+
;;;; ----- Running an external program -----
;;; Simple variant of run-program with no input, and capturing output
:output (if pipe :stream t)
. #.(append
#+(or clozure cmu ecl sbcl scl) '(:error t)
- #+sbcl '(:search t
- #|:external-format external-format ; not in old SBCLs|#)))))
+ ;; note: :external-format requires a recent SBCL
+ #+sbcl '(:search t :external-format external-format)))))
(process
#+(or allegro lispworks) (if pipe (third process*) (first process*))
#+ecl (third process*)
:direction :input
:if-does-not-exist :error
:element-type element-type
- :external-format external-format)
+ #-gcl<2.7 :external-format #-gcl<2.7 external-format)
(slurp-input-stream output stream)))
(call-system (system-command command) :interactive interactive)))))
(if (and (not force-shell)
;;; Output to a stream or string, FORMAT-style
-(defgeneric call-with-output (x thunk)
- (:documentation
- ;; code from fare-utils base/streams where it's now named
- ;; call-with-output-stream to avoid the package clash in a lot of my code.
- "Calls FUN with an actual stream argument, behaving like FORMAT with respect to stream'ing:
+(defun* call-with-output (x thunk)
+ "Calls FUN with an actual stream argument, behaving like FORMAT with respect to stream'ing:
If OBJ is a stream, use it as the stream.
If OBJ is NIL, use a STRING-OUTPUT-STREAM as the stream, and return the resulting string.
If OBJ is T, use *STANDARD-OUTPUT* as the stream.
If OBJ is a string with a fill-pointer, use it as a string-output-stream.
-Otherwise, signal an error.")
- (:method ((x null) thunk)
- (declare (ignorable x))
- (with-output-to-string (s) (funcall thunk s)))
- (:method ((x (eql t)) thunk)
- (declare (ignorable x))
- (funcall thunk *standard-output*) nil)
- #-genera
- (:method ((x stream) thunk)
- (funcall thunk x) nil)
- (:method ((x string) thunk)
- (assert (fill-pointer x))
- (with-output-to-string (s x) (funcall thunk s)))
- (:method (x thunk)
- (declare (ignorable thunk))
- (cond
- #+genera
- ((typep x 'stream) (funcall thunk x) nil)
- (t (error "not a valid stream designator ~S" x)))))
+Otherwise, signal an error."
+ (typecase x
+ (null
+ (with-output-to-string (s) (funcall thunk s)))
+ ((eql t)
+ (funcall thunk *standard-output*))
+ (stream
+ (funcall thunk x))
+ (string
+ (assert (fill-pointer x))
+ (with-output-to-string (s x) (funcall thunk s)))
+ (t (error "not a valid stream designator ~S" x))))
(defmacro with-output ((x &optional (value x)) &body body)
"Bind X to an output stream, coercing VALUE (default: previous binding of X)
&key (element-type *default-stream-element-type*)
(external-format :default))
"Open FILE for input with given options, call THUNK with the resulting stream."
+ #+gcl<2.7 (declare (ignore external-format))
(with-open-file (s pathname :direction :input
- :element-type element-type :external-format external-format
+ :element-type element-type
+ #-gcl<2.7 :external-format #-gcl<2.7 external-format
:if-does-not-exist :error)
(funcall thunk s)))
(*print-pretty* nil)
(start-time 0))
- (with-open-file (result-stream (asdf::merge-pathnames* "output.txt" root)
+ (with-open-file (result-stream (asdf::subpathname
+ *build-directory*
+ (format nil "results/~(~A~)-pathnames.txt" *implementation*))
:direction :output
:if-exists :supersede :if-does-not-exist :create)
(flet ((src-dir (&rest path) (append (or (pathname-directory root) (list :relative))
:defaults root)
,(make-pathname :directory (src-dir "system2" "module4") :name "file" :type "lisp"
:defaults root)
- ,(make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4") :name "file" :type "lisp"
+ ,(make-pathname :host "ASDFTEST" :directory '(:absolute "system2" "module4") :name "file" :type "lisp" :version nil
:defaults root)
,(parse-namestring "ASDFTEST:system2;module4;file.lisp")
,@(when support-string-pathnames
((error (lambda (c)
(incf system-failures)
(format *error-output* "~&error! ~a~%sysdef:~% ~S~%" c system-definition)
- #+sbcl (sb-debug:backtrace 69)
- #+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
- #+clisp (system::print-backtrace)
+ (asdf::print-condition-backtrace c :stream *error-output*)
(format result-stream "~&~%***~%error: ~a~%~s"
c system-definition)
(return-from :test-system))))
rm -rf ../build/test-source-registry-conf.d ../build/test-asdf-output-translations-conf.d
}
test_clean_load () {
+ case $lisp in
+ gcl) return 0 ;; # GCL 2.6 is hopeless
+ esac
nop=build/results/${lisp}-nop.text
load=build/results/${lisp}-load.text
${command} ${eval} \
#+(or cmu scl) (c::brevity 2)))
(defvar *trace-symbols*
- '(;; If you want to trace some stuff while debugging ASDF,
+ `(;; If you want to trace some stuff while debugging ASDF,
;; here's a nice place to say what.
;; These string designators will be interned in ASDF after it is loaded.
))
;;; Survival utilities
(defun asym (name)
- (find-symbol (string name) :asdf))
+ (let ((asdf (find-package :asdf)))
+ (unless asdf (error "Can't find package ASDF"))
+ (or (find-symbol (string name) asdf)
+ (error "Can't find symbol ~A in ASDF" name))))
(defun acall (name &rest args)
(apply (asym name) args))
#+cmu :cmucl
#+corman :cormanlisp
#+digitool :mcl
- #+ecl :ecl
+ #+ecl (or #+ecl-bytecmp :ecl_bytecodes :ecl)
#+gcl :gcl
#+lispworks :lispworks
#+mkcl :mkcl
(finish-outputs)
(throw :asdf-test-done return))
-(defmacro with-test (() &body body)
+(defmacro with-test ((&optional) &body body)
`(call-with-test (lambda () ,@body)))
(defun call-with-test (thunk)
+++ /dev/null
-#|
-make sure that serial t and static-files don't cause full rebuilds all
-the time...
-|#
-
-(defsystem static-and-serial
- :version "0.1"
- :serial t
- :components
- ((:static-file "file2.lisp")
- (:static-file "run-tests.sh")
- (:file "file1")))
(defsystem :test-encoding-explicit-u8
:components ((:file "lambda" :encoding :utf-8))))
+ #-asdf-unicode
+ (leave-test "No Unicode support to test on this lisp implementation" 0)
+
;; NB: recent clozure can autodetect without asdf-encodings with :default (!)
#+(and asdf-unicode sbcl)
;;; -*- Lisp -*-
+#|
+make sure that serial t and static-files
+don't cause full rebuilds all the time...
+|#
(load "script-support.lisp")
(load-asdf)
(in-package :asdf-test)
-#+gcl (trace coerce-pathname)
-
(with-test ()
- (format t "dpd: ~S~%f1: ~S~%" *default-pathname-defaults* (asdf::merge-pathnames* "file1"))
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
+ (load-test-system 'static-and-serial)
- (asdf:operate 'asdf:load-op 'static-and-serial)
(let* ((file1 (asdf:compile-file-pathname* "file1.lisp"))
(file1-date (file-write-date file1))
(date1 (- file1-date 600))
(format t "file: ~S~%date: ~S~%" file1 file1-date)
;; date should stay same
- (asdf:clear-system 'static-and-serial)
+ (clear-system 'static-and-serial)
+ (touch-file "static-and-serial.asd" :offset -10000)
(touch-file "file2.lisp" :timestamp date1)
(touch-file "file1.lisp" :timestamp date2)
(touch-file file1 :timestamp date3)
- (asdf:operate 'asdf:load-op 'static-and-serial)
- (assert (equal (file-write-date file1) date3))))
+ (DBG "load again" (oos 'load-op 'static-and-serial))
+ (assert-equal (file-write-date file1) date3)))
(asdf:defsystem :wild-module
:version "0.0"
:components ((:wild-module "systems" :pathname #p"*.asd")))
+ #-gcl<2.7
(load-system :wild-module))
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
- (asdf-version "2.26.83")
+ (asdf-version "2.26.84")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
common-lisp.net / projects/asdf/asdf.git / commitdiff
