Commit b44a8731 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.132: remove various breakage left while debugging previous issues.

Also, propagate around previous improvements to stream slurping.
Fix some test cases.
parent 79968ea0
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :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 () :depends-on ()
:components ((:module "build" :components ((:file "asdf")))) :components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem)))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- ;; -*- 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: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -244,8 +244,6 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -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))) :original-source-path ,(sb-c::compiler-error-context-original-source-path frob)))
(sb-c::undefined-warning-warnings warning)))) (sb-c::undefined-warning-warnings warning))))
(asdf-debug)
(defun reify-deferred-warnings () (defun reify-deferred-warnings ()
#+clozure #+clozure
(mapcar 'reify-deferred-warning (mapcar 'reify-deferred-warning
......
...@@ -157,17 +157,21 @@ by /bin/sh in POSIX" ...@@ -157,17 +157,21 @@ by /bin/sh in POSIX"
(declare (ignorable x)) (declare (ignorable x))
(slurp-stream-string stream)) (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)) (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)) (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)) (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) (defmethod slurp-input-stream (x stream &key (element-type 'character) &allow-other-keys)
(declare (ignorable stream element-type)) (declare (ignorable stream element-type))
......
...@@ -189,10 +189,34 @@ reading contents line by line." ...@@ -189,10 +189,34 @@ reading contents line by line."
(with-output-to-string (output) (with-output-to-string (output)
(copy-stream-to-stream input output :element-type element-type)))) (copy-stream-to-stream input output :element-type element-type))))
(defun* slurp-stream-lines (input) (defun* slurp-stream-lines (input &key count)
"Read the contents of the INPUT stream as a list of lines" "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) (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) (defun* slurp-stream-forms (input &key count)
"Read the contents of the INPUT stream as a list of forms, "Read the contents of the INPUT stream as a list of forms,
......
(in-package :asdf)
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
;; CLISP 2.48 has a bug that makes this test fail. Work around: ;; CLISP 2.48 has a bug that makes this test fail.
#+(or clisp ecl) (when (and (eq asdf:*compile-file-failure-behaviour* :error) ;; The ECL bytecode compiler also fails.
#+ecl (equal (asdf::fasl-type) "fasc")) ;; Work around:
(error 'asdf:compile-error :operation "op" :component "comp")) #+(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.")) (warn "Warning."))
;;; -*- Lisp -*- ;;; -*- 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))))
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(defparameter *lambda-string* nil) (defparameter *lambda-string* nil)
(defun string-char-codes (s) (defun string-char-codes (s)
...@@ -28,7 +26,8 @@ ...@@ -28,7 +26,8 @@
(setf *lambda-string* nil) (setf *lambda-string* nil)
,def-test-system ,def-test-system
(let ((c (asdf:find-component ',sys ',path))) (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) (loop :for o :in (asdf:output-files (asdf::make-operation 'asdf:compile-op) c)
:do (asdf::delete-file-if-exists o))) :do (asdf::delete-file-if-exists o)))
,@(when op ,@(when op
...@@ -37,89 +36,86 @@ ...@@ -37,89 +36,86 @@
(eval `(assert-equal (string-char-codes ,*lambda-string*) (eval `(assert-equal (string-char-codes ,*lambda-string*)
(expected-char-codes ',',encoding)))))) (expected-char-codes ',',encoding))))))
(progn (with-encoding-test (:utf-8)
(def-test-system :test-encoding-explicit-u8
(with-encoding-test (:utf-8) :components ((:file "lambda" :encoding :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)
#+abcl #-asdf-unicode
(leave-test "abcl is known to fail these tests. Go update asdf-encodings" 0) (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 ;; NB: recent clozure can autodetect without asdf-encodings with :default (!)
(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 #+sbcl
(setf *central-registry* (progn
(list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF #+sbcl (setf sb-impl::*default-external-format* :latin-3)
;; try finding asdf-encodings it right next to asdf. (with-encoding-test (:default)
(subpathname *asdf-directory* "../asdf-encodings/"))) (def-test-system :test-encoding-explicit-default
(unless (find-system :asdf-encodings nil) :components ((:file "lambda" :encoding :default))))
;; try harder by enabling the user's source-registry (with-encoding-test (:default)
(initialize-source-registry "")) (def-test-system :test-encoding-implicit-default
(unless (find-system :asdf-encodings nil) :components ((:file "lambda")))))
(leave-test "Couldn't find ASDF-ENCODINGS. Skipping the rest the test." 0))
;; Disable any user source registry. ;; Try to load asdf-encodings
(initialize-source-registry `(:source-registry :ignore-inherited-configuration)) (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.
(asdf:load-system :asdf-encodings) (subpathname *asdf-directory* "../asdf-encodings/")))
#-lispworks (unless (find-system :asdf-encodings nil)
(with-encoding-test (:latin-2) ;; try harder by enabling the user's source-registry
(def-test-system :test-encoding-implicit-autodetect (initialize-source-registry ""))
:components ((:file "lambda")))) (unless (find-system :asdf-encodings nil)
#+sbcl (leave-test "Couldn't find ASDF-ENCODINGS. Skipping the rest the test." 0))
(with-encoding-test (:koi8-r) ;; Disable any user source registry.
(def-test-system :test-encoding-explicit-koi8-r (initialize-source-registry `(:source-registry :ignore-inherited-configuration))
:components ((:file "lambda" :encoding :koi8-r))))
(with-encoding-test (:utf-8) (asdf:load-system :asdf-encodings)
(def-test-system :test-file-encoding-u8 #-lispworks
:encoding :latin-1 (with-encoding-test (:latin-2)
:components ((:file "lambda" :encoding :utf-8)))) (def-test-system :test-encoding-implicit-autodetect
(with-encoding-test (:latin-1) :components ((:file "lambda"))))
(def-test-system :test-file-encoding-l1 #+sbcl
:encoding :utf-8 (with-encoding-test (:koi8-r)
:components ((:file "lambda" :encoding :latin-1)))) (def-test-system :test-encoding-explicit-koi8-r
(with-encoding-test (:utf-8 :op asdf:load-source-op) :components ((:file "lambda" :encoding :koi8-r))))
(def-test-system :test-system-encoding-u8
:encoding :utf-8 (with-encoding-test (:utf-8)
:components ((:file "lambda")))) (def-test-system :test-file-encoding-u8
(with-encoding-test (:utf-8 :op asdf:load-op) :encoding :latin-1
(def-test-system :test-system-encoding-u8-load-op :components ((:file "lambda" :encoding :utf-8))))
:encoding :utf-8 (with-encoding-test (:latin-1)
:components ((:file "lambda")))) (def-test-system :test-file-encoding-l1
(with-encoding-test (:latin-1) :encoding :utf-8
(def-test-system :test-system-encoding-l1 :components ((:file "lambda" :encoding :latin-1))))
:encoding :latin-1 (with-encoding-test (:utf-8 :op asdf:load-source-op)
:components ((:file "lambda")))) (def-test-system :test-system-encoding-u8
#-ecl-bytecmp :encoding :utf-8
(with-encoding-test (:latin-1 :op asdf:load-op) :components ((:file "lambda"))))
(def-test-system :test-system-encoding-l1-load-op (with-encoding-test (:utf-8 :op asdf:load-op)
:encoding :latin-1 (def-test-system :test-system-encoding-u8-load-op
:components ((:file "lambda")))) :encoding :utf-8
(with-encoding-test (:utf-8 :path ("foo" "lambda")) :components ((:file "lambda"))))
(def-test-system :test-module-encoding-u8 (with-encoding-test (:latin-1)
:encoding :latin-1 (def-test-system :test-system-encoding-l1
:components :encoding :latin-1
((:module "foo" :pathname "" :encoding :utf-8 :components ((:file "lambda"))))
:components ((:file "lambda")))))) #-ecl-bytecmp
(with-encoding-test (:latin-1 :path ("foo" "lambda")) (with-encoding-test (:latin-1 :op asdf:load-op)
(def-test-system :test-module-encoding-l1 (def-test-system :test-system-encoding-l1-load-op
:encoding :utf-8 :encoding :latin-1
:components :components ((:file "lambda"))))
((:module "foo" :pathname "" :encoding :latin-1 (with-encoding-test (:utf-8 :path ("foo" "lambda"))
:components ((:file "lambda")))))) (def-test-system :test-module-encoding-u8
t) :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"))))))
;;; -*- Lisp -*- ;;; -*- Lisp -*-
(DBG :foo (current-lisp-file-pathname))
(progn (defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))
(assert (absolute-pathname-p exe))
(DBG :foo (current-lisp-file-pathname))
(unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil
(let ((exe (output-file (make-operation 'program-op) (find-system :hello-world-example)))) #+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
(assert (absolute-pathname-p exe)) #+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
(unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil "2.48"))
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect (DBG "Creating standalone programs is not supported on your CL implementation")
#+clisp (version-satisfies (leave-test "Skipping test" 0))
(first (split-string (lisp-implementation-version) :separator " "))
"2.48")) ;; Try to load lisp-invocation from xcvb
(DBG "Creating standalone programs is not supported on your CL implementation") (setf *central-registry*
(leave-test "Skipping test" 0)) (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
;; try finding xcvb's lisp-invocation right next to asdf.
;; Try to load lisp-invocation from xcvb (subpathname *asdf-directory* "../xcvb/")))
(setf *central-registry* (unless (find-system :lisp-invocation nil)
(list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF ;; try harder by enabling the user's source-registry
;; try finding xcvb's lisp-invocation right next to asdf. (initialize-source-registry ""))
(subpathname *asdf-directory* "../xcvb/"))) (unless (find-system :lisp-invocation nil)
(unless (find-system :lisp-invocation nil) (leave-test "Couldn't find lisp-invocation. Skipping the rest the test." 0))
;; try harder by enabling the user's source-registry (load-system :lisp-invocation)
(initialize-source-registry "")) ;; Disable any user source registry.
(unless (find-system :lisp-invocation nil) (initialize-source-registry `(:source-registry :ignore-inherited-configuration))
(leave-test "Couldn't find lisp-invocation. Skipping the rest the test." 0))
(load-system :lisp-invocation) (delete-file-if-exists exe)
;; Disable any user source registry. (run-program/
(initialize-source-registry `(:source-registry :ignore-inherited-configuration)) (symbol-call :lisp-invocation :lisp-invocation-arglist
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))))
(delete-file-if-exists exe) (assert (probe-file* exe))
(run-program/
(symbol-call :lisp-invocation :lisp-invocation-arglist (assert-equal (run-program/ (native-namestring exe) :output :lines)
:load (subpathname *test-directory* "make-hello-world.lisp"))) '("hello, world"))
(assert (probe-file* exe))
(assert-equal (run-program/ (unix-namestring exe) :output :lines)
'("hello, world"))
t))
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "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.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 ;; "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-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)) (already-there (equal asdf-version existing-version))
...@@ -46,11 +46,12 @@ ...@@ -46,11 +46,12 @@
#:perform-with-restarts #:component-relative-pathname #:perform-with-restarts #:component-relative-pathname
#:system-source-file #:operate #:find-component #:find-system #:system-source-file #:operate #:find-component #:find-system
#:apply-output-translations #:component-self-dependencies #:apply-output-translations #:component-self-dependencies
#:system-relative-pathname #:resolve-location #:system-relative-pathname
#:inherit-source-registry #:process-source-registry #:inherit-source-registry #:process-source-registry
#:process-source-registry-directive #:source-file-type #:process-source-registry-directive #:source-file-type
#:process-output-translations-directive #:process-output-translations-directive
#:trivial-system-p #:trivial-system-p
;; NB: it's too late to do anything about asdf-driver functions!
)) ))
(uninterned-symbols (uninterned-symbols
'(#:*asdf-revision* #:around #:asdf-method-combination '(#:*asdf-revision* #:around #:asdf-method-combination
......
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