From 132a32f5de08a8ce63cfe0b55d852b9edca73a89 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 7 Jan 2013 12:23:21 -0500
Subject: [PATCH] 2.26.60: fix encodings, broken by component refactoring. Add
 test.

Bug identified by avodonosov.
---
 asdf.asd                   |   2 +-
 asdf.lisp                  |  14 +++--
 test/script-support.lisp   |   7 +--
 test/test-encodings.script | 106 +++++++++++++++++++++++++++++++++++++
 4 files changed, 117 insertions(+), 12 deletions(-)
 create mode 100644 test/test-encodings.script

diff --git a/asdf.asd b/asdf.asd
index 7793db12..56452d1a 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -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")))
diff --git a/asdf.lisp b/asdf.lisp
index 1d556d79..72d3260b 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;; -*- 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
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 8ebeab53..419a2e32 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -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)))
diff --git a/test/test-encodings.script b/test/test-encodings.script
new file mode 100644
index 00000000..02e6939b
--- /dev/null
+++ b/test/test-encodings.script
@@ -0,0 +1,106 @@
+;;; -*- 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)
-- 
GitLab