[elpa] externals/compat 5e7698c 45/99: Avoid testing advice compatibility in version to old to compare

[ELPA Syncer]

branch: externals/compat
commit 5e7698cd1035fce166bdea2a8f181e1c569254df
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Avoid testing advice compatibility in version to old to compare
    
    A function may be bound but that doesn't mean it implements the
    behaviour we are testing. These modifications ensure that the tests
    only run when the version guarantees the expected behaviour.
---
 compat-macs.el  | 12 ++++++++----
 compat-tests.el | 12 +++++++++---
 2 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/compat-macs.el b/compat-macs.el
index 2c00f68..63604e8 100644
--- a/compat-macs.el
+++ b/compat-macs.el
@@ -29,7 +29,7 @@
   "Ignore all arguments."
   nil)
 
-(defun compat-generate-common (name def-fn install-fn check-fn attr)
+(defun compat-generate-common (name def-fn install-fn check-fn attr type)
   "Common code for generating compatibility definitions for NAME.
 The resulting body is constructed by invoking the functions
 DEF-FN (passed the \"realname\" and the version number, returning
@@ -59,7 +59,9 @@ attributes are handled, all others are ignored:
   code was defined in (string).
 
 - :realname :: Manual specification of a \"realname\" to use for
-  the compatibility definition (symbol)."
+  the compatibility definition (symbol).
+
+TYPE is used to set the symbol property `compat-type' for NAME."
   (let* ((min-version (plist-get attr :min-version))
          (max-version (plist-get attr :max-version))
          (feature (plist-get attr :feature))
@@ -96,6 +98,8 @@ attributes are handled, all others are ignored:
                            1 font-lock-preprocessor-face prepend))))
                  ,(funcall install-fn realname))))
     `(progn
+       (put ',realname 'compat-type ',type)
+       (put ',realname 'compat-version ,version)
        ,(funcall def-fn realname version)
        ,(if feature
             `(eval-after-load ',feature (lambda () ,body))
@@ -162,7 +166,7 @@ attributes (see `compat-generate-common')."
         ((memq type '(func macro))
          `(fboundp ',name))
         ((eq type 'advice) t)))
-     rest)))
+     rest type)))
 
 (defmacro compat-defun (name arglist docstring &rest rest)
   "Define NAME with arguments ARGLIST as a compatibility function.
@@ -247,7 +251,7 @@ non-nil value."
      `(defvaralias ',name ',realname))
    (lambda ()
      `(boundp ',name))
-   attr))
+   attr 'variable))
 
 (provide 'compat-macs)
 ;;; compat-macs.el ends here
diff --git a/compat-tests.el b/compat-tests.el
index 1b41cbb..02a3cb6 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -96,7 +96,10 @@
     (macroexp-progn
      (list
       `(should (equal (funcall (apply-partially #',cfn #',rfn) ,@input) 
,result))
-      (and (fboundp rfn)
+      (and (and (fboundp rfn)
+                (or (not (eq (get cfn 'compat-type) 'advice))
+                    (not (get cfn 'compat-version))
+                    (version<= (get cfn 'compat-version) emacs-version)))
            `(should (equal (,rfn ,@input) ,result)))))))
 
 (defmacro compat--mshould (result &rest input)
@@ -129,7 +132,10 @@
     (macroexp-progn
      (list
       `(should-error (funcall (apply-partially #',cfn #',rfn) ,@input) :type 
',error)
-      (and (fboundp rfn)
+      (and (and (fboundp rfn)
+                (or (not (eq (get cfn 'compat-type) 'advice))
+                    (not (get cfn 'compat-version))
+                    (version<= (get cfn 'compat-version) emacs-version)))
            `(should-error (,rfn ,@input) :type ',error))))))
 
 ;; FIXME: extract the name of the test out of the ERT-test, instead
@@ -560,7 +566,7 @@ the compatibility function."
     ;; Test empty list:
     (compat--should* "\\(?:\\`a\\`\\)" '())
     (compat--should* "\\<\\(\\`a\\`\\)\\>" '() 'words))
-  (let ((unmatchable (regexp-opt '())))
+  (let ((unmatchable (compat--regexp-opt #'regexp-opt '())))
     (dolist (str '(""                   ;empty string
                    "a"                  ;simple string
                    "aaa"                ;longer string