emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 06a7606 10/31: Pass / update tests for warnings.


From: Jackson Ray Hamilton
Subject: [elpa] master 06a7606 10/31: Pass / update tests for warnings.
Date: Mon, 09 Feb 2015 01:09:32 +0000

branch: master
commit 06a760614d1fc4443d421e08765f0efeeeb58a29
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Pass / update tests for warnings.
---
 context-coloring.el           |   61 +++++++++++++++++++++++++++++------------
 test/context-coloring-test.el |   43 +++++++++++++++++------------
 2 files changed, 68 insertions(+), 36 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 0f2f9fa3..4d6c172 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -485,20 +485,40 @@ would be redundant."
   "context-coloring-level-\\([[:digit:]]+\\)-face"
   "Regular expression for extracting a level from a face.")
 
+(defvar context-coloring-defined-theme-hash-table (make-hash-table :test 'eq)
+  "Cache of custom themes who originally set their own
+  `context-coloring-level-N-face' faces.")
+
 (defun context-coloring-theme-definedp (theme)
   "Return t if there is a `context-coloring-level-N-face' defined
 for THEME, nil otherwise."
-  (let* ((settings (get theme 'theme-settings))
-         (tail settings)
-         found)
-    (while (and tail (not found))
-      (and (eq (nth 0 (car tail)) 'theme-face)
-           (string-match
-            context-coloring-level-face-regexp
-            (symbol-name (nth 1 (car tail))))
-           (setq found t))
-      (setq tail (cdr tail)))
-    found))
+  (let (defined)
+    (cond
+     ((setq defined (gethash theme context-coloring-defined-theme-hash-table))
+      (eq defined 'defined))
+     (t
+      (let* ((settings (get theme 'theme-settings))
+             (tail settings)
+             found)
+        (while (and tail (not found))
+          (and (eq (nth 0 (car tail)) 'theme-face)
+               (string-match
+                context-coloring-level-face-regexp
+                (symbol-name (nth 1 (car tail))))
+               (setq found t))
+          (setq tail (cdr tail)))
+        found)))))
+
+(defun context-coloring-cache-defined (theme defined)
+  "Remember if THEME had colors defined for it; if DEFINED is
+non-nil, it did, otherwise it didn't."
+  ;; Caching the definededness of a theme is kind of dirty, but we have to do 
it
+  ;; to remember the past state of the theme. There are probably some edge 
cases
+  ;; where caching will be an issue, but they are probably rare.
+  (puthash
+   theme
+   (if defined 'defined 'undefined)
+   context-coloring-defined-theme-hash-table))
 
 (defun context-coloring-warn-theme-defined (theme)
   "Warns the user that the colors for a theme are already defined."
@@ -575,14 +595,17 @@ theme's author's colors instead."
         (override (plist-get properties :override))
         (recede (plist-get properties :recede)))
     (dolist (name (append `(,theme) aliases))
-      (when (and (not override)
-                 (context-coloring-theme-definedp name))
-        (context-coloring-warn-theme-defined name))
       (puthash name properties context-coloring-theme-hash-table)
-      ;; Set (or overwrite) colors.
-      (when (and (custom-theme-p name)
-                 (not recede))
-        (context-coloring-apply-theme name)))))
+      (when (custom-theme-p name)
+        (let ((defined (context-coloring-theme-definedp name)))
+          (context-coloring-cache-defined name defined)
+          (when (and defined
+                     (not recede)
+                     (not override))
+            (context-coloring-warn-theme-defined name)))
+        ;; Set (or overwrite) colors.
+        (when (not recede)
+          (context-coloring-apply-theme name))))))
 
 (defun context-coloring-load-theme (&optional rest)
   (declare
@@ -607,6 +630,8 @@ THEME."
           (context-coloring-apply-theme theme)))))
      (t
       (let ((defined (context-coloring-theme-definedp theme)))
+        ;; Cache now in case the theme was defined after.
+        (context-coloring-cache-defined theme defined)
         (when (and defined
                    (not override))
           (context-coloring-warn-theme-defined theme))
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 5a55f28..9b636cc 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -210,6 +210,13 @@ EXPECTED-FACE."
 
 (defun context-coloring-test-assert-message (expected buffer)
   "Assert that BUFFER has message EXPECTED."
+  (when (null (get-buffer buffer))
+    (ert-fail
+     (format
+      (concat
+       "Expected buffer `%s' to have message \"%s\", "
+       "but the buffer did not have any messages.")
+      buffer expected)))
   (with-current-buffer buffer
     (let ((messages (split-string
                      (buffer-substring-no-properties
@@ -292,16 +299,27 @@ is FOREGROUND."
   (context-coloring-test-assert-face 8 "#888888")
   (context-coloring-test-assert-face 9 "#999999"))
 
+(defvar context-coloring-test-theme-index 0
+  "Unique index for unique theme names.")
+
+(defun context-coloring-test-get-next-theme ()
+  "Return a unique symbol for a throwaway theme."
+  (prog1
+      (intern (format "context-coloring-test-theme-%s"
+                      context-coloring-test-theme-index))
+    (setq context-coloring-test-theme-index
+          (+ context-coloring-test-theme-index 1))))
+
 (defun context-coloring-test-assert-theme-definedp (settings &optional negate)
   "Assert that `context-coloring-theme-definedp' returns t for a
 theme with SETTINGS (or the inverse if NEGATE is non-nil)."
-  (let (theme)
+  (let ((theme (context-coloring-test-get-next-theme)))
     (put theme 'theme-settings settings)
     (when (funcall (if negate 'identity 'not) (context-coloring-theme-definedp 
theme))
-      (ert-fail (format (concat "Expected theme with settings `%s' "
+      (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
                                 "%sto be considered to have defined a level, "
                                 "but it %s.")
-                        settings
+                        theme settings
                         (if negate "not " "")
                         (if negate "was" "wasn't"))))))
 
@@ -355,20 +373,6 @@ t for a theme with SETTINGS."
    1)
   )
 
-(defvar context-coloring-test-theme-index 0
-  "Unique index for unique theme names.")
-
-(defun context-coloring-test-get-next-theme ()
-  "Return a unique symbol for a throwaway theme."
-  (prog1
-      (intern (format "context-coloring-test-theme-%s"
-                      context-coloring-test-theme-index))
-    (setq context-coloring-test-theme-index
-          (+ context-coloring-test-theme-index 1))))
-
-(defun context-coloring-test-deftheme (theme)
-  (eval (macroexpand `(deftheme ,theme))))
-
 (defmacro context-coloring-test-deftest-define-theme (name &rest body)
   (declare (indent defun))
   (let ((deftest-name (intern (format "context-coloring-test-define-theme-%s" 
name))))
@@ -382,6 +386,9 @@ t for a theme with SETTINGS."
            (disable-theme theme)
            (context-coloring-set-colors-default))))))
 
+(defun context-coloring-test-deftheme (theme)
+  (eval (macroexpand `(deftheme ,theme))))
+
 (context-coloring-test-deftest-define-theme additive
   (context-coloring-test-deftheme theme)
   (context-coloring-define-theme
@@ -414,7 +421,7 @@ t for a theme with SETTINGS."
   (context-coloring-test-assert-defined-warning theme)
   (context-coloring-test-kill-buffer "*Warnings*")
   (enable-theme theme)
-  (context-coloring-test-assert-no-message "*Warnings*")
+  (context-coloring-test-assert-defined-warning theme)
   (context-coloring-test-assert-face 0 "#cccccc")
   (context-coloring-test-assert-face 1 "#dddddd"))
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]