Permalink
Browse files

(gimp-unit-test-execute): Applying patch by Brent Goodrick: fix for c…

…ompletion bug, add unit testing
  • Loading branch information...
1 parent 796d799 commit 27935278f0bac802f0cb29c80c41676733da4559 sharik committed Oct 2, 2009
Showing with 416 additions and 84 deletions.
  1. +416 −84 gimp-mode.el
View
500 gimp-mode.el
@@ -1,4 +1,4 @@
-;;; gimp-mode.el --- $Id: gimp-mode.el,v 1.52 2009-09-14 12:14:27 sharik Exp $
+;;; gimp-mode.el --- $Id: gimp-mode.el,v 1.53 2009-10-02 20:55:07 sharik Exp $
;; Copyright (C) 2008 Niels Giesen
;; Author: Niels Giesen <nielsforkgiesen@gmailspooncom, but please
@@ -250,9 +250,16 @@ another. Now best left at the non-nil value.")
;; (Bases of following caches) generated on GIMP startup (by
;; emacs-interaction.scm)
(defvar gimp-dump nil
- "Dump of pdb")
+ "Dump of GIMPs pdb as a hash table.
+
+Access this only through `gimp-get-dump-hash', since it requires
+that GIMP run and generate the symbol information for completion
+and documentation first.")
(defvar gimp-pdb-cache nil
- "Cache containing all symbols in GIMPs Procedural Database.")
+ "Cache containing all symbols in GIMPs Procedural Database.
+
+Access this only through `gimp-get-pdb-cache', for the same
+reasons as given by the documentation for `gimp-dump'.")
(defvar gimp-registrations nil)
(defvar gimp-fonts-cache nil
"Cache of available fonts")
@@ -325,7 +332,8 @@ script-fu console."
("grokking the gimp" .
"http://www.linuxtopia.org/online_books/graphics_tools\
/gimp_advanced_guide/index.html")
- ("sicp (Structure and Interpretation of Computer Programs)" . "http://mitpress.mit.edu/sicp/full-text/book/book.html"))
+ ("sicp (Structure and Interpretation of Computer Programs)" .
+ "http://mitpress.mit.edu/sicp/full-text/book/book.html"))
"Alist of gimp documentation URLs."
:group 'gimp
:type '(alist :key-type string :value-type string))
@@ -748,7 +756,7 @@ buffer."
(destructuring-bind (version major minor)
(gimp-string-match
"\\([0-9]+\\)\.\\([0-9]+\\)"
- "$Id: gimp-mode.el,v 1.52 2009-09-14 12:14:27 sharik Exp $" )
+ "$Id: gimp-mode.el,v 1.53 2009-10-02 20:55:07 sharik Exp $" )
(if (interactive-p)
(prog1 nil
(message "GIMP mode version: %s.%s" major minor))
@@ -898,6 +906,9 @@ to avoid infinite looping. "
(error "%S Timed out" this-command))
(sit-for .01)) ;keep polling
(substring gimp-output 0 -2)))))
+ ;; Bail early with an error message if the user needs to start the GIMP process:
+ ((not (gimp-proc))
+ (gimp-error-must-run-gimp))
((eq (process-status gimp-cl-proc)
'open)
(gimp-cl-eval-to-string string discard))
@@ -1286,8 +1297,27 @@ buffer, is found."
(get-buffer scheme-buffer)
(comint-check-proc scheme-buffer)))
+(defvar gimp-error-must-run-gimp-error-message
+ "You must execute `run-gimp' one time at least,\
+ in order to populate symbol completion tables from within GIMP."
+ "Error message to emit when the user must run GIMP first\
+ to populate symbol completion tables.")
+
+(defun gimp-error-must-run-gimp ()
+ (error gimp-error-must-run-gimp-error-message))
+
+(defun gimp-get-dump-hash ()
+ (if gimp-dump
+ gimp-dump
+ (gimp-error-must-run-gimp)))
+
+(defun gimp-get-pdb-cache ()
+ (if gimp-pdb-cache
+ gimp-pdb-cache
+ (gimp-error-must-run-gimp)))
+
(defun gimp-procedure-at-point (&optional as-string)
- (let ((sym (when (gethash (symbol-at-point) gimp-dump)
+ (let ((sym (when (gethash (symbol-at-point) (gimp-get-dump-hash))
(symbol-at-point))))
(when sym
(apply
@@ -1437,27 +1467,42 @@ screwed up. It is wise then to preceed it with a call to
(error (gimp-report-bug err)))
(message "%s%s" (current-message) "Done!"))
+(defun gimp-dump-file ()
+ (expand-file-name "dump.db" (gimp-dir)))
+
(defun gimp-read-dump ()
- (let ((file (concat (gimp-dir) "/dump.db"))
- (ht (make-hash-table :test 'eql)))
- (with-temp-buffer
- (insert-file-contents file)
- (mapc (lambda (i)
+ (let ((gimp-dump-file (gimp-dump-file))
+ (ht (make-hash-table :test 'eql)))
+ ;; If gimp-dump-file does not exist, then GIMP has not been executed yet,
+ ;; which is required in order for the file to be generated by the
+ ;; emacs-interaction.scm file inside GIMP. But at Emacs startup, we may be
+ ;; asked to read the dump file, but we will silently ignore that request
+ ;; here if the dump.db file does not already exist. Later on, when the user
+ ;; executes one of Gimp Modes commands that requires symbol
+ ;; completion, then we will throw an error that reminds them that they have
+ ;; to run the GIMP one time at least in order to dump this file out. Note
+ ;; that the accessing of gimp-dump or gimp-pdb-cache should be guarded with
+ ;; the proper check by calling gimp-get-dump-hash and gimp-get-pdb-cache,
+ ;; respectively, instead directly accessing the variables, except of course
+ ;; here where we update their values:
+ (when (file-exists-p gimp-dump-file)
+ (with-temp-buffer
+ (insert-file-contents gimp-dump-file)
+ (mapc (lambda (i)
(puthash (intern (cadr i))
(cddr i)
ht))
- (read (concat
+ (read (concat
"("
(buffer-substring-no-properties
(point-min) (point-max))
- ")")))
- (kill-buffer nil))
- (setq gimp-dump ht)
- (setq gimp-pdb-cache (let (list)
- (maphash (lambda (k v)
- (push (symbol-name k) list))
- gimp-dump)
- list))))
+ ")"))))
+ (setq gimp-dump ht)
+ (setq gimp-pdb-cache (let (list)
+ (maphash (lambda (k v)
+ (push (symbol-name k) list))
+ gimp-dump)
+ list)))))
;; Input ring
(defun gimp-save-input-ring ()
"Save the input ring for subsequent sessions."
@@ -1488,7 +1533,7 @@ screwed up. It is wise then to preceed it with a call to
(up-list -1)
(push (gimp-de-underscore
(cdr (sexp-at-point))) result)
- (forward-sexp 1)))))
+ (forward-sexp 1)))))
(gimp-all-scm-files))
result)))
@@ -1577,7 +1622,7 @@ See variable `gimp-docs-alist'"
;; (defun gimp-apropos-list (input)
;; (loop for i in (sort (mapcar (lambda (l)
;; (symbol-name (car l)))
-;; (gimp-hash-to-list gimp-dump)) 'string<)
+;; (gimp-hash-to-list (gimp-get-dump-hash))) 'string<)
;; when (string-match input i)
;; collect i))
@@ -1588,7 +1633,7 @@ See variable `gimp-docs-alist'"
;; (maphash (lambda (k v)
;; (if (string-match value (nth pos v))
;; (push (symbol-name k) result)))
-;; gimp-dump)
+;; (gimp-get-dump-hash))
;; (sort result 'string<)))
(defun gimp-real-apropos (value)
@@ -1602,7 +1647,7 @@ See variable `gimp-docs-alist'"
(string-match (concat "\\<" value "\\>") thing))) v)
(string-match value (symbol-name k)))
(push (symbol-name k) result)))
- gimp-dump)
+ (gimp-get-dump-hash))
(sort result 'string<)))
(gimp-defcommand gimp-apropos (&optional query)
@@ -1716,15 +1761,16 @@ Use `outline-mode' commands to navigate and fold stuff.
Optional argument PROC is a string identifying a procedure."
(interactive)
- (let* ((sym
+ (let* ((pdb-cache (gimp-get-pdb-cache))
+ (sym
(read
(or
proc
(gimp-procedure-at-point t)
(car (member (symbol-name
- (gimp-fnsym-in-current-sexp)) gimp-pdb-cache))
- (completing-read "Procedure: " gimp-pdb-cache nil t
- (if (gethash (symbol-at-point) gimp-dump)
+ (gimp-fnsym-in-current-sexp)) pdb-cache))
+ (completing-read "Procedure: " pdb-cache nil t
+ (if (gethash (symbol-at-point) (gimp-get-dump-hash))
(symbol-name (symbol-at-point))))))))
(add-to-list 'gimp-help-visited-pages sym)
(gimp-help-wrapper
@@ -1757,7 +1803,7 @@ s : search source code for symbol"
(replace-regexp-in-string
"'\\([[:alpha:]-]+\\)'"
(lambda (match)
- (if (member (match-string 1 match) gimp-pdb-cache)
+ (if (member (match-string 1 match) (gimp-get-pdb-cache))
(gimp-button match
function
"Follow link"
@@ -1854,7 +1900,7 @@ s : search source code for symbol"
(nth arg (gimp-get-proc-args proc)))
(defun gimp-get-proc-description (proc)
- (gethash proc gimp-dump))
+ (gethash proc (gimp-get-dump-hash)))
(defun gimp-get-proc-args (proc)
(let ((all-args (nth 6 (gimp-get-proc-description proc))))
@@ -2010,7 +2056,7 @@ You can toggle this variable at any time with the command
((lambda (desc name type)
(string= "procedure-name" name))
. (lambda (&rest ignore)
- gimp-pdb-cache))
+ (gimp-get-pdb-cache)))
((lambda (desc name type)
(string= "run-mode" name))
@@ -2179,7 +2225,9 @@ Optional argument LST specifies a list of completion candidates."
(let* ((lst (mapcar (lambda (i)
(if (listp i)
(car i)
- i)) ;let the list be possibly of form ((matchable . metadata))
+ i))
+ ;;let the list be possibly of form
+ ;;((matchable . metadata))
(or lst gimp-oblist-cache)))
(completion
(if (not gimp-complete-fuzzy-p)
@@ -2257,59 +2305,77 @@ Pushed into `hippie-expand-try-functions-list'."
(defun gimp-completable-at-p ()
"Check whether thing at p is completable."
(let ((fun (gimp-fnsym-in-current-sexp)))
- (and fun (gethash fun gimp-dump))))
+ (and fun (gethash fun (gimp-get-dump-hash)))))
(defun gimp-complete ()
"Main completion function."
(unless (and (not (interactive-p))
(not gimp-complete-p))
- (let ((fun (gimp-fnsym-in-current-sexp))
- (pos (gimp-position))
- (gimp-command
- (save-excursion
- (cadr (gimp-string-match "^,\\([[:alpha:]-]*\\)"
- (comint-get-old-input-default))))))
- (cond
- (gimp-command
- (gimp-complete-savvy gimp-shortcuts))
- ((and fun (> pos (length (gimp-get-proc-args fun))))
- (point))
- ((gimp-completable-at-p)
- (let* ((desc (gimp-get-proc-arg fun (1- pos)))
- (list (gimp-make-completion desc))
- (scraped-arg (gimp-arg-from-scraped-registration
- (1- pos)
- (symbol-name fun)))
- (question (format "%s %s: "
- (caddr desc)
- (or scraped-arg ""))))
- (if (string= (car desc)
- "option")
- (setq list
- (or scraped-arg list)))
- (cond
- ((eq list 'discard)
- nil)
- ((functionp list)
- (funcall list))
- (list
- (gimp-complete-savvy list))
- (t (let ((answer (read-from-minibuffer
- question
- (if scraped-arg
- (case
- (read (cadr desc))
- (GIMP_PDB_FLOAT
- (number-to-string (cadar scraped-arg)))
- (GIMP_PDB_COLOR (if (numberp (car scraped-arg))
- (format "'%S" scraped-arg)
- (car scraped-arg)))
- (t (format "%S" (car scraped-arg))))
- nil))))
- (insert
- (replace-regexp-in-string "\\(^\"\\|\"$\\)" "" answer)))))))
- (t
- (gimp-complete-savvy gimp-oblist-cache))))))
+ (let* ((fun (gimp-fnsym-in-current-sexp))
+ (pos (gimp-position))
+ (gimp-command
+ (save-excursion
+ (cadr (gimp-string-match "^,\\([[:alpha:]-]*\\)"
+ (comint-get-old-input-default)))))
+ (num-args (gimp-get-proc-args fun))
+ (function-already-complete (not (null num-args))))
+ (cond
+ (gimp-command
+ (gimp-complete-savvy gimp-shortcuts))
+ ;; If the function is already complete, but there are no arguments, then
+ ;; there is nothing to complete:
+ ((and function-already-complete (= 0 (length num-args)))
+ (point))
+ ((and fun (> pos (length num-args)))
+ (point))
+ ((and (gimp-completable-at-p)
+ ;; Prompt for completion of the argument if there is info for that
+ ;; argument, but not otherwise:
+ (gimp-get-proc-arg fun (1- pos)))
+ (let* ((desc (gimp-get-proc-arg fun (1- pos)))
+ (list (gimp-make-completion desc))
+ (scraped-arg (gimp-arg-from-scraped-registration
+ (1- pos)
+ (symbol-name fun)))
+ (question (format "%s %s: "
+ (caddr desc)
+ (or scraped-arg ""))))
+ (if (string= (car desc)
+ "option")
+ (setq list
+ (or scraped-arg list)))
+ (cond
+ ((eq list 'discard)
+ nil)
+ ((functionp list)
+ (funcall list))
+ ;; If there are no completions and we are at the end of the word that
+ ;; was completed, then don't try to prompt for the argument since there
+ ;; needs to be at least one whitespace character between point and the
+ ;; end of the previous word. In that case we will do the default savvy
+ ;; completion (which may not actually complete anything, which is
+ ;; sometimes expected):
+ ((and (null list)
+ (not (looking-back (rx (+ (or "\n" white))))))
+ (gimp-complete-savvy gimp-oblist-cache))
+ (list
+ (gimp-complete-savvy list))
+ (t (let ((answer (read-from-minibuffer
+ question
+ (if scraped-arg
+ (case
+ (read (cadr desc))
+ (GIMP_PDB_FLOAT
+ (number-to-string (cadar scraped-arg)))
+ (GIMP_PDB_COLOR (if (numberp (car scraped-arg))
+ (format "'%S" scraped-arg)
+ (car scraped-arg)))
+ (t (format "%S" (car scraped-arg))))
+ nil))))
+ (insert
+ (replace-regexp-in-string "\\(^\"\\|\"$\\)" "" answer)))))))
+ (t
+ (gimp-complete-savvy gimp-oblist-cache))))))
(defun gimp-local-completion ()
(let* ((desc (gimp-get-proc-arg
@@ -2479,7 +2545,7 @@ argument at point is highlighted."
response
(pos (gimp-position)))
(when sym
- (cond ((gethash sym gimp-dump)
+ (cond ((gethash sym (gimp-get-dump-hash))
;; Get it
(setq response (gimp-docstring (read str))))
((unless nil ;(string-match "define\\(?:-macro\\)?\\|let" str)
@@ -2538,7 +2604,7 @@ argument at point is highlighted."
"Echo description for argument or procedure at point."
(interactive)
(let* ((sym (gimp-without-string (gimp-fnsym-in-current-sexp))))
- (if (member (symbol-name sym) gimp-pdb-cache)
+ (if (member (symbol-name sym) (gimp-get-pdb-cache))
(if (eql sym (symbol-at-point))
(gimp-echo-procedure-description sym)
(message "%s %s"
@@ -2588,10 +2654,10 @@ into etags and find-tag."
(or proc
(completing-read
"Search code for procedure: "
- gimp-pdb-cache nil t
+ (gimp-get-pdb-cache) nil t
(let ((p (or (gimp-procedure-at-point)
(and
- (gethash (gimp-fnsym-in-current-sexp) gimp-dump)
+ (gethash (gimp-fnsym-in-current-sexp) (gimp-get-dump-hash))
(gimp-fnsym-in-current-sexp)))))
(if p (symbol-name p) nil))))))
(case (gimp-get-proc-type (read proc))
@@ -3062,6 +3128,272 @@ Lisp world."
(string= (buffer-name)
"*Gimp-Client*"))
+(defun gimp-unit-test-execute (test-name function-to-test &rest cl-keys)
+ "Test FUNCTION-TO-TEST using TEST-NAME to name the output.
+
+This function is part of the unit test function suite for
+gimp-mode.
+
+TEST-NAME is a string for pass/fail messages.
+
+FUNCTION-TO-TEST specifies a lambda function to execute.
+
+Optional keywords:
+
+:expression is a Scheme expression to test FUNCTION-TO-TEST
+against. It should include a \"<point>\" string where the test
+should position point before proceeding with the test (the
+\"<point>\" part of the expression is deleted before proceeding).
+
+When :use-nil-dump-file is set to a non-nil value, the
+`gimp-dump' is temporarily set to nil to simulate the condition
+whereby the user has installed gimp-mode the first time, but has
+yet to actually run GIMP, such that the symbol completion should
+fail in a user-friendly way.
+
+When :use-nil-dump-file is left to be nil, then `gimp-dump'
+variable is left set as it is (and in this case, `gimp-dump' must
+be non-nil, which is verified during the test run).
+
+When :dont-trap is non-nil, do not trap for any error, which is
+used for interactive debugging by avoiding obscuring the
+traceback (useful when you also have debug-on-error enabled with
+`toggle-debug-on-error').
+
+:preconditioner is a lambda form to funcall before running the test:
+
+\nKeywords supported: :use-nil-dump-file :dont-trap :validator \
+:preconditioner
+\n(fn TEST-NAME FUNCTION-TO-TEST EXPRESSION [KEYWORD VALUE]...)"
+ (cl-parsing-keywords
+ (:expression :use-nil-dump-file :dont-trap :validator :preconditioner) ()
+ (let ((tmp-scm-file (make-temp-file "gimp-mode-test" nil ".scm"))
+ ;; Set gimp-dump to nil temporarily to simulate that the GIMP dump file
+ ;; did not exist upon startup, but only if cl-use-nil-dump-file is t
+ (gimp-dump (if cl-use-nil-dump-file
+ nil
+ (or gimp-dump
+ (error "You must have run `run-gimp' at least once\
+ first time in order for the unit-test to validate all functionality."))))
+ (read-from-minibuffer-result-string "result-string")
+ read-from-minibuffer-list)
+ (flet ((test-error (&rest format-args)
+ (error (format "gimp-unit-test-execute: %s: %s"
+ test-name (apply 'format format-args))))
+ ;; override read-from-minibuffer to just record the prompts into
+ ;; read-from-minibuffer-list so that the cl-validator can scan over it
+ ;; for various tests:
+ (read-from-minibuffer
+ (prompt &optional initial-contents keymap read hist default-value
+ inherit-input-method)
+ (push (list prompt initial-contents keymap read hist default-value
+ inherit-input-method) read-from-minibuffer-list)
+ ;; Return a result, just as read-from-minibuffer would:
+ read-from-minibuffer-result-string))
+ (with-temp-file tmp-scm-file
+ (when cl-expression
+ (insert cl-expression)
+ (goto-char (point-min))
+ (let ((point-expression "<point>"))
+ (if (search-forward point-expression nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (test-error (format "EXPRESSION does not include a \"%s\" string\
+ to locate the point." point-expression)))))
+ ;; Execute the preconditioner if specified:
+ (when cl-preconditioner
+ (funcall cl-preconditioner))
+ ;; Use dont-trap when you want to see the error backtrace show up with
+ ;; toggle-debug-on-error is active (otherwise, the backtracing mechanism
+ ;; in Emacs rewrites the trace to the point of not being useable):
+ (if cl-dont-trap
+ (funcall function-to-test)
+ (condition-case err
+ (funcall function-to-test)
+ (error
+ (if (not (string-equal (cadr err) gimp-error-must-run-gimp-error-message))
+ (error "FAILED \"%s\": Unexpected error: %S" test-name err)))))
+ ;; Call the cl-validator and expect a string result if it fails, and that
+ ;; string result is the reason for the failure. But if cl-validator is not
+ ;; specified, then just indicate the test passed:
+ (let (validator-result)
+ (if cl-validator
+ (setq validator-result (funcall cl-validator read-from-minibuffer-list)))
+ (if (and cl-validator (stringp validator-result))
+ (error "FAILED \"%s\": Validation failed: %s" test-name validator-result)
+ (message (format "PASSED: \"%s\"" test-name)))))
+ ;; Remove the temporary file file if it is written (we expect
+ ;; it to be always written out by make-temp-file called
+ ;; above):
+ (and (file-exists-p tmp-scm-file) (delete-file tmp-scm-file))))))
+
+(defun gimp-unit-test-completions (dont-trap)
+ "Unit test function for testing completion."
+ (flet ((current-word-validator
+ (word)
+ `(lambda (&rest ignored)
+ (let ((word (current-word)))
+ (or (string-equal ,word word)
+ (format
+ "Expected current word to be completed as %S but instead got %S"
+ ,word word)))))
+ (expect-no-prompting-validator
+ ()
+ (lambda (&rest read-from-minibuffer-list)
+ (and (car read-from-minibuffer-list)
+ (format
+ "Expected no prompting but instead got one or more prompts: %S"
+ read-from-minibuffer-list)))))
+ (let ((function-to-test (lambda ()
+ (call-interactively 'gimp-indent-and-complete))))
+ ;; Insure that we have a proper error message when the `gimp-dump' variable
+ ;; does not exist, which means that the user has yet to run `run-gimp' the
+ ;; very first time after having installed gimp-mode (the installation of which
+ ;; includes inserting a .scm file into the users GIMP startup directory to
+ ;; dump out a representation of the GIMP PDB for Emacs to read into the
+ ;; `gimp-dump' hash):
+ (gimp-unit-test-execute "Error checking for missing dump hash"
+ function-to-test
+ :expression "(gimp-displays-flush<point>)"
+ :use-nil-dump-file t
+ :dont-trap dont-trap)
+ ;; Do the same test as above, but this time test that no Emacs Lisp error
+ ;; occurs during completion of a GIMP Scheme function known to have zero
+ ;; arguments:
+ (gimp-unit-test-execute
+ "Check for zero-args function name completion"
+ function-to-test
+ :expression "(gimp-displays-flush<point>)"
+ :dont-trap dont-trap
+ :validator
+ (current-word-validator "gimp-displays-flush"))
+ (gimp-unit-test-execute
+ "Check for one-arg function name completion with arg already specified"
+ function-to-test
+ :expression "(gimp-display-ne<point> image)"
+ :dont-trap dont-trap
+ :validator (current-word-validator "gimp-display-new"))
+ ;; Test for two-arg function completion. No prompting for
+ ;; arguments should be done:
+ (gimp-unit-test-execute
+ "Check for two-arg function name completion with arg already specified"
+ function-to-test
+ :expression "(gimp-image-new<point> image)"
+ :dont-trap dont-trap
+ :validator (expect-no-prompting-validator))
+ ;; Test for one-arg function completion. This has in the past
+ ;; resulted in failures whereby the user has not yet run
+ ;; `run-gimp', which means that the inferior process with the
+ ;; GIMP has not yet been established; the solution to this of
+ ;; course is to require the user to execute `run-gimp'. Here,
+ ;; gimp-display-new has an argument that is matched by the
+ ;; gimp-completion-rules, but returns nil often times
+ ;; (gimp-image-list can return nil if there are no active
+ ;; images), and in that case we do not want to prompt for the
+ ;; argument since the point does not have a space in front (If
+ ;; we were to go ahead and prompt for the argument and insert it
+ ;; in without the preceding whitespace, then it will be a part
+ ;; of the previous word, which is not syntactically correct, and
+ ;; certainly not what the user desires):
+ (gimp-unit-test-execute
+ "Check for function name completion without preceding space\
+ but with first arg of image type"
+ function-to-test
+ :expression "(gimp-display-new<point> image)"
+ :dont-trap dont-trap
+ :validator (expect-no-prompting-validator))
+ ;; Do the same test as above, but gimp-image-new whose first arg
+ ;; is an integer type, and for that case we do not prompt. In
+ ;; this case and the preceding case, there is no preceding space
+ ;; which is key here:
+ (gimp-unit-test-execute
+ "Check for function name completion without preceding space\
+ but with first arg of integer type"
+ function-to-test
+ :expression "(gimp-image-new<point>)"
+ :dont-trap dont-trap
+ :validator (expect-no-prompting-validator))
+ ;; Expect to prompt for the first arg of a function that takes
+ ;; an image type as the first argument. Note that there _is_
+ ;; preceding whitespace in front of point here:
+ (gimp-unit-test-execute
+ "Check for function name completion with preceding space\
+ but with first arg of image type"
+ function-to-test
+ :expression "(gimp-display-new <point> image)"
+ :dont-trap dont-trap
+ :validator (lambda (&rest read-from-minibuffer-list)
+ (let ((first-arg (car read-from-minibuffer-list)))
+ (cond ((null first-arg)
+ (format "Expected a prompt but got none"))
+ ;; Pass the test if the prompt
+ ;; contains the word "image"
+ ;; in upper or lower case:
+ ((let ((case-fold-search t))
+ (string-match "image" (caar first-arg)))
+ t)
+ (t
+ (format
+ "Unexpected first argument prompt for gimp-display-new: %S"
+ (caar first-arg)))))))
+ ;; Expect no prompting on a integer argument type when
+ ;; completing after some whitespace:
+ (gimp-unit-test-execute
+ "Check for function name completion with preceding space\
+ but with first arg of integer type"
+ function-to-test
+ :expression "(gimp-image-new <point>)"
+ :dont-trap dont-trap
+ :validator (expect-no-prompting-validator))
+ ;; Test for completions on a function:
+ (gimp-unit-test-execute
+ "Check for function name completion with preceding space\
+ but with first arg of integer type"
+ function-to-test
+ :expression "(gimp-image-<point>)"
+ ;; kill all completion buffers initially, so as to test for at
+ ;; least one showing up during completion:
+ :preconditioner
+ (lambda ()
+ (mapc (lambda (buffer)
+ (and (string-match (rx "*Completions*") (buffer-name buffer))
+ (kill-buffer buffer)))
+ (buffer-list)))
+ :dont-trap dont-trap
+ :validator
+ (lambda (&rest read-from-minibuffer-list)
+ (unless (remove-if-not
+ (lambda (buffer)
+ (string-match (rx "*Completions*") (buffer-name buffer)))
+ (buffer-list))
+ "No completions buffer showed up when completing on \"gimp-image-<point>\"")))
+ ;; (gimp-unit-test-execute "Check for one-arg function name
+ ;; completion with arg not already specified"
+ ;; "(gimp-display-new<point>)" nil dont-trap)
+ (message "PASSED: All gimp-mode unit-tests pass."))))
+
+(defun gimp-unit-test (&optional dont-trap)
+ "The top-level driver function for all unit-tests.
+
+Call subsidiary functions to perform various unit-tests on
+temporary GIMP Scheme files to validate the Emacs-->GIMP
+integration provided by `gimp-mode'.
+
+Optional prefix argument DONT-TRAP will be passed on to the
+testing functions. See documentation on keyword arg :dont-trap in
+`gimp-unit-test-execute'."
+ (interactive "P")
+ (unless (and (gimp-dir) (file-directory-p (gimp-dir)))
+ (error "Expected (gimp-dir) to return an existing directory.\
+ Did Gimp Mode get downloaded and installed correctly?"))
+ ;; Insure we have read the dump file:
+ (gimp-read-dump)
+ (gimp-unit-test-completions dont-trap)
+ ;;
+ ;; ... add more unit test function calls here ...
+ ;;
+ (message "PASSED: All gimp-mode unit-tests pass."))
+
(provide 'gimp-mode)
;;; gimp-mode.el ends here
+

0 comments on commit 2793527

Please sign in to comment.