;;; Code:
(require 'ert)
(setq ert-quiet nil
      ert-batch-print-level 10
      ert-batch-print-length 10
      ert-batch-backtrace-line-length t)

;;; utils/
(eval-and-compile
  (require 'help-fns)
  (defmacro utils/report-compilation-status (fun &optional feature)
    "Report on the compilation status of function FUN.
Optionally load FEATURE before reporting on compilation status."
    `(progn
       (eval-when-compile
         (when ',feature
           (require ',feature)))
       (let ((descstr (substring-no-properties
                       (with-output-to-string
                         (help-fns-function-description-header ',fun)))))
         (cons ',fun
               (cond
                ((string-search " native-compiled" descstr) 'native-compiled)
                ;; ((string-search " autoloaded" descstr) descstr)
                ((string-search " byte-compiled" descstr) 'byte-compiled)
                (t descstr))))))

  (defun utils/report-compilation-status/apply (fun &optional feature)
    "Invoke `utils/report-compilation-status' with FUN and FEATURE."
    (eval `(utils/report-compilation-status ,fun ,feature)))

  (require 'find-func)
  (defun utils/find-library-dir (feature)
    "Output directory where FEATURE resides."
    (directory-file-name
     (file-name-directory
      (find-library-name (symbol-name feature)))))

  (defun utils/report-failing-cases (cases)
    "From CASES, report failing tests.
Test failure are those where `utils/report-compilation-status' doesn't
report natively-compiled.  CASES is a list where each element are
ARGUMENTS for `utils/report-compilation-status'."
    (let ((results (mapcar (lambda (args)
                             (apply #'utils/report-compilation-status/apply args))
                           cases)))
      (seq-filter (lambda (x) (not (eq (cdr x) 'native-compiled)))
                  results))))

;;; hack/
(eval-and-compile
  (defun hack/new-load-path-that-can-make-v10-test-failures-pass ()
    "Return a list that can be used as the `load-path'.

The returned list is assured to have the entry for
share/emacs/<emacs-version>/lisp occur after the entry for
lisp/international (corresponding to the `mule-util' and
`ucs-normalize' failing test cases) and the entry for lisp/term
 (corresponding to the `term/internal' failing test case).

If the `load-path' is set to the returned value, all tests pass
in v10.  Notably, in non-Guix Emacs this isn't needed.  I.e., the
fact that the share/emacs/<emacs-version>/lisp entry precedes the
entries for `mule-util' and `ucs-normalize' is okay as is the
fact that the entry for `term/internal' is missing."
    (eval-when-compile
      (require 'find-func))
    ;; we'll ensure that the entry for share/emacs/<emacs-version>/lisp comes
    ;; after the lisp/international and lisp/term entries
    (let* ((new-load-path load-path)
           ;; add the missing entry for `term/internal'
           (_ (add-to-list 'new-load-path
                           (utils/find-library-dir 'term/internal)
                           ;; NOTE: we don't need to append; doing so simply to confirm that
                           ;; it's only the relative position wrt the
                           ;; share/emacs/<emacs-version>/lisp entry that matters.
                           t))
           (sitelisppath (format "/share/emacs/%s/lisp"
                                 emacs-version))
           (pathsuffix (seq-filter
                        (lambda (x)
                          (string-suffix-p sitelisppath x))
                        new-load-path))
           (pathprefix (seq-filter
                        (lambda (x)
                          (not
                           (string-suffix-p sitelisppath x)))
                        new-load-path)))
      (append pathprefix pathsuffix))))

;;; cases/
;; [[/usr/share/emacs/29.2/lisp]]
(eval-when-compile
  (defvar cases/eln-in-preloaded-dir nil
    "Functions that ought to be natively-compiled.")
  (setq cases/eln-in-preloaded-dir
        '((abbrev-mode)
          (backquote-process)
          (mode-line-widen)
          (buffer-menu)
          ;; burmese
          (button-mode)
          (byte-run-strip-symbol-positions)
          (case-table-get-table)
          (cconv-convert)
          ;; cham
          (use-default-char-width-table)
          ;; chinese
          (cl-generic-p)
          (cl-struct-define)
          (x-setup-function-keys)
          (encode-composition-rule)
          ;; cp51932
          (custom-declare-face)
          (minibuffer-prompt-properties--setter) ;; cus-start.el
          (custom-add-choice)
          ;; cyrillic
          ;; czech
          (debug-early)
          (display-table-slot disp-table) ;; disp-table.eln exists
          (dnd-open-file)
          (dos-mode25 dos-fns)    ;; dos-fns.eln exists
          ;; dos-vars
          (find-file-text dos-w32) ;; dos-w32.eln exists
          (dynamic-setting-handle-config-changed-event)
          (easy-menu-item-present-p)
          ;; ediff-hook
          (eldoc-mode)
          (electric-indent-mode)
          (elisp-mode-syntax-propertize)
          ;; english
          (getenv)
          (epa-file-find-file-hook)
          ;; ethiopic
          ;; eucjp-ms
          ;; european
          (face-list)
          (find-file-noselect)
          (fill-region)
          ;; float-sup
          (font-lock-change-mode)
          (font-lock-add-keywords)
          (fontset-plain-name)
          (format-read)
          (frame-edges)
          (fringe-mode)
          ;; georgian
          ;; greek
          ;; haiku-win
          ;; hebrew
          (help-quick)
          (image-type)
          (indent-region)
          (indian-compose-regexp)
          ;; indonesian
          (msdos-setup-keyboard term/internal) ;; internal.eln exists
          (isearch-abort)
          (iso-transl-set-language)
          ;; japanese
          (jit-lock-mode)
          (jka-compr-build-file-regexp)
          (keymap-global-set)
          ;; khmer
          ;; korean
          ;; lao
          (forward-sexp)
          (lisp-string-in-doc-position-p)
          (ls-lisp-set-options ls-lisp) ;; ls-lisp.eln exists
          (macroexp-compiling-p)
          (map-y-or-n-p)
          (menu-find-file-existing)
          (completion-boundaries)
          (egyptian-shape-grouping)
          (mouse-double-click-time)
          (convert-define-charset-argument)
          (coding-system-change-eol-conversion)
          ;; mule-conf.eln
          (store-substring mule-util) ;; mule-util.eln exists
          (mouse-wheel-change-button)
          (advice-function-mapc)
          (comment-string-strip)
          ;; (ns-handle-nxopen term/ns-win)
          (obarray-make)
          (oclosure-type)
          (forward-page)
          (sentence-end)
          (show-paren-function)
          ;; (msdos-face-setup term/pc-win)
          (pgtk-dnd-init-frame pgtk-dnd) ;; pgtk-dnd.eln exists
          ;; (pgtk-drag-n-drop term/pgtk-win)
          ;; philippine
          (prog-context-menu)
          (regexp-opt)
          (get-register)
          (query-replace-descr)
          (rfn-eshadow-setup-minibuffer)
          (read-multiple-choice)
          ;; romanian
          (scroll-bar-scale)
          (gui-select-text)
          (seq-first)
          (hack-read-symbol-shorthands)
          (next-error-find-buffer)
          ;; sinhala
          ;; slovak
          (exit-splash-screen)
          (buffer-local-boundp)
          (syntax-propertize-multiline)
          (tab-bar-mode)
          (tabulated-list-put-tag)
          ;; tai-viet
          (text-mode)
          ;; thai
          ;; tibetan
          (timer-activate)
          (tool-bar-mode)
          (tooltip-mode)
          (tty-color-desc)
          (ucs-normalize-hfs-nfd-comp-p ucs-normalize) ;; ucs-normalize.eln exists
          (uniquify-item-p)
          ;; utf-8-lang.eln
          (vc-mode)
          (emacs-version)
          ;; vietnamese
          ;; (w32-shell-name)
          ;; w32-vars.eln
          ;; (w32-handle-dropped-file 'term/w32-win)
          (define-widget)
          (window-right)
          (x-dnd-init-frame)
          (x-handle-no-bitmap-icon))))

;;; ERT tests
(ert-deftest 01-natively-compiled-features-passing-as-of-v10 ()
  "The 94 cases which pass for v10 patch series.
These cases are taken from .eln files that are located in the preloaded
directory for non-Guix Emacs."
  (eval-when-compile
    (let ((cases (seq-filter (lambda (x)
                               (not (memq (cadr x) '(mule-util term/internal ucs-normalize))))
                             cases/eln-in-preloaded-dir)))
      (should-not (utils/report-failing-cases cases)))))

(ert-deftest 02-natively-compiled-features-failing-as-of-v10 ()
  "The 3 cases which fail for v10 patch series on Guix Emacs.
These cases are taken from .eln files that are located in the preloaded
directory for non-Guix Emacs."
  :expected-result (if (getenv "GUIX_ENVIRONMENT")
                       :failed
                     :passed)
  (should-not
   (eval-when-compile
     (let ((cases (seq-filter (lambda (x)
                                (memq (cadr x) '(mule-util term/internal ucs-normalize)))
                              cases/eln-in-preloaded-dir)))
       (utils/report-failing-cases cases)))))

(ert-deftest 03-some-features-in-later-load-path-entries-are-still-natively-compiled ()
  "These cases pass as of v10 of the patch.
These cases share the fact that their directory entries occur in
the `load-path' after the $prefix/share/emacs/$emacs_version/lisp
entry.  This is something these cases have in common with the
three cases that are known to fail, however, unlike them these
succeed (i.e., natively-compiled variants are loaded)."
  (eval-when-compile
    (let* ((cases '((cl-position cl-seq)
                    (find-library-name find-func)
                    (log-edit log-edit)))
           (failing (utils/report-failing-cases cases))
           (features-loadpath-entries (mapcar #'utils/find-library-dir
                                              (mapcar #'cadr cases)))
           (features-entry-pos (mapcar (lambda (x)
                                         (cl-position
                                          (utils/find-library-dir (cadr x))
                                          load-path :test #'equal))
                                       cases))
           (share-emacs-lisp-entry-pos (cl-position "/share/emacs/29.2/lisp"
                                                    load-path
                                                    :test #'string-suffix-p)))
      (should-not failing)
      (should-not (seq-filter (lambda (x) (< x share-emacs-lisp-entry-pos))
                              features-entry-pos)))))

(ert-deftest 04-load-path-order-should-not-determine-natively-compiled-status ()
  "This seems like an invariant that would be useful to have.
It is unclear if this is guaranteed by upstream Emacs, but
observations seem consistent with it."
  :expected-result (if (getenv "GUIX_ENVIRONMENT")
                       :failed
                     :passed)
  (eval-when-compile
    (defvar original-load-path load-path))
  (let ((failures-prior-to-load-path-shuffle
         (eval-when-compile
           (utils/report-failing-cases cases/eln-in-preloaded-dir)))
        (failures-post-load-path-shuffle
         (eval-when-compile
           (progn
             (setq load-path
                   (hack/new-load-path-that-can-make-v10-test-failures-pass))
             (dolist (item cases/eln-in-preloaded-dir)
               (when (cadr item)
                 (unload-feature (cadr item))))
             (utils/report-failing-cases cases/eln-in-preloaded-dir)))))
    (should (equal failures-prior-to-load-path-shuffle
                   failures-post-load-path-shuffle))))

(ert-deftest 05-there-exists-load-path-order-where-all-tests-pass ()
  "Proof witness that the v10 failing cases relate to load-path ordering."
  (should-not (eval-when-compile
                (when (and (boundp 'original-load-path) original-load-path)
                  (setq load-path original-load-path)
                  (dolist (item cases/eln-in-preloaded-dir)
                    (when (cadr item)
                      (unload-feature (cadr item)))))
                (defvar original-load-path load-path)
                (setq load-path
                      (hack/new-load-path-that-can-make-v10-test-failures-pass))
                (utils/report-failing-cases cases/eln-in-preloaded-dir))))

;;; test-native-comp-p.el ends here