diff --git a/haskell-cabal.el b/haskell-cabal.el index 5416ea643..7c27f70d6 100644 --- a/haskell-cabal.el +++ b/haskell-cabal.el @@ -51,6 +51,11 @@ (require 'cl-lib) (require 'haskell-utils) +(defcustom haskell-hasktags-path "hasktags" + "Path to `hasktags' executable." + :group 'haskell + :type 'string) + (defconst haskell-cabal-general-fields ;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields") '("name" "version" "cabal-version" "license" "license-file" "copyright" @@ -1096,7 +1101,7 @@ recursively avoiding visiting unnecessary heavy directories like .git, .svn, _darcs and build directories created by cabal-install, stack, etc and passes list of found files to Hasktags." (if (eq system-type 'windows-nt) - (format "hasktags --output=\"%s\\TAGS\" -x -e \"%s\"" dir dir) + (format "%s --output=\"%s\\TAGS\" -x -e \"%s\"" haskell-hasktags-path dir dir) (format "cd %s && %s | %s" dir (concat "find . " @@ -1116,7 +1121,7 @@ cabal-install, stack, etc and passes list of found files to Hasktags." "-name '#*' " "-or -name '.*' " "\\) -print0") - "xargs -0 hasktags -e -x"))) + (format "xargs -0 %s -e -x" haskell-hasktags-path)))) (provide 'haskell-cabal) ;;; haskell-cabal.el ends here diff --git a/tests/haskell-exec-tests.el b/tests/haskell-exec-tests.el new file mode 100644 index 000000000..08a5d61a8 --- /dev/null +++ b/tests/haskell-exec-tests.el @@ -0,0 +1,23 @@ +;; haskell-exec-tests.el --- -*- lexical-binding: t; -*- + +(require 'ert) +(require 'haskell-test-utils) + +(defvar haskell-example-script "echo") + +(defun haskell-exec-test-output-argv-and-copy-stdin () + (let (line) + (while argv + (message-stdout "%s" (pop argv))) + (while (setq line (read-stdin)) + (message-stdout "%s" line)))) + +(ert-deftest haskell-exec-subst-script () + (with-script-path haskell-example-script haskell-exec-test-output-argv-and-copy-stdin + (with-temp-buffer + (insert "line1\n") + (insert "line2\n") + (insert "line3-no-newline") + (call-process-region (point-min) (point-max) haskell-example-script t t nil "-a" "--arg1" "/zonk" "filename.el") + (should (equal "-a\n--arg1\n/zonk\nfilename.el\nline1\nline2\nline3-no-newline\n" + (buffer-substring-no-properties (point-min) (point-max))))))) diff --git a/tests/haskell-mode-tests.el b/tests/haskell-mode-tests.el index 9b9cdd446..c206cb09a 100644 --- a/tests/haskell-mode-tests.el +++ b/tests/haskell-mode-tests.el @@ -19,6 +19,7 @@ (require 'ert) (require 'haskell-mode) +(require 'haskell-test-utils) (ert-deftest haskell-mode-ident-at-point-empty () (should (with-temp-buffer @@ -533,4 +534,26 @@ moves over sexps." (haskell-forward-sexp -4) (eq (point) 3)))) +(defun haskell-generate-tags-test-helper () + (with-current-buffer (find-file-noselect "TAGS-test-format") + (erase-buffer) + (dolist (arg (sort argv #'string<)) + (insert arg "\n")) + (save-buffer) + (kill-buffer))) + +(ert-deftest haskell-generate-tags () + (with-temp-dir-structure + (("xxx.cabal" . "") + ("T1.hs" . "i1 :: Int") + ("src" . (("T2.hs" . "i2 :: Int"))) + (".git" . (("Tx.hs" . "should_not_see_me :: Int")))) + (with-script-path + haskell-hasktags-path + haskell-generate-tags-test-helper + (haskell-mode-generate-tags) + (with-current-buffer (find-file-noselect "TAGS-test-format") + (should (equal "-e\n-x\n./T1.hs\n./src/T2.hs\n" + (buffer-substring (point-min) (point-max)))))))) + (provide 'haskell-mode-tests) diff --git a/tests/haskell-test-utils.el b/tests/haskell-test-utils.el index 926b4b134..2adec8a16 100644 --- a/tests/haskell-test-utils.el +++ b/tests/haskell-test-utils.el @@ -130,5 +130,104 @@ if all of its characters have syntax and face. See (search-forward string)) (check-syntax-and-face-match-range (match-beginning 0) (match-end 0) syntax face))))) + +(defun message-stderr (&rest args) + "Output a message to stderr in batch mode. + +ARGS are formatted according to `format'. A newline is automatically appended." + (apply #'message args)) + +(defun message-stdout (&rest args) + "Output a message to stdout in batch mode. + +ARGS are formatted according to `format'. A newline is automatically appended." + (princ (apply #'format args)) + (terpri)) + +(defun read-stdin () + "Read a line from stdin in batch mode. + +A line is read and returned. End of input is signalled by +nil. Newlines are stripped. Last line is returned even if there +is no final newline." + (condition-case nil + (read-from-minibuffer "") + (error nil))) + +(defmacro with-script-path (cmdvar func &rest body) + "Temporarily substitute a command line executable. + +Creates a temporary executable script and sets CMDVAR to point to +the script. When the script is run it spawns another Emacs +instance and executes function FUNC. Substitution is in effect +throughout BODY. + +In FUNC variable `argv' is a list of all arguments that the +script received when invoked. If the FUNC returns a number then +it will be used as exit code for `kill-emacs' function, otherwise +0 will be used." + (declare (indent 2) (debug t)) + `(let ((,cmdvar (make-temp-file "haskell-mode-tests-script"))) + (with-current-buffer (find-file-noselect ,cmdvar) + + (insert "#!/bin/sh\n") + (insert "\":\"; exec \"" invocation-directory invocation-name "\" -Q --batch -l \"$0\" -- \"$@\"\n") + (insert "(setq debug-on-error t)\n") + (insert "(pop argv)\n") + (insert "(setq load-path '" (format "%S" load-path) ")\n") + (insert "(load \"" (symbol-file ',func) "\" nil t)\n") + (insert "(let ((return-value (" (symbol-name ',func) ")))\n") + (insert " (if (numberp return-value)\n") + (insert " (kill-emacs return-value)\n") + (insert " (kill-emacs 0)))\n") + (basic-save-buffer) + (kill-buffer)) + (set-file-modes ,cmdvar (string-to-number "700" 8)) + (unwind-protect + (progn ,@body) + (delete-file ,cmdvar)))) + +(defun create-directory-structure (entries) + (dolist (entry entries) + (cond + ((stringp (cdr entry)) + (with-current-buffer (find-file-noselect (car entry)) + (insert (cdr entry)) + (basic-save-buffer) + (kill-buffer))) + ((bufferp (cdr entry)) + (with-current-buffer (find-file-noselect (car entry)) + (insert (with-current-buffer (cdr entry) + (buffer-substring-no-properties (point-min) (point-max)))) + (basic-save-buffer) + (kill-buffer))) + (t + (make-directory (car entry)) + (let ((default-directory (concat default-directory (car entry) "/"))) + (create-directory-structure (cdr entry))))))) + +(defmacro with-temp-dir-structure (entries &rest body) + "Create a temporary directory structure. + +ENTRIES is an alist with file or directory names as keys. If +associated value is a string or buffer then a file is created, if +value is an association list then a directory is created +recursively. + +Throughout BODY `default-directory' is set to the root of the +hierarchy created. + +Whole hierarchy is removed after BODY finishes and value of +`default-directory' is restored." + (declare (indent 2) (debug t)) + `(let ((tmpdir (make-temp-name "haskell-mode-test-dir"))) + (make-directory tmpdir) + (unwind-protect + (let ((default-directory (concat default-directory tmpdir "/"))) + (create-directory-structure ',entries) + ,@body) + (delete-directory tmpdir t)))) + + (provide 'haskell-test-utils) ;;; haskell-test-utils.el ends here