From dd65fe618683129d964d9fe76dbaab26a34bd336 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 18 Jul 2017 20:15:14 -0400 Subject: [PATCH] Add compile_all target, fix all compilation warnings * Rakefile (.elc): Set byte-compile-force-lexical-warnings when compiling. (:compile_all): New target that compiles yasnippet-debug.el and yasnippet-tests.el too. * .travis.yml (script): Use it instead of `compile'. Update cl-lib to 0.6.1. Don't error on warnings for Emacs 24.3 on yasnippet-tests.el. * yasnippet-debug.el: Don't use `yas--loaddir' if it's not bound (e.g., when compiling). Require `color' and `edebug' at toplevel. Check if `subr-x' defines `when-let'. (yas-debug-snippet-vars): Remove, it was unused and broken. * yasnippet-tests.el (yas-with-snippet-dirs, (yas-should-expand) (yas--collect-menu-items, yas-should-not-expand, yas-mock-insert) (yas-mock-yank, yas--key-binding, yas-make-file-or-dirs) (yas-variables, yas-call-with-saving-variables) (yas-call-with-snippet-dirs, special-mode, string-suffix-p): Move to top section. (yas-tests--ran-exit-hook): Rename from yas--ran-exit-hook, and move to top-level. * yasnippet.el (yas--letenv): Evaluate the FORMs of ENV. --- .travis.yml | 22 +++- Rakefile | 16 ++- yasnippet-debug.el | 51 +++----- yasnippet-tests.el | 282 ++++++++++++++++++++++----------------------- yasnippet.el | 12 +- 5 files changed, 192 insertions(+), 191 deletions(-) diff --git a/.travis.yml b/.travis.yml index 1dfb3fa..3e27a32 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,10 +4,18 @@ git: submodules: false env: - - EMACS_VERSION=23.4 - - EMACS_VERSION=24.3 - - EMACS_VERSION=24.5 - - EMACS_VERSION=25.2 + global: + - Wlexical=t + - Werror=t + - tests_Werror=t # For yasnippet-tests.el + matrix: + - EMACS_VERSION=23.4 + # 24.3 gives a bunch of 'value returned from (car value-N) is + # unused' warnings. + - EMACS_VERSION=24.3 tests_Werror=nil + - EMACS_VERSION=24.5 + - EMACS_VERSION=25.2 + install: - curl -LO https://github.com/npostavs/emacs-travis/releases/download/bins/emacs-bin-${EMACS_VERSION}.tar.gz @@ -15,7 +23,7 @@ install: # Configure $PATH: Emacs installed to /tmp/emacs - export PATH=/tmp/emacs/bin:${PATH} - if ! emacs -Q --batch --eval "(require 'cl-lib)" ; then - curl -Lo cl-lib.el http://elpa.gnu.org/packages/cl-lib-0.5.el ; + curl -Lo cl-lib.el http://elpa.gnu.org/packages/cl-lib-0.6.1.el ; export warnings="'(not cl-functions)" ; fi - if ! emacs -Q --batch --eval "(require 'ert)" ; then @@ -25,7 +33,9 @@ install: - emacs --version script: - - rake compile + - rake yasnippet.elc + - rake yasnippet-debug.elc + - rake yasnippet-tests.elc Werror=$tests_Werror - rake tests notifications: diff --git a/Rakefile b/Rakefile index 85133e6..83c6257 100644 --- a/Rakefile +++ b/Rakefile @@ -100,14 +100,22 @@ end desc "Compile yasnippet.el into yasnippet.elc" rule '.elc' => '.el' do |t| - set_warnings = "" + cmdline = $EMACS + ' --batch -L .' if ENV['warnings'] - set_warnings = " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\"" + cmdline += " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\"" end - sh "#{$EMACS} --batch -L . --eval \"(setq byte-compile-error-on-warn t)\"" + - "#{set_warnings} -f batch-byte-compile #{t.source}" + if ENV['Werror'] + cmdline += " --eval \"(setq byte-compile-error-on-warn #{ENV['Werror']})\"" + end + if ENV['Wlexical'] + cmdline += " --eval \"(setq byte-compile-force-lexical-warnings #{ENV['Wlexical']})\"" + end + cmdline +=" -f batch-byte-compile #{t.source}" + + sh cmdline end task :compile => FileList["yasnippet.el"].ext('elc') +task :compile_all => FileList["*.el"].ext('elc') task :default => :doc diff --git a/yasnippet-debug.el b/yasnippet-debug.el index 79a9b6d..178e627 100644 --- a/yasnippet-debug.el +++ b/yasnippet-debug.el @@ -36,10 +36,18 @@ (file-name-directory (or load-file-name buffer-file-name)) "Directory that yasnippet was loaded from.") -(require 'yasnippet (expand-file-name "yasnippet" yas--loaddir)) +(require 'yasnippet (if (boundp 'yas--loaddir) + ;; Don't require '-L ' when debugging. + (expand-file-name "yasnippet" yas--loaddir))) (require 'cl-lib) (eval-when-compile - (unless (require 'subr-x nil t) + (unless (fboundp 'cl-flet) + (defalias 'cl-flet 'flet))) +(require 'color nil t) +(require 'edebug) +(eval-when-compile + (unless (and (require 'subr-x nil t) (fboundp 'when-let)) + ;; Introduced in 25.1 (defmacro when-let (key-val &rest body) (declare (indent 1) (debug ((symbolp form) body))) `(let ((,(car key-val) ,(cadr key-val))) @@ -73,7 +81,9 @@ (color (cl-loop with best-color = nil with max-dist = -1 for color = (format "#%06X" (random #x1000000)) - for comp = (apply #'color-rgb-to-hex (color-complement color)) + for comp = (if (fboundp 'color-complement) + (apply #'color-rgb-to-hex (color-complement color)) + color) if (< (color-distance color (face-foreground 'default)) (color-distance comp (face-foreground 'default))) do (setq color comp) @@ -192,7 +202,9 @@ (yas--debug-format-fom-concise (yas--mirror-next mirror)))))))) (defvar yas-debug-target-buffer nil) -(defvar-local yas-debug-target-snippets nil) +(defvar yas-debug-target-snippets nil nil) +(make-variable-buffer-local 'yas-debug-target-snippets) + (defvar yas-debug-undo nil) (defun yas-toggle-debug-undo (value) @@ -246,7 +258,6 @@ ;; want when the caller has a single window open. Good ;; enough for now. (when (eq hook 'create) - (require 'edebug) (edebug-instrument-function 'yas--snippet-parse-create) (let ((buf-point (find-function-noselect 'yas--snippet-parse-create))) (with-current-buffer (car buf-point) @@ -257,36 +268,6 @@ (defun yas-debug-snippet-create () (yas-debug-snippets nil 'create)) -(defun yas-debug-snippet-vars () - "Debug snippets, fields, mirrors and the `buffer-undo-list'." - (interactive) - (yas-debug-with-tracebuf () - (printf "Interesting YASnippet vars: \n\n") - - (printf "\nPost command hook: %s\n" post-command-hook) - (printf "\nPre command hook: %s\n" pre-command-hook) - - (printf "%s live snippets in total\n" (length (yas-active-snippets 'all-snippets))) - (printf "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max)))) - (printf "%s live snippets at point:\n\n" (length (yas-active-snippets))) - - (yas-debug-snippets outbuf) ;;FIXME: reference to free variable ‘outbuf’ - - (printf "\nUndo is %s and point-max is %s.\n" - (if (eq buffer-undo-list t) - "DISABLED" - "ENABLED") - (point-max)) - (unless (eq buffer-undo-list t) - (printf "Undpolist has %s elements. First 10 elements follow:\n" - (length buffer-undo-list)) - (let ((first-ten (cl-subseq buffer-undo-list 0 - (min 19 (length buffer-undo-list))))) - (dolist (undo-elem first-ten) - (printf "%2s: %s\n" (cl-position undo-elem first-ten) - (truncate-string-to-width (format "%s" undo-elem) 70))))) - (display-buffer tracebuf))) ;;FIXME: reference to free variable ‘tracebuf’ - (defun yas--debug-format-fom-concise (fom) (when fom (cond ((yas--field-p fom) diff --git a/yasnippet-tests.el b/yasnippet-tests.el index c5a94f5..748ba97 100644 --- a/yasnippet-tests.el +++ b/yasnippet-tests.el @@ -22,6 +22,11 @@ ;; Test basic snippet mechanics and the loading system +;; To test this in emacs22 mac osx: +;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el +;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el +;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert + ;;; Code: (require 'yasnippet) @@ -30,6 +35,122 @@ (require 'cl-lib) (require 'org) + +;;; Helper macros and function + +(defmacro yas-with-snippet-dirs (dirs &rest body) + (declare (indent defun) (debug t)) + `(yas-call-with-snippet-dirs + ,dirs #'(lambda () ,@body))) + +(defun yas-should-expand (keys-and-expansions) + (dolist (key-and-expansion keys-and-expansions) + (yas-exit-all-snippets) + (erase-buffer) + (insert (car key-and-expansion)) + (ert-simulate-command '(yas-expand)) + (unless (string= (yas--buffer-contents) (cdr key-and-expansion)) + (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\"" + (car key-and-expansion) + (cdr key-and-expansion) + (yas--buffer-contents))))) + (yas-exit-all-snippets)) + +(defun yas--collect-menu-items (menu-keymap) + (let ((yas--menu-items ())) + (map-keymap (lambda (_binding definition) + (when (eq (car-safe definition) 'menu-item) + (push definition yas--menu-items))) + menu-keymap) + yas--menu-items)) + +(defun yas-should-not-expand (keys) + (dolist (key keys) + (yas-exit-all-snippets) + (erase-buffer) + (insert key) + (ert-simulate-command '(yas-expand)) + (unless (string= (yas--buffer-contents) key) + (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\"" + key + (yas--buffer-contents)))))) + +(defun yas-mock-insert (string) + (dotimes (i (length string)) + (let ((last-command-event (aref string i))) + (ert-simulate-command '(self-insert-command 1))))) + +(defun yas-mock-yank (string) + (let ((interprogram-paste-function (lambda () string))) + (ert-simulate-command '(yank nil)))) + +(defun yas--key-binding (key) + "Like `key-binding', but override `this-command-keys-vector'. +This lets `yas--maybe-expand-from-keymap-filter' work as expected." + (cl-letf (((symbol-function 'this-command-keys-vector) + (lambda () (cl-coerce key 'vector)))) + (key-binding key))) + +(defun yas-make-file-or-dirs (ass) + (let ((file-or-dir-name (car ass)) + (content (cdr ass))) + (cond ((listp content) + (make-directory file-or-dir-name 'parents) + (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (mapc #'yas-make-file-or-dirs content))) + ((stringp content) + (with-temp-buffer + (insert content) + (write-region nil nil file-or-dir-name nil 'nomessage))) + (t + (message "[yas] oops don't know this content"))))) + + +(defun yas-variables () + (let ((syms)) + (mapatoms #'(lambda (sym) + (if (and (string-match "^yas-[^/]" (symbol-name sym)) + (boundp sym)) + (push sym syms)))) + syms)) + +(defun yas-call-with-saving-variables (fn) + (let* ((vars (yas-variables)) + (saved-values (mapcar #'symbol-value vars))) + (unwind-protect + (funcall fn) + (cl-loop for var in vars + for saved in saved-values + do (set var saved))))) + +(defun yas-call-with-snippet-dirs (dirs fn) + (let* ((default-directory (make-temp-file "yasnippet-fixture" t)) + (yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs))) + (with-temp-message "" + (unwind-protect + (progn + (mapc #'yas-make-file-or-dirs dirs) + (funcall fn)) + (when (>= emacs-major-version 24) + (delete-directory default-directory 'recursive)))))) + +;;; Older emacsen +;;; +(unless (fboundp 'special-mode) + ;; FIXME: Why provide this default definition here?!? + (defalias 'special-mode 'fundamental)) + +(unless (fboundp 'string-suffix-p) + ;; introduced in Emacs 24.4 + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + ;;; Snippet mechanics @@ -499,14 +620,9 @@ mapconcat #'(lambda (arg) (kill-buffer ,temp-buffer)))))))) (defmacro yas-saving-variables (&rest body) + (declare (debug t)) `(yas-call-with-saving-variables #'(lambda () ,@body))) -(defmacro yas-with-snippet-dirs (dirs &rest body) - (declare (indent defun)) - `(yas-call-with-snippet-dirs ,dirs - #'(lambda () - ,@body))) - (ert-deftest example-for-issue-474 () (yas--with-font-locked-temp-buffer (c-mode) @@ -597,21 +713,22 @@ TODO: correct this bug!" "brother from another mother") ;; no newline should be here! ))) +(defvar yas-tests--ran-exit-hook nil) + (ert-deftest snippet-exit-hooks () - (defvar yas--ran-exit-hook) (with-temp-buffer (yas-saving-variables - (let ((yas--ran-exit-hook nil) + (let ((yas-tests--ran-exit-hook nil) (yas-triggers-in-field t)) (yas-with-snippet-dirs '((".emacs.d/snippets" ("emacs-lisp-mode" ("foo" . "\ -# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook t)))) +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook t)))) # -- FOO ${1:f1} ${2:f2}") ("sub" . "\ -# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook 'sub)))) +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'sub)))) # -- SUB")))) (yas-reload-all) @@ -619,22 +736,21 @@ SUB")))) (yas-minor-mode +1) (insert "foo") (ert-simulate-command '(yas-expand)) - (should-not yas--ran-exit-hook) + (should-not yas-tests--ran-exit-hook) (yas-mock-insert "sub") (ert-simulate-command '(yas-expand)) (ert-simulate-command '(yas-next-field)) - (should-not yas--ran-exit-hook) + (should-not yas-tests--ran-exit-hook) (ert-simulate-command '(yas-next-field)) - (should (eq yas--ran-exit-hook t))))))) + (should (eq yas-tests--ran-exit-hook t))))))) (ert-deftest snippet-exit-hooks-bindings () "Check that `yas-after-exit-snippet-hook' is handled correctly in the case of a buffer-local variable and being overwritten by the expand-env field." - (defvar yas--ran-exit-hook) (with-temp-buffer (yas-saving-variables - (let ((yas--ran-exit-hook nil) + (let ((yas-tests--ran-exit-hook nil) (yas-triggers-in-field t) (yas-after-exit-snippet-hook nil)) (yas-with-snippet-dirs @@ -642,21 +758,21 @@ the expand-env field." ("emacs-lisp-mode" ("foo" . "foobar\n") ("baz" . "\ -# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook 'letenv)))) +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'letenv)))) # -- foobaz\n")))) (yas-reload-all) (emacs-lisp-mode) (yas-minor-mode +1) - (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global yas--ran-exit-hook))) - (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local yas--ran-exit-hook)) nil t) + (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global yas-tests--ran-exit-hook))) + (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local yas-tests--ran-exit-hook)) nil t) (insert "baz") (ert-simulate-command '(yas-expand)) - (should (eq 'letenv yas--ran-exit-hook)) + (should (eq 'letenv yas-tests--ran-exit-hook)) (insert "foo") (ert-simulate-command '(yas-expand)) - (should (eq 'global (nth 0 yas--ran-exit-hook))) - (should (eq 'local (nth 1 yas--ran-exit-hook)))))))) + (should (eq 'global (nth 0 yas-tests--ran-exit-hook))) + (should (eq 'local (nth 1 yas-tests--ran-exit-hook)))))))) (ert-deftest snippet-mirror-bindings () "Check that variables defined with the expand-env field are @@ -784,6 +900,7 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \ ;;; (defmacro yas-with-overriden-buffer-list (&rest body) + (declare (debug t)) (let ((saved-sym (make-symbol "yas--buffer-list"))) `(let ((,saved-sym (symbol-function 'buffer-list))) (cl-letf (((symbol-function 'buffer-list) @@ -796,6 +913,7 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \ (defmacro yas-with-some-interesting-snippet-dirs (&rest body) + (declare (debug t)) `(yas-saving-variables (yas-with-overriden-buffer-list (yas-with-snippet-dirs @@ -1259,128 +1377,6 @@ add the snippets associated with the given mode." (yas-should-expand '(("car" . "(car )"))))))) -;;; Helpers -;;; -(defun yas-should-expand (keys-and-expansions) - (dolist (key-and-expansion keys-and-expansions) - (yas-exit-all-snippets) - (erase-buffer) - (insert (car key-and-expansion)) - (let ((yas-fallback-behavior nil)) - (ert-simulate-command '(yas-expand))) - (unless (string= (yas--buffer-contents) (cdr key-and-expansion)) - (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\"" - (car key-and-expansion) - (cdr key-and-expansion) - (yas--buffer-contents))))) - (yas-exit-all-snippets)) - -(defun yas--collect-menu-items (menu-keymap) - (let ((yas--menu-items ())) - (map-keymap (lambda (_binding definition) - (when (eq (car-safe definition) 'menu-item) - (push definition yas--menu-items))) - menu-keymap) - yas--menu-items)) - -(defun yas-should-not-expand (keys) - (dolist (key keys) - (yas-exit-all-snippets) - (erase-buffer) - (insert key) - (let ((yas-fallback-behavior nil)) - (ert-simulate-command '(yas-expand))) - (unless (string= (yas--buffer-contents) key) - (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\"" - key - (yas--buffer-contents)))))) - -(defun yas-mock-insert (string) - (dotimes (i (length string)) - (let ((last-command-event (aref string i))) - (ert-simulate-command '(self-insert-command 1))))) - -(defun yas-mock-yank (string) - (let ((interprogram-paste-function (lambda () string))) - (ert-simulate-command '(yank nil)))) - -(defun yas--key-binding (key) - "Like `key-binding', but override `this-command-keys-vector'. -This lets `yas--maybe-expand-from-keymap-filter' work as expected." - (cl-letf (((symbol-function 'this-command-keys-vector) - (lambda () (cl-coerce key 'vector)))) - (key-binding key))) - -(defun yas-make-file-or-dirs (ass) - (let ((file-or-dir-name (car ass)) - (content (cdr ass))) - (cond ((listp content) - (make-directory file-or-dir-name 'parents) - (let ((default-directory (concat default-directory "/" file-or-dir-name))) - (mapc #'yas-make-file-or-dirs content))) - ((stringp content) - (with-temp-buffer - (insert content) - (write-region nil nil file-or-dir-name nil 'nomessage))) - (t - (message "[yas] oops don't know this content"))))) - - -(defun yas-variables () - (let ((syms)) - (mapatoms #'(lambda (sym) - (if (and (string-match "^yas-[^/]" (symbol-name sym)) - (boundp sym)) - (push sym syms)))) - syms)) - -(defun yas-call-with-saving-variables (fn) - (let* ((vars (yas-variables)) - (saved-values (mapcar #'symbol-value vars))) - (unwind-protect - (funcall fn) - (cl-loop for var in vars - for saved in saved-values - do (set var saved))))) - -(defun yas-call-with-snippet-dirs (dirs fn) - (let* ((default-directory (make-temp-file "yasnippet-fixture" t)) - (yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs))) - (with-temp-message "" - (unwind-protect - (progn - (mapc #'yas-make-file-or-dirs dirs) - (funcall fn)) - (when (>= emacs-major-version 24) - (delete-directory default-directory 'recursive)))))) - -;;; Older emacsen -;;; -(unless (fboundp 'special-mode) - ;; FIXME: Why provide this default definition here?!? - (defalias 'special-mode 'fundamental)) - -(unless (fboundp 'string-suffix-p) - ;; introduced in Emacs 24.4 - (defun string-suffix-p (suffix string &optional ignore-case) - "Return non-nil if SUFFIX is a suffix of STRING. -If IGNORE-CASE is non-nil, the comparison is done without paying -attention to case differences." - (let ((start-pos (- (length string) (length suffix)))) - (and (>= start-pos 0) - (eq t (compare-strings suffix nil nil - string start-pos nil ignore-case)))))) - -;;; btw to test this in emacs22 mac osx: -;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el -;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el -;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert - - -(put 'yas-saving-variables 'edebug-form-spec t) -(put 'yas-with-snippet-dirs 'edebug-form-spec t) -(put 'yas-with-overriden-buffer-list 'edebug-form-spec t) -(put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t) (provide 'yasnippet-tests) ;; Local Variables: diff --git a/yasnippet.el b/yasnippet.el index dd2d051..6e805c8 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -132,6 +132,7 @@ ;;; Code: (require 'cl-lib) +(declare-function cl-progv-after "cl-extra") ; Needed for 23.4. (require 'easymenu) (require 'help-mode) @@ -3029,11 +3030,16 @@ DEPTH is a count of how many nested mirrors can affect this mirror" (defmacro yas--letenv (env &rest body) "Evaluate BODY with bindings from ENV. -ENV is a list of elements with the form (VAR FORM)." +ENV is a lisp expression that evaluates to list of elements with +the form (VAR FORM), where VAR is a symbol and FORM is a lisp +expression that evaluates to its value." (declare (debug (form body)) (indent 1)) - (let ((envvar (make-symbol "env"))) + (let ((envvar (make-symbol "envvar"))) `(let ((,envvar ,env)) - (cl-progv (mapcar #'car ,envvar) (mapcar #'cadr ,envvar) . ,body)))) + (cl-progv + (mapcar #'car ,envvar) + (mapcar (lambda (v-f) (eval (cadr v-f))) ,envvar) + ,@body)))) (defun yas--snippet-map-markers (fun snippet) "Apply FUN to all marker (sub)fields in SNIPPET.