;;; -*- 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")))))

(defmacro with-encoding-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)

       (setf *lambda-string* nil)

       ,defsystem

       (let ((c (asdf:find-component ',sys ',path)))
         (assert-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
           `((asdf:operate ',op ',(second defsystem))))

       ,@body

       (eval `(assert-equal (string-char-codes ,*lambda-string*)
                            (expected-char-codes ',',encoding))))))

(with-test ()

  (with-encoding-test (:utf-8)

    (defsystem :test-encoding-explicit-u8
      :components ((:file "lambda" :encoding :utf-8))))

  ;; NB: recent clozure can autodetect without asdf-encodings with :default (!)

  #+(and asdf-unicode sbcl)

  (progn
    #+clozure (setf ccl:*default-external-format* :latin3)
    #+sbcl (setf sb-impl::*default-external-format* :latin-3)

    (with-encoding-test (:default)

      (defsystem :test-encoding-explicit-default
        :components ((:file "lambda" :encoding :default))))

    (with-encoding-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-encoding-test (:latin-2)

      (defsystem :test-encoding-implicit-autodetect
        :components ((:file "lambda"))))
    #+sbcl

    (with-encoding-test (:koi8-r)

      (defsystem :test-encoding-explicit-koi8-r
        :components ((:file "lambda" :encoding :koi8-r)))))

  (with-encoding-test (:utf-8)

    (defsystem :test-file-encoding-u8
      :encoding :latin-1
      :components ((:file "lambda" :encoding :utf-8))))

  (with-encoding-test (:latin-1)

    (defsystem :test-file-encoding-l1
      :encoding :utf-8
      :components ((:file "lambda" :encoding :latin-1))))

  (with-encoding-test (:utf-8 :op asdf:load-source-op)

    (defsystem :test-system-encoding-u8
      :encoding :utf-8
      :components ((:file "lambda"))))

  (with-encoding-test (:utf-8 :op asdf:load-op)

    (defsystem :test-system-encoding-u8-load-op
      :encoding :utf-8
      :components ((:file "lambda"))))

  (with-encoding-test (:latin-1)

    (defsystem :test-system-encoding-l1
      :encoding :latin-1
      :components ((:file "lambda"))))

  #-ecl-bytecmp

  (with-encoding-test (:latin-1 :op asdf:load-op)

    (defsystem :test-system-encoding-l1-load-op
      :encoding :latin-1
      :components ((:file "lambda"))))

  (with-encoding-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-encoding-test (:latin-1 :path ("foo" "lambda"))