diff --git a/asdf.asd b/asdf.asd index caf19124e905087bd434c827b1db168094cd3b3e..46194a5540fc22cb7fb9744dc3c7d97ec76a305a 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.131" ;; to be automatically updated by make bump-version + :version "2.26.132" ;; to be automatically updated by make bump-version :depends-on () :components ((:module "build" :components ((:file "asdf")))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem)))) diff --git a/header.lisp b/header.lisp index 2364de9e24e720acba6eb2ccee5953bdd156f573..e9fb97d474311e7cdc5a89e3a123dde61f715d08 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.131: Another System Definition Facility. +;;; This is ASDF 2.26.132: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . diff --git a/lisp-build.lisp b/lisp-build.lisp index 96bfca673f30d47ad2158a07f54e6ecd9ad6e93f..3899612d066d1ee0c9348f6ea9059374b76bf499 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -244,8 +244,6 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when :original-source-path ,(sb-c::compiler-error-context-original-source-path frob))) (sb-c::undefined-warning-warnings warning)))) -(asdf-debug) - (defun reify-deferred-warnings () #+clozure (mapcar 'reify-deferred-warning diff --git a/run-program.lisp b/run-program.lisp index b7b06c6e9dc62aace7461f26844b418516938ffe..7fb62f5c7f3609b483f56477662d998037a173b4 100644 --- a/run-program.lisp +++ b/run-program.lisp @@ -157,17 +157,21 @@ by /bin/sh in POSIX" (declare (ignorable x)) (slurp-stream-string stream)) -(defmethod slurp-input-stream ((x (eql :lines)) stream &key &allow-other-keys) +(defmethod slurp-input-stream ((x (eql :lines)) stream &rest keys &key &allow-other-keys) (declare (ignorable x)) - (slurp-stream-lines stream)) + (apply 'slurp-stream-lines stream keys)) -(defmethod slurp-input-stream ((x (eql :form)) stream &key &allow-other-keys) +(defmethod slurp-input-stream ((x (eql :line)) stream &rest keys &key &allow-other-keys) (declare (ignorable x)) - (read stream)) + (apply 'slurp-stream-line stream keys)) -(defmethod slurp-input-stream ((x (eql :forms)) stream &key &allow-other-keys) +(defmethod slurp-input-stream ((x (eql :forms)) stream &rest keys &key &allow-other-keys) (declare (ignorable x)) - (slurp-stream-form stream :path nil)) + (apply 'slurp-stream-forms stream keys)) + +(defmethod slurp-input-stream ((x (eql :form)) stream &rest keys &key &allow-other-keys) + (declare (ignorable x)) + (apply 'slurp-stream-form stream keys)) (defmethod slurp-input-stream (x stream &key (element-type 'character) &allow-other-keys) (declare (ignorable stream element-type)) diff --git a/stream.lisp b/stream.lisp index 73f77217e8ee2aece51e195a267107fcca19035c..f8671d853fb3a560ee6b66e41991e600d96af6a7 100644 --- a/stream.lisp +++ b/stream.lisp @@ -189,10 +189,34 @@ reading contents line by line." (with-output-to-string (output) (copy-stream-to-stream input output :element-type element-type)))) -(defun* slurp-stream-lines (input) - "Read the contents of the INPUT stream as a list of lines" +(defun* slurp-stream-lines (input &key count) + "Read the contents of the INPUT stream as a list of lines, return those lines. + +Read no more than COUNT lines." + (check-type count (or null integer)) (with-open-stream (input input) - (loop :for l = (read-line input nil nil) :while l :collect l))) + (loop :for n :from 0 + :for l = (and (or (not count) (< n count)) + (read-line input nil nil)) + :while l :collect l))) + +(defun* slurp-stream-line (input &key (path 0)) + "Read the contents of the INPUT stream as a list of lines, +then return the SUB-OBJECT of that list of lines following the PATH. +PATH defaults to 0, i.e. return the first line. +PATH is typically an integer, or a list of an integer and a function. +If PATH is NIL, it will return all the lines in the file. + +The stream will not be read beyond the Nth lines, +where N is the index specified by path +if path is either an integer or a list that starts with an integer." + (let* ((count (cond + ((integerp path) + (1+ path)) + ((and (consp path) (integerp (first path))) + (1+ (first path))))) + (forms (slurp-stream-lines input :count count))) + (sub-object forms path))) (defun* slurp-stream-forms (input &key count) "Read the contents of the INPUT stream as a list of forms, diff --git a/test/test-compile-file-failure.lisp b/test/test-compile-file-failure.lisp index 83be5b7d9110d62b3fda7395a735272f85b11af6..6154a20b2680a1ee6faabc942361c9599660d9e7 100644 --- a/test/test-compile-file-failure.lisp +++ b/test/test-compile-file-failure.lisp @@ -1,6 +1,11 @@ +(in-package :asdf) + (eval-when (:compile-toplevel :load-toplevel :execute) - ;; CLISP 2.48 has a bug that makes this test fail. Work around: - #+(or clisp ecl) (when (and (eq asdf:*compile-file-failure-behaviour* :error) - #+ecl (equal (asdf::fasl-type) "fasc")) - (error 'asdf:compile-error :operation "op" :component "comp")) + ;; CLISP 2.48 has a bug that makes this test fail. + ;; The ECL bytecode compiler also fails. + ;; Work around: + #+(or clisp ecl) + (when (and (eq asdf:*compile-file-failure-behaviour* :error) + #+ecl (equal (compile-file-type) "fasc")) + (error 'compile-file-error :description "faking it")) (warn "Warning.")) diff --git a/test/test-compile-file-failure.script b/test/test-compile-file-failure.script index 51dfb748c03e6c758a38adcf0fae8fc6e0b54984..cc741ee0f1e0f654b3cefd16479abc13a2f37dc0 100644 --- a/test/test-compile-file-failure.script +++ b/test/test-compile-file-failure.script @@ -1,17 +1,17 @@ ;;; -*- Lisp -*- +(in-package :asdf) +#-gcl<2.7 +(assert (handler-case + (let ((*compile-file-failure-behaviour* :warn)) + (load-system 'test-compile-file-failure :force t) + t) + (compile-file-error () nil))) +#-gcl<2.7 +(assert (handler-case + (let ((*compile-file-failure-behaviour* :error)) + (load-system 'test-compile-file-failure :force t) + nil) + (compile-file-error () t))) -(progn - #-gcl<2.7 - (assert (handler-case - (let ((asdf:*compile-file-failure-behaviour* :warn)) - (asdf:load-system 'test-compile-file-failure :force t) - t) - (asdf/lisp-build:compile-file-error () nil))) - #-gcl<2.7 - (assert (handler-case - (let ((asdf:*compile-file-failure-behaviour* :error)) - (asdf:load-system 'test-compile-file-failure :force t) - nil) - (asdf/lisp-build:compile-file-error () t)))) diff --git a/test/test-encodings.script b/test/test-encodings.script index 64957e487256f2f560b7b5369b6071aefb266a6e..25bf4a7249be0ba7ee11b1d950c2739008f5ce01 100644 --- a/test/test-encodings.script +++ b/test/test-encodings.script @@ -1,7 +1,5 @@ ;;; -*- Lisp -*- - - (defparameter *lambda-string* nil) (defun string-char-codes (s) @@ -28,7 +26,8 @@ (setf *lambda-string* nil) ,def-test-system (let ((c (asdf:find-component ',sys ',path))) - (assert-equal (asdf:component-encoding c) ',encoding) + ;; mlisp has an issue of :LATIN-2 vs :latin-2. Smooth things with string-equal. + (assert-compare (string-equal (asdf:component-encoding c) ',encoding)) (loop :for o :in (asdf:output-files (asdf::make-operation 'asdf:compile-op) c) :do (asdf::delete-file-if-exists o))) ,@(when op @@ -37,89 +36,86 @@ (eval `(assert-equal (string-char-codes ,*lambda-string*) (expected-char-codes ',',encoding)))))) -(progn - - (with-encoding-test (:utf-8) - (def-test-system :test-encoding-explicit-u8 - :components ((:file "lambda" :encoding :utf-8)))) - - #-asdf-unicode - (leave-test "No Unicode support to test on this lisp implementation" 0) +(with-encoding-test (:utf-8) + (def-test-system :test-encoding-explicit-u8 + :components ((:file "lambda" :encoding :utf-8)))) - #+abcl - (leave-test "abcl is known to fail these tests. Go update asdf-encodings" 0) +#-asdf-unicode +(leave-test "No Unicode support to test on this lisp implementation" 0) - ;; NB: recent clozure can autodetect without asdf-encodings with :default (!) +#+abcl +(leave-test "abcl is known to fail these tests. Go update asdf-encodings" 0) - #+sbcl - (progn - #+sbcl (setf sb-impl::*default-external-format* :latin-3) - (with-encoding-test (:default) - (def-test-system :test-encoding-explicit-default - :components ((:file "lambda" :encoding :default)))) - (with-encoding-test (:default) - (def-test-system :test-encoding-implicit-default - :components ((:file "lambda"))))) +;; NB: recent clozure can autodetect without asdf-encodings with :default (!) - ;; Try to load asdf-encodings - (setf *central-registry* - (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF - ;; try finding asdf-encodings it right next to asdf. - (subpathname *asdf-directory* "../asdf-encodings/"))) - (unless (find-system :asdf-encodings nil) - ;; try harder by enabling the user's source-registry - (initialize-source-registry "")) - (unless (find-system :asdf-encodings nil) - (leave-test "Couldn't find ASDF-ENCODINGS. Skipping the rest the test." 0)) - ;; Disable any user source registry. - (initialize-source-registry `(:source-registry :ignore-inherited-configuration)) - - - (asdf:load-system :asdf-encodings) - #-lispworks - (with-encoding-test (:latin-2) - (def-test-system :test-encoding-implicit-autodetect - :components ((:file "lambda")))) - #+sbcl - (with-encoding-test (:koi8-r) - (def-test-system :test-encoding-explicit-koi8-r - :components ((:file "lambda" :encoding :koi8-r)))) - - (with-encoding-test (:utf-8) - (def-test-system :test-file-encoding-u8 - :encoding :latin-1 - :components ((:file "lambda" :encoding :utf-8)))) - (with-encoding-test (:latin-1) - (def-test-system :test-file-encoding-l1 - :encoding :utf-8 - :components ((:file "lambda" :encoding :latin-1)))) - (with-encoding-test (:utf-8 :op asdf:load-source-op) - (def-test-system :test-system-encoding-u8 - :encoding :utf-8 - :components ((:file "lambda")))) - (with-encoding-test (:utf-8 :op asdf:load-op) - (def-test-system :test-system-encoding-u8-load-op - :encoding :utf-8 - :components ((:file "lambda")))) - (with-encoding-test (:latin-1) - (def-test-system :test-system-encoding-l1 - :encoding :latin-1 - :components ((:file "lambda")))) - #-ecl-bytecmp - (with-encoding-test (:latin-1 :op asdf:load-op) - (def-test-system :test-system-encoding-l1-load-op - :encoding :latin-1 - :components ((:file "lambda")))) - (with-encoding-test (:utf-8 :path ("foo" "lambda")) - (def-test-system :test-module-encoding-u8 - :encoding :latin-1 - :components - ((:module "foo" :pathname "" :encoding :utf-8 - :components ((:file "lambda")))))) - (with-encoding-test (:latin-1 :path ("foo" "lambda")) - (def-test-system :test-module-encoding-l1 - :encoding :utf-8 - :components - ((:module "foo" :pathname "" :encoding :latin-1 - :components ((:file "lambda")))))) - t) +#+sbcl +(progn + #+sbcl (setf sb-impl::*default-external-format* :latin-3) + (with-encoding-test (:default) + (def-test-system :test-encoding-explicit-default + :components ((:file "lambda" :encoding :default)))) + (with-encoding-test (:default) + (def-test-system :test-encoding-implicit-default + :components ((:file "lambda"))))) + +;; Try to load asdf-encodings +(setf *central-registry* + (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF + ;; try finding asdf-encodings it right next to asdf. + (subpathname *asdf-directory* "../asdf-encodings/"))) +(unless (find-system :asdf-encodings nil) + ;; try harder by enabling the user's source-registry + (initialize-source-registry "")) +(unless (find-system :asdf-encodings nil) + (leave-test "Couldn't find ASDF-ENCODINGS. Skipping the rest the test." 0)) +;; Disable any user source registry. +(initialize-source-registry `(:source-registry :ignore-inherited-configuration)) + + +(asdf:load-system :asdf-encodings) +#-lispworks +(with-encoding-test (:latin-2) + (def-test-system :test-encoding-implicit-autodetect + :components ((:file "lambda")))) +#+sbcl +(with-encoding-test (:koi8-r) + (def-test-system :test-encoding-explicit-koi8-r + :components ((:file "lambda" :encoding :koi8-r)))) + +(with-encoding-test (:utf-8) + (def-test-system :test-file-encoding-u8 + :encoding :latin-1 + :components ((:file "lambda" :encoding :utf-8)))) +(with-encoding-test (:latin-1) + (def-test-system :test-file-encoding-l1 + :encoding :utf-8 + :components ((:file "lambda" :encoding :latin-1)))) +(with-encoding-test (:utf-8 :op asdf:load-source-op) + (def-test-system :test-system-encoding-u8 + :encoding :utf-8 + :components ((:file "lambda")))) +(with-encoding-test (:utf-8 :op asdf:load-op) + (def-test-system :test-system-encoding-u8-load-op + :encoding :utf-8 + :components ((:file "lambda")))) +(with-encoding-test (:latin-1) + (def-test-system :test-system-encoding-l1 + :encoding :latin-1 + :components ((:file "lambda")))) +#-ecl-bytecmp +(with-encoding-test (:latin-1 :op asdf:load-op) + (def-test-system :test-system-encoding-l1-load-op + :encoding :latin-1 + :components ((:file "lambda")))) +(with-encoding-test (:utf-8 :path ("foo" "lambda")) + (def-test-system :test-module-encoding-u8 + :encoding :latin-1 + :components + ((:module "foo" :pathname "" :encoding :utf-8 + :components ((:file "lambda")))))) +(with-encoding-test (:latin-1 :path ("foo" "lambda")) + (def-test-system :test-module-encoding-l1 + :encoding :utf-8 + :components + ((:module "foo" :pathname "" :encoding :latin-1 + :components ((:file "lambda")))))) diff --git a/test/test-program.script b/test/test-program.script index 6db1a515af031a21f7771f337553155d76638476..65b47f20da697f1b70cb3077710252f4983a4a47 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -1,43 +1,37 @@ ;;; -*- Lisp -*- - - -(progn - - (DBG :foo (current-lisp-file-pathname)) - - (let ((exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))) - (assert (absolute-pathname-p exe)) - - (unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil - #+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect - #+clisp (version-satisfies - (first (split-string (lisp-implementation-version) :separator " ")) - "2.48")) - (DBG "Creating standalone programs is not supported on your CL implementation") - (leave-test "Skipping test" 0)) - - ;; Try to load lisp-invocation from xcvb - (setf *central-registry* - (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF - ;; try finding xcvb's lisp-invocation right next to asdf. - (subpathname *asdf-directory* "../xcvb/"))) - (unless (find-system :lisp-invocation nil) - ;; try harder by enabling the user's source-registry - (initialize-source-registry "")) - (unless (find-system :lisp-invocation nil) - (leave-test "Couldn't find lisp-invocation. Skipping the rest the test." 0)) - (load-system :lisp-invocation) - ;; Disable any user source registry. - (initialize-source-registry `(:source-registry :ignore-inherited-configuration)) - - (delete-file-if-exists exe) - (run-program/ - (symbol-call :lisp-invocation :lisp-invocation-arglist - :load (subpathname *test-directory* "make-hello-world.lisp"))) - (assert (probe-file* exe)) - - (assert-equal (run-program/ (unix-namestring exe) :output :lines) - '("hello, world")) - - t)) +(DBG :foo (current-lisp-file-pathname)) + +(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example))) +(assert (absolute-pathname-p exe)) + +(unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil + #+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect + #+clisp (version-satisfies + (first (split-string (lisp-implementation-version) :separator " ")) + "2.48")) + (DBG "Creating standalone programs is not supported on your CL implementation") + (leave-test "Skipping test" 0)) + +;; Try to load lisp-invocation from xcvb +(setf *central-registry* + (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF + ;; try finding xcvb's lisp-invocation right next to asdf. + (subpathname *asdf-directory* "../xcvb/"))) +(unless (find-system :lisp-invocation nil) + ;; try harder by enabling the user's source-registry + (initialize-source-registry "")) +(unless (find-system :lisp-invocation nil) + (leave-test "Couldn't find lisp-invocation. Skipping the rest the test." 0)) +(load-system :lisp-invocation) +;; Disable any user source registry. +(initialize-source-registry `(:source-registry :ignore-inherited-configuration)) + +(delete-file-if-exists exe) +(run-program/ + (symbol-call :lisp-invocation :lisp-invocation-arglist + :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")))) +(assert (probe-file* exe)) + +(assert-equal (run-program/ (native-namestring exe) :output :lines) + '("hello, world")) diff --git a/upgrade.lisp b/upgrade.lisp index d9ca17fa0fe715b4bf011e1166f7a773311364bb..d9e59188c12c16c6f2ac11addb7d8250e36fdde4 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -35,7 +35,7 @@ ;; "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.131") + (asdf-version "2.26.132") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version)) @@ -46,11 +46,12 @@ #:perform-with-restarts #:component-relative-pathname #:system-source-file #:operate #:find-component #:find-system #:apply-output-translations #:component-self-dependencies - #:system-relative-pathname #:resolve-location + #:system-relative-pathname #:inherit-source-registry #:process-source-registry #:process-source-registry-directive #:source-file-type #:process-output-translations-directive #:trivial-system-p + ;; NB: it's too late to do anything about asdf-driver functions! )) (uninterned-symbols '(#:*asdf-revision* #:around #:asdf-method-combination diff --git a/version.lisp-expr b/version.lisp-expr index 30f308cce8c17895898f80f05278257bde4f622e..b6155aa61d817ef391cabd0eb92067cd0eb02118 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.131" +"2.26.132"