2.26.132: remove various breakage left while debugging previous issues.

Also, propagate around previous improvements to stream slurping.
Fix some test cases.

diff --git a/asdf.asd b/asdf.asd
index caf1912..46194a5 100644 (file)
--- 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 2364de9..e9fb97d 100644 (file)
--- 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 <asdf-devel@common-lisp.net>.

diff --git a/lisp-build.lisp b/lisp-build.lisp
index 96bfca6..3899612 100644 (file)
--- 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 b7b06c6..7fb62f5 100644 (file)
--- 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 73f7721..f8671d8 100644 (file)
--- 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 83be5b7..6154a20 100644 (file)
--- 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 51dfb74..cc741ee 100644 (file)
--- 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 64957e4..25bf4a7 100644 (file)
--- 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 6db1a51..65b47f2 100644 (file)
--- 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 d9ca17f..d9e5918 100644 (file)
--- 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 30f308c..b6155aa 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.131"
+"2.26.132"