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 @@
: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))))
......
;; -*- 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>.
......
......@@ -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
......
......@@ -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))
......
......@@ -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,
......
(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."))
;;; -*- 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 -*-
(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"))))))
;;; -*- 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"))
......@@ -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
......
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