[nongnu] elpa/buttercup fce5fa5 313/340: Optionally fail when loading old elc files

[ELPA Syncer]

branch: elpa/buttercup
commit fce5fa53592990f00289044adb037744cc1b8df0
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Optionally fail when loading old elc files
    
    The new --stale-file-error option can be used to activate a hook that
    will signal an error if a stale .elc file is loaded.  Stale means
    older than its originating .el file.
    
    Fixes #142.
---
 bin/buttercup           |  8 +++++++-
 buttercup-compat.el     | 11 +++++++++++
 buttercup.el            | 29 +++++++++++++++++++++++++++++
 tests/test-buttercup.el | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 96 insertions(+), 1 deletion(-)

diff --git a/bin/buttercup b/bin/buttercup
index 92a94fc..8562905 100755
--- a/bin/buttercup
+++ b/bin/buttercup
@@ -56,6 +56,8 @@ Buttercup options:
                           frame with a lambda or M to indicate whether
                           it is a normal function call or a
                           macro/special form.
+
+--stale-file-error      Fail the test run if stale .elc files are loaded.
 EOF
 }
 
@@ -81,7 +83,7 @@ do
             shift
             shift
             ;;
-        "-c"|"--no-color"|"--no-skip"|"--only-error")
+        "-c"|"--no-color"|"--no-skip"|"--only-error"|"--stale-file-error")
             BUTTERCUP_ARGS+=("$1")
             shift
             ;;
@@ -100,3 +102,7 @@ done
 
 # `--' is needed so that Buttercup options don't get parsed by Emacs itself.
 exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f 
buttercup-run-discover -- "${BUTTERCUP_ARGS[@]}"
+
+# Local Variables:
+# indent-tabs-mode: nil
+# End:
diff --git a/buttercup-compat.el b/buttercup-compat.el
index d70bd62..792a8c8 100644
--- a/buttercup-compat.el
+++ b/buttercup-compat.el
@@ -109,6 +109,17 @@ If INCLUDE-DIRECTORIES, also include directories that have 
matching names."
                            (<= (car here) delay)))
                (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr 
here)))))))
 
+;;;;;;;;;;;;;;;;;;;;;
+;; Introduced in 26.1
+
+(unless (fboundp 'file-attribute-modification-time)
+  (defsubst file-attribute-modification-time (attributes)
+       "The modification time in ATTRIBUTES returned by `file-attributes'.
+This is the time of the last change to the file's contents, and
+is a Lisp timestamp in the style of `current-time'."
+       (nth 5 attributes)))
+
+
 
 (provide 'buttercup-compat)
 ;;; buttercup-compat.el ends here
diff --git a/buttercup.el b/buttercup.el
index c10c3b4..cbfa04e 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -1386,6 +1386,9 @@ current directory."
         (push 'pending buttercup-reporter-batch-quiet-statuses)
         (push 'passed buttercup-reporter-batch-quiet-statuses)
         (setq args (cdr args)))
+       ((equal (car args) "--stale-file-error")
+        (buttercup-install-old-elc-error)
+        (setq args (cdr args)))
        (t
         (push (car args) dirs)
         (setq args (cdr args)))))
@@ -2003,6 +2006,32 @@ With buttercup minor mode active the following is 
activated:
       (cl-dolist (form imenu-forms)
         (setq imenu-generic-expression (delete form 
imenu-generic-expression))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Signal errors when files have to be recompiled
+
+(defun buttercup-check-for-stale-elc (elc-file)
+  "Raise an error when ELC-FILE is an elc-file and older than its el-file."
+  (when (string= (file-name-extension elc-file) "elc")
+    (let ((el-file (substring elc-file 0 -1)))
+      (when (and (file-exists-p el-file)
+                 (time-less-p
+                  (file-attribute-modification-time (file-attributes elc-file))
+                  (file-attribute-modification-time (file-attributes 
el-file))))
+        (error "%s is newer than %s" el-file elc-file)))))
+
+(defun buttercup-error-on-stale-elc (&optional arg)
+  "Activate errors when an stale (older than .el) .elc-file is loaded.
+
+Enable the functionality if ARG is omitted or nil, toggle it if
+ARG is ‘toggle’; disable otherwise."
+  (cond ((null arg)
+         (add-hook 'after-load-functions #'buttercup-check-for-stale-elc))
+        ((eq arg 'toggle)
+         (if (memq 'buttercup-check-for-stale-elc after-load-functions)
+             (remove-hook 'after-load-functions 
#'buttercup-check-for-stale-elc)
+           (add-hook 'after-load-functions #'buttercup-check-for-stale-elc)))
+        (t (remove-hook 'after-load-functions 
#'buttercup-check-for-stale-elc))))
+
 ;; Local Variables:
 ;; indent-tabs-mode: nil
 ;; sentence-end-double-space: nil
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index 41236aa..b9fbf54 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -1649,6 +1649,55 @@ text properties using `ansi-color-apply'."
         (expect (length (cdr specs)) :to-equal 1)
         (expect (cl-caadr specs) :to-equal "should fontify special 
keywords")))))
 
+;;;;;;;;;;;;;;;;;;;
+;;; Stale elc files
+
+(describe "For stale `elc' file checks"
+  (describe "`buttercup-check-for-stale-elc'"
+    :var (el-time elc-time)
+    (before-each
+      (spy-on 'file-attributes :and-call-fake
+              (lambda (filename &optional id-format)
+                (make-list
+                 10
+                 (make-list 4
+                            (pcase (file-name-extension filename)
+                              ("elc" elc-time)
+                              ("el" el-time)))))))
+    (it "should do nothing for `el' files"
+      (setq el-time 2  ;; elc is older than el
+            elc-time 1)
+      (expect (buttercup-check-for-stale-elc "buttercup.el") :not :to-throw))
+    (it "should signal error when `elc' is older than `el'"
+      (setq el-time 2  ;; elc is older than el
+            elc-time 1)
+      (expect (buttercup-check-for-stale-elc "buttercup.elc") :to-throw))
+    (it "should not signal error when `elc' is newer than `el'"
+      (setq el-time 2  ;; elc is older than el
+            elc-time 3)
+      (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw))
+    (it "should do nothing if the `el' file does not exist"
+      (setq el-time 3  ;; el is older than elc
+            elc-time 2)
+      (spy-on 'file-exists-p)
+      (expect (buttercup-check-for-stale-elc "buttercup.elc") :not :to-throw)))
+
+  (describe "`buttercup-error-on-stale-elc'"
+    (it "should activate with no argument"
+      (let (after-load-functions)
+        (buttercup-error-on-stale-elc)
+        (expect after-load-functions :to-contain 
'buttercup-check-for-stale-elc)))
+    (it "should deactivate with almost any argument"
+      (let ((after-load-functions '(buttercup-check-for-stale-elc)))
+        (buttercup-error-on-stale-elc 2)
+        (expect after-load-functions :not :to-contain 
'buttercup-check-for-stale-elc)))
+    (it "should toggle when given `toggle' as argument"
+      (let (after-load-functions)
+        (buttercup-error-on-stale-elc 'toggle)
+        (expect after-load-functions :to-contain 
'buttercup-check-for-stale-elc)
+        (buttercup-error-on-stale-elc 'toggle)
+        (expect after-load-functions :not :to-contain 
'buttercup-check-for-stale-elc)))))
+
 ;; Local Variables:
 ;; indent-tabs-mode: nil
 ;; sentence-end-double-space: nil