Commit 132a32f5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.60: fix encodings, broken by component refactoring. Add test.

Bug identified by avodonosov.
parent c664fbc5
......@@ -14,7 +14,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.59" ;; to be automatically updated by bin/bump-revision
:version "2.26.60" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components
((:file "asdf")))
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.59: Another System Definition Facility.
;;; This is ASDF 2.26.60: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......@@ -126,7 +126,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.59")
(asdf-version "2.26.60")
(existing-asdf (find-class 'component nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......@@ -1597,16 +1597,14 @@ hopefully, if done consistently, that won't affect program behavior too much.")
"Hook for an extension to define a function to automatically detect a file's encoding")
(defun* detect-encoding (pathname)
(funcall *encoding-detection-hook* pathname))
(if (and pathname (probe-file pathname))
(funcall *encoding-detection-hook* pathname)
*default-encoding*))
(defmethod component-encoding ((c component))
(or (loop :for x = c :then (component-parent x)
:while x :thereis (%component-encoding x))
(call-next-method)))
(defmethod component-encoding ((c file-component))
(detect-encoding (component-pathname c)))
(defmethod component-encoding ((c parent-component))
*default-encoding*)
(detect-encoding (component-pathname c))))
(defun* default-encoding-external-format (encoding)
(case encoding
......
......@@ -66,10 +66,11 @@
(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
(load old-asdf))))
(defvar *debug-symbols*
'( #|:COMPILE-FILE* :perform-lisp-compilation|# ))
(defun configure-asdf ()
#+ecl (eval `(trace ,@(loop :for s :in '(:COMPILE-FILE* :perform-lisp-compilation)
:collect (find-symbol (string s) :asdf))
c::builder))
(eval `(trace ,@(loop :for s :in *debug-symbols* :collect (find-symbol (string s) :asdf))))
(funcall (find-symbol (string :initialize-source-registry) :asdf)
`(:source-registry :ignore-inherited-configuration))
(let ((registry (find-symbol (string :*central-registry*) :asdf)))
......
;;; -*- Lisp -*-
(load "script-support.lisp")
(load-asdf)
(defparameter *lambda-string* nil)
(defun string-char-codes (s)
(loop :for c :across s :collect (char-code c)))
(defun expected-char-codes (x)
#-asdf-unicode '(#xCE #xBB)
#+asdf-unicode
(ecase x
(:utf-8 '(955))
((:latin1 :latin-1) '(206 187))
((:latin2 :latin-2) '(206 357))
((:latin3 :latin-3) '(206 287))
(:koi8-r '(1085 9577))
(:default (expected-char-codes
#+clozure ccl:*default-external-format*
#+sbcl sb-impl::*default-external-format*
#-(or clozure sbcl) (error "can't determine default external-format")))))
(defun reset-lambda ()
(setf *lambda-string* nil)
(asdf::delete-file-if-exists (asdf::compile-file-pathname* "lambda.lisp")))
(defmacro with-test ((encoding &key (op 'asdf:load-source-op) (path "lambda")) defsystem &body body)
(let ((sys (second defsystem)))
`(progn
(format t "~&Test ~A: should be ~A~%" ',sys ',encoding)
(reset-lambda)
,defsystem
(assert-equal (asdf:component-encoding (asdf:find-component ',sys ',path)) ',encoding)
,@(when op `((asdf:operate ',op ',(second defsystem))))
,@body
(eval `(assert-equal (string-char-codes ,*lambda-string*) (expected-char-codes ',',encoding))))))
(quit-on-error
(with-test (:utf-8)
(defsystem :test-encoding-explicit-u8
:components ((:file "lambda" :encoding :utf-8))))
#+(and asdf-unicode (or clozure sbcl))
(progn
#+clozure (setf ccl:*default-external-format* :latin3)
#+sbcl (setf sb-impl::*default-external-format* :latin-3)
(with-test (:default)
(defsystem :test-encoding-explicit-default
:components ((:file "lambda" :encoding :default))))
(with-test (:default)
(defsystem :test-encoding-implicit-default
:components ((:file "lambda")))))
#+asdf-unicode
(progn
;; BEWARE: For testing purposes, we assume ASDF-ENCODINGS is under the same root as ASDF.
(pushnew (asdf::subpathname *asdf-directory* "../asdf-encodings/") asdf:*central-registry*)
(asdf:load-system :asdf-encodings)
#-lispworks
(with-test (:latin-2)
(defsystem :test-encoding-implicit-autodetect
:components ((:file "lambda"))))
#+sbcl
(with-test (:koi8-r)
(defsystem :test-encoding-explicit-koi8-r
:components ((:file "lambda" :encoding :koi8-r)))))
(with-test (:utf-8)
(defsystem :test-file-encoding-u8
:encoding :latin-1
:components ((:file "lambda" :encoding :utf-8))))
(with-test (:latin-1)
(defsystem :test-file-encoding-l1
:encoding :utf-8
:components ((:file "lambda" :encoding :latin-1))))
(with-test (:utf-8 :op asdf:load-source-op)
(defsystem :test-system-encoding-u8
:encoding :utf-8
:components ((:file "lambda"))))
(with-test (:utf-8 :op asdf:load-op)
(defsystem :test-system-encoding-u8-load-op
:encoding :utf-8
:components ((:file "lambda"))))
(with-test (:latin-1)
(defsystem :test-system-encoding-l1
:encoding :latin-1
:components ((:file "lambda"))))
(with-test (:latin-1 :op asdf:load-op)
(defsystem :test-system-encoding-l1-load-op
:encoding :latin-1
:components ((:file "lambda"))))
(with-test (:utf-8 :path ("foo" "lambda"))
(defsystem :test-module-encoding-u8
:encoding :latin-1
:components
((:module "foo" :pathname "" :encoding :utf-8
:components ((:file "lambda"))))))
(with-test (:latin-1 :path ("foo" "lambda"))
(defsystem :test-module-encoding-l1
:encoding :utf-8
:components
((:module "foo" :pathname "" :encoding :latin-1
:components ((:file "lambda"))))))
t)
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