From f57ce5abc43c766a63ec89e2ce6eb4a617943fe7 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Tue, 29 Mar 2016 09:06:31 +0200 Subject: [PATCH 01/11] run hs2hs on .hsc-files before loading (#1012) Disable by setting haskell-process-do-hsc2hs to nil. Tests only work interactively, TODO --- haskell.el | 51 +++++++++++++++++++++++---- tests/haskell-hsc2hs-tests.el | 65 +++++++++++++++++++++++++++++++++++ 2 files changed, 110 insertions(+), 6 deletions(-) create mode 100644 tests/haskell-hsc2hs-tests.el diff --git a/haskell.el b/haskell.el index a3dc618b2..5d0abe087 100644 --- a/haskell.el +++ b/haskell.el @@ -398,18 +398,57 @@ Give optional NEXT-P parameter to override value of (buffer (haskell-session-interactive-buffer session))) (pop-to-buffer buffer))) + +(defun haskell--file-name-to-load-string (file-name) + "Create a GHCi repl load statement from FILE-NAME." + (format "load \"%s\"" (replace-regexp-in-string + "\"" + "\\\\\"" + file-name))) + + +(defvar haskell-process-do-hsc2hs t + "If non-nil, run hsc2hs first on source files ending in .hsc.") + +(defun haskell--process-hsc2hs-load () + "Run hsc2hs and load the resulting file (unless hsc2hs failed)." + ;; assumes lexical-binding + (let* ((hwin (get-buffer-window (current-buffer))) + (hs (replace-regexp-in-string "\\.hsc\\'" ".hs" (buffer-file-name))) + (cbuf (compilation-start (format "hsc2hs %s" (buffer-file-name)) + nil + (lambda (_) "*hsc2hs*"))) + (proc (get-buffer-process cbuf))) + (set-process-sentinel proc (lambda (p m) + (haskell--hsc2hs-sentinel hs hwin p m))))) + +(defun haskell--hsc2hs-sentinel (hs hwin proc msg) + "Load compiled .hs (and hide compilation) on hsc2hs success. +Argument HS is the generated hsc source file name; HWIN is the +window of the hsc source file; PROC is the hsc2hs process (MSG is +currently ignored)." + (when (and (memq (process-status proc) '(exit signal)) + (equal 0 (process-exit-status proc))) + (let ((cbuf (process-buffer proc))) + (select-window (get-buffer-window cbuf)) + (bury-buffer) + (select-window hwin) + (haskell-process-file-loadish (haskell--file-name-to-load-string hs) + nil + (window-buffer hwin))))) + ;;;###autoload (defun haskell-process-load-file () "Load the current buffer file." (interactive) (save-buffer) (haskell-interactive-mode-reset-error (haskell-session)) - (haskell-process-file-loadish (format "load \"%s\"" (replace-regexp-in-string - "\"" - "\\\\\"" - (buffer-file-name))) - nil - (current-buffer))) + (if (and haskell-process-do-hsc2hs + (equal "hsc" (file-name-extension (buffer-file-name)))) + (haskell--process-hsc2hs-load) + (haskell-process-file-loadish (haskell--file-name-to-load-string (buffer-file-name)) + nil + (current-buffer)))) ;;;###autoload (defun haskell-process-reload () diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el new file mode 100644 index 000000000..75dc2b7c8 --- /dev/null +++ b/tests/haskell-hsc2hs-tests.el @@ -0,0 +1,65 @@ +;; haskell-hsc2hs-tests.el --- -*- lexical-binding: t; -*- + +(require 'ert) +(require 'haskell) +(require 'haskell-test-utils) + + +(defvar default-hsc "{-# LANGUAGE CPP #-} +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Hsc2hsTest where + +import Foreign +import Foreign.C.String +import Foreign.C.Types + +#include + +newtype NUMBERS = NUMBERS { unNUMBERS :: CInt } + deriving (Eq,Show) + +#{enum NUMBERS, NUMBERS + , rand_max = RAND_MAX + } +") + +(defmacro with-hsc2hs (contents &rest body) + (declare (debug t) (indent 1)) + `(with-temp-switch-to-buffer + (let ((f (make-temp-file "haskell-hsc2hs-tests.el" nil ".hsc"))) + (insert ,contents) + (write-file f) + (haskell-mode) + (haskell-process-load-file) + (let ((proc (get-buffer-process "*hsc2hs*"))) + (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? + (sit-for 0.5)) + ,@body + (delete-file f))))) + +(ert-deftest hsc2hs-errors () + (let ((error-hsc (concat default-hsc + "newtype FOO = FOO { unFOO :: CInt } deriving (Eq,Show)\n" + "#{enum FOO, FOO , a_typo = A_TYPO }\n"))) + (with-hsc2hs error-hsc + (with-current-buffer "*hsc2hs*" + (goto-char (point-min)) + (when (re-search-forward "A_TYPO" nil 'noerror) + (goto-char (match-beginning 0))) + (should (looking-at-p "A_TYPO. undeclared")))))) + +(ert-deftest hsc2hs-compile-and-load () + (with-hsc2hs default-hsc + (with-current-buffer "*haskell*" ; TODO: Where is this defined? + (goto-char (point-max)) + (insert ":t unNUMBERS rand_max") + (goto-char (point-max)) + (haskell-interactive-handle-expr) + (sit-for 1.0) ; TODO: can we wait until the prompt appears, with a timeout? + (forward-line -1) + (should (looking-at-p "unNUMBERS rand_max :: CInt"))))) + +;; haskell-hsc2hs-tests.el ends here + From d6a8eea4a84fbfe4bfda2dbb3c613c494420d3f5 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Tue, 29 Mar 2016 11:03:33 +0200 Subject: [PATCH 02/11] uncustomise haskell-process-do-hsc2hs cf. https://github.com/haskell/haskell-mode/wiki/Customizable-variables --- haskell.el | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/haskell.el b/haskell.el index 5d0abe087..7259373d0 100644 --- a/haskell.el +++ b/haskell.el @@ -406,10 +406,6 @@ Give optional NEXT-P parameter to override value of "\\\\\"" file-name))) - -(defvar haskell-process-do-hsc2hs t - "If non-nil, run hsc2hs first on source files ending in .hsc.") - (defun haskell--process-hsc2hs-load () "Run hsc2hs and load the resulting file (unless hsc2hs failed)." ;; assumes lexical-binding @@ -443,8 +439,7 @@ currently ignored)." (interactive) (save-buffer) (haskell-interactive-mode-reset-error (haskell-session)) - (if (and haskell-process-do-hsc2hs - (equal "hsc" (file-name-extension (buffer-file-name)))) + (if (equal "hsc" (file-name-extension (buffer-file-name))) (haskell--process-hsc2hs-load) (haskell-process-file-loadish (haskell--file-name-to-load-string (buffer-file-name)) nil From de7dd07da205dc8528e5e89f3703d49c5fc3e243 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Tue, 29 Mar 2016 11:10:55 +0200 Subject: [PATCH 03/11] defvar haskell-process-path-hsc2hs for test-mocking --- haskell.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/haskell.el b/haskell.el index 7259373d0..2ce647f27 100644 --- a/haskell.el +++ b/haskell.el @@ -406,12 +406,18 @@ Give optional NEXT-P parameter to override value of "\\\\\"" file-name))) +(defvar haskell-process-path-hsc2hs "hsc2hs" + "The path for running hsc2hs. +This should be a single string.") + (defun haskell--process-hsc2hs-load () "Run hsc2hs and load the resulting file (unless hsc2hs failed)." ;; assumes lexical-binding (let* ((hwin (get-buffer-window (current-buffer))) (hs (replace-regexp-in-string "\\.hsc\\'" ".hs" (buffer-file-name))) - (cbuf (compilation-start (format "hsc2hs %s" (buffer-file-name)) + (cbuf (compilation-start (format "%s %s" + haskell-process-path-hsc2hs + (buffer-file-name)) nil (lambda (_) "*hsc2hs*"))) (proc (get-buffer-process cbuf))) From 91800f06972b7b7ef8365128b15de2723923c478 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 10:23:13 +0200 Subject: [PATCH 04/11] use hsc2hs script for testing if no real hsc2hs --- tests/haskell-hsc2hs-tests.el | 11 ++++++++++- tests/hsc2hs.sh | 29 +++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 1 deletion(-) create mode 100755 tests/hsc2hs.sh diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index 75dc2b7c8..0fbe184ac 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -26,13 +26,22 @@ newtype NUMBERS = NUMBERS { unNUMBERS :: CInt } ") (defmacro with-hsc2hs (contents &rest body) + "Load CONTENTS as a .hsc, then run BODY after it's loaded into REPL. +Uses `haskell-process-path-hsc2hs' if executable exists, +otherwise fake script hsc2hs.sh from this directory." (declare (debug t) (indent 1)) `(with-temp-switch-to-buffer (let ((f (make-temp-file "haskell-hsc2hs-tests.el" nil ".hsc"))) (insert ,contents) (write-file f) (haskell-mode) - (haskell-process-load-file) + (let* ((dir (file-name-directory + (find-lisp-object-file-name 'with-hsc2hs nil))) + (haskell-process-path-hsc2hs + (if (file-executable-p (executable-find haskell-process-path-hsc2hs)) + haskell-process-path-hsc2hs + (format "%s/%s" dir "hsc2hs.sh")))) + (haskell-process-load-file)) (let ((proc (get-buffer-process "*hsc2hs*"))) (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? (sit-for 0.5)) diff --git a/tests/hsc2hs.sh b/tests/hsc2hs.sh new file mode 100755 index 000000000..0378831b8 --- /dev/null +++ b/tests/hsc2hs.sh @@ -0,0 +1,29 @@ +#!/bin/sh + +# Very stupid fake hsc2hs specific to our tests + +awk -v hs="${1%c}" ' +/^#{/ { + skip = 1 +} +!skip && !/^#include/ { + lines = lines $0"\n" +} +/}/ { + skip = 0 +} + +/A_TYPO/ { + print FILENAME":"NR":58: error: ‘A_TYPO’ undeclared (first use in this function)" >"/dev/stderr" + lines="" + exit(1) +} + +END { + if(lines) { + lines = lines "rand_max :: NUMBERS\n" + lines = lines "rand_max = NUMBERS 2147483647\n" + print lines > hs + } +} +' "$1" From 31bc866279464b31fafcccae1b7776b233526c64 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 10:28:21 +0200 Subject: [PATCH 05/11] avoid a (file-executable-p nil) if no hsc2hs --- tests/haskell-hsc2hs-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index 0fbe184ac..33d5e0207 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -37,8 +37,9 @@ otherwise fake script hsc2hs.sh from this directory." (haskell-mode) (let* ((dir (file-name-directory (find-lisp-object-file-name 'with-hsc2hs nil))) + (existing-hsc2hs (executable-find haskell-process-path-hsc2hs)) (haskell-process-path-hsc2hs - (if (file-executable-p (executable-find haskell-process-path-hsc2hs)) + (if (and existing-hsc2hs (file-executable-p existing-hsc2hs)) haskell-process-path-hsc2hs (format "%s/%s" dir "hsc2hs.sh")))) (haskell-process-load-file)) From 4dc29026b75f1d2be14c0c5a3e3dbe6d1dbaed5d Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 13:21:49 +0200 Subject: [PATCH 06/11] always use hsc2hs.sh --- tests/haskell-hsc2hs-tests.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index 33d5e0207..58de0df04 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -37,11 +37,7 @@ otherwise fake script hsc2hs.sh from this directory." (haskell-mode) (let* ((dir (file-name-directory (find-lisp-object-file-name 'with-hsc2hs nil))) - (existing-hsc2hs (executable-find haskell-process-path-hsc2hs)) - (haskell-process-path-hsc2hs - (if (and existing-hsc2hs (file-executable-p existing-hsc2hs)) - haskell-process-path-hsc2hs - (format "%s/%s" dir "hsc2hs.sh")))) + (haskell-process-path-hsc2hs (format "%s/%s" dir "hsc2hs.sh"))) (haskell-process-load-file)) (let ((proc (get-buffer-process "*hsc2hs*"))) (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? From 914175e4b3ea9d726575a1649e79c3a10f1796e4 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 13:22:33 +0200 Subject: [PATCH 07/11] =?UTF-8?q?defvar=E2=86=92defcustom=20for=20haskell-?= =?UTF-8?q?process-path-hsc2hs?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- haskell.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/haskell.el b/haskell.el index 2ce647f27..1352fd0fb 100644 --- a/haskell.el +++ b/haskell.el @@ -406,9 +406,12 @@ Give optional NEXT-P parameter to override value of "\\\\\"" file-name))) -(defvar haskell-process-path-hsc2hs "hsc2hs" +(defcustom haskell-process-path-hsc2hs + "hsc2hs" "The path for running hsc2hs. -This should be a single string.") +This should be a single string." + :group 'haskell-interactive + :type 'string) (defun haskell--process-hsc2hs-load () "Run hsc2hs and load the resulting file (unless hsc2hs failed)." From 15a0471cbd4a74ee09cbe041c6a810c98aca30ae Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 13:31:48 +0200 Subject: [PATCH 08/11] make the whole fake-hsc2hs script run in awk and avoid a process --- tests/{hsc2hs.sh => fake-hsc2hs} | 16 ++++++++++++---- tests/haskell-hsc2hs-tests.el | 5 ++--- 2 files changed, 14 insertions(+), 7 deletions(-) rename tests/{hsc2hs.sh => fake-hsc2hs} (62%) diff --git a/tests/hsc2hs.sh b/tests/fake-hsc2hs similarity index 62% rename from tests/hsc2hs.sh rename to tests/fake-hsc2hs index 0378831b8..cf0b399a7 100755 --- a/tests/hsc2hs.sh +++ b/tests/fake-hsc2hs @@ -1,14 +1,15 @@ -#!/bin/sh +#!/usr/bin/awk -f # Very stupid fake hsc2hs specific to our tests -awk -v hs="${1%c}" ' /^#{/ { skip = 1 } + !skip && !/^#include/ { lines = lines $0"\n" } + /}/ { skip = 0 } @@ -23,7 +24,14 @@ END { if(lines) { lines = lines "rand_max :: NUMBERS\n" lines = lines "rand_max = NUMBERS 2147483647\n" - print lines > hs + hs = FILENAME + sub(/hsc$/, "hs", hs) + if(FILENAME==hs) { + print FILENAME" doesn't seem to end in .hsc">"/dev/stderr" + exit(1) + } + else { + print lines > hs + } } } -' "$1" diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index 58de0df04..bc580085a 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -27,8 +27,7 @@ newtype NUMBERS = NUMBERS { unNUMBERS :: CInt } (defmacro with-hsc2hs (contents &rest body) "Load CONTENTS as a .hsc, then run BODY after it's loaded into REPL. -Uses `haskell-process-path-hsc2hs' if executable exists, -otherwise fake script hsc2hs.sh from this directory." +Uses fake hsc2hs script from this directory." (declare (debug t) (indent 1)) `(with-temp-switch-to-buffer (let ((f (make-temp-file "haskell-hsc2hs-tests.el" nil ".hsc"))) @@ -37,7 +36,7 @@ otherwise fake script hsc2hs.sh from this directory." (haskell-mode) (let* ((dir (file-name-directory (find-lisp-object-file-name 'with-hsc2hs nil))) - (haskell-process-path-hsc2hs (format "%s/%s" dir "hsc2hs.sh"))) + (haskell-process-path-hsc2hs (format "%s/%s" dir "fake-hsc2hs"))) (haskell-process-load-file)) (let ((proc (get-buffer-process "*hsc2hs*"))) (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? From 68a70c68fe65871ab5f76f0895a891cb7b0d214b Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Wed, 30 Mar 2016 13:33:12 +0200 Subject: [PATCH 09/11] clean up the generated .hs as well as the .hsc --- tests/haskell-hsc2hs-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index bc580085a..2a2b77ae0 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -42,7 +42,8 @@ Uses fake hsc2hs script from this directory." (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? (sit-for 0.5)) ,@body - (delete-file f))))) + (delete-file f) + (delete-file (replace-regexp-in-string "\\.hsc\\'" ".hs" f)))))) (ert-deftest hsc2hs-errors () (let ((error-hsc (concat default-hsc From 44dac285badca7151b978bb26a8c20e5cdff1009 Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Thu, 7 Apr 2016 10:29:40 +0200 Subject: [PATCH 10/11] rm fake-hsc2hs; inlined as var and put in a temp script uses new macro `with-script-path' --- tests/fake-hsc2hs | 37 -------------------- tests/haskell-hsc2hs-tests.el | 64 ++++++++++++++++++++++++++++------- tests/haskell-test-utils.el | 19 +++++++++++ 3 files changed, 71 insertions(+), 49 deletions(-) delete mode 100755 tests/fake-hsc2hs diff --git a/tests/fake-hsc2hs b/tests/fake-hsc2hs deleted file mode 100755 index cf0b399a7..000000000 --- a/tests/fake-hsc2hs +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/awk -f - -# Very stupid fake hsc2hs specific to our tests - -/^#{/ { - skip = 1 -} - -!skip && !/^#include/ { - lines = lines $0"\n" -} - -/}/ { - skip = 0 -} - -/A_TYPO/ { - print FILENAME":"NR":58: error: ‘A_TYPO’ undeclared (first use in this function)" >"/dev/stderr" - lines="" - exit(1) -} - -END { - if(lines) { - lines = lines "rand_max :: NUMBERS\n" - lines = lines "rand_max = NUMBERS 2147483647\n" - hs = FILENAME - sub(/hsc$/, "hs", hs) - if(FILENAME==hs) { - print FILENAME" doesn't seem to end in .hsc">"/dev/stderr" - exit(1) - } - else { - print lines > hs - } - } -} diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index 2a2b77ae0..c7f3da51d 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -25,25 +25,64 @@ newtype NUMBERS = NUMBERS { unNUMBERS :: CInt } } ") +(defvar fake-hsc2hs "#!/usr/bin/awk -f + +/^#{/ { + skip = 1 +} + +!skip && !/^#include/ { + lines = lines $0\"\\n\" +} + +/}/ { + skip = 0 +} + +/A_TYPO/ { + print FILENAME\":\"NR\":58: error: ‘A_TYPO’ undeclared (first use in this function)\" >\"/dev/stderr\" + lines=\"\" + exit(1) +} + +END { + if(lines) { + lines = lines \"rand_max :: NUMBERS\\n\" + lines = lines \"rand_max = NUMBERS 2147483647\\n\" + hs = FILENAME + sub(/hsc$/, \"hs\", hs) + if(FILENAME==hs) { + print FILENAME\" doesn't seem to end in .hsc\">\"/dev/stderr\" + exit(1) + } + else { + print lines > hs + } + } +} +" "Very stupid fake hsc2hs specific to our tests") + + (defmacro with-hsc2hs (contents &rest body) "Load CONTENTS as a .hsc, then run BODY after it's loaded into REPL. Uses fake hsc2hs script from this directory." (declare (debug t) (indent 1)) `(with-temp-switch-to-buffer - (let ((f (make-temp-file "haskell-hsc2hs-tests.el" nil ".hsc"))) + (let* ((hsc (make-temp-file "haskell-hsc2hs-tests.el" nil ".hsc")) + (hs (replace-regexp-in-string "\\.hsc\\'" ".hs" hsc))) (insert ,contents) - (write-file f) + (write-file hsc) (haskell-mode) - (let* ((dir (file-name-directory - (find-lisp-object-file-name 'with-hsc2hs nil))) - (haskell-process-path-hsc2hs (format "%s/%s" dir "fake-hsc2hs"))) - (haskell-process-load-file)) - (let ((proc (get-buffer-process "*hsc2hs*"))) - (while (eq (process-status proc) 'run) ; TODO: is there no built-in way to block-wait on a process? - (sit-for 0.5)) - ,@body - (delete-file f) - (delete-file (replace-regexp-in-string "\\.hsc\\'" ".hs" f)))))) + (with-script-path haskell-process-path-hsc2hs fake-hsc2hs 'keep + (haskell-process-load-file) + (let ((proc (get-buffer-process "*hsc2hs*"))) + (while (and proc (eq (process-status proc) 'run)) ; TODO: is there no built-in way to block-wait on a process? + (sit-for 0.5)) + ,@body) + (delete-file haskell-process-path-hsc2hs)) + (delete-file hsc) + (when (file-exists-p hs) + (delete-file hs))))) (ert-deftest hsc2hs-errors () (let ((error-hsc (concat default-hsc @@ -57,6 +96,7 @@ Uses fake hsc2hs script from this directory." (should (looking-at-p "A_TYPO. undeclared")))))) (ert-deftest hsc2hs-compile-and-load () + (kill-buffer "*haskell*") (with-hsc2hs default-hsc (with-current-buffer "*haskell*" ; TODO: Where is this defined? (goto-char (point-max)) diff --git a/tests/haskell-test-utils.el b/tests/haskell-test-utils.el index 58ff67f93..e4e4f8f66 100644 --- a/tests/haskell-test-utils.el +++ b/tests/haskell-test-utils.el @@ -99,6 +99,25 @@ after a test as this aids interactive debugging." (funcall ,mode) ,@body))) +(defmacro with-script-path (path script keep &rest body) + "Run a script using a temporary file. + +Creates an executable temp file and sets the PATH variable to +point to that, and inserts SCRIPT in the file and adds the +executable bit. Unless KEEP is non-nil, the script is deleted +after BODY has run. The variable PATH is available for use in +BODY." + (declare (indent 3) (debug t)) + `(let ((,path (make-temp-file "haskell-mode-tests-script"))) + (with-current-buffer (find-file-noselect ,path) + (insert ,script) + (save-buffer) + (kill-buffer)) + (set-file-modes ,path (string-to-number "700" 8)) + (prog1 (progn ,@body) + (unless ,keep + (delete-file ,path))))) + (defun check-properties (lines-or-contents props &optional mode) "Check if syntax properties and font-lock properties as set properly. From 34892009f50aec6e75f7bee1dfe5ffa54478a92b Mon Sep 17 00:00:00 2001 From: Kevin Brubeck Unhammer Date: Thu, 7 Apr 2016 11:35:59 +0200 Subject: [PATCH 11/11] wip: fake-ghci (not working yet) process seems to just die, although it works fine interactively on the command line --- tests/haskell-hsc2hs-tests.el | 44 ++++++++++++++++++++++++++--------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/tests/haskell-hsc2hs-tests.el b/tests/haskell-hsc2hs-tests.el index c7f3da51d..6a8a811aa 100644 --- a/tests/haskell-hsc2hs-tests.el +++ b/tests/haskell-hsc2hs-tests.el @@ -25,6 +25,25 @@ newtype NUMBERS = NUMBERS { unNUMBERS :: CInt } } ") +(defvar fake-ghci "#!/usr/bin/awk -f + +BEGIN { + printf \"%s\", \"Your wish is my IO ().\\nChanged directory: /tmp/\\nPrelude> \" + fflush() +} + +/^:t unNUMBERS rand_max$/ { + printf \"%s\", \"unNUMBERS rand_max :: CInt\\nPrelude> \" + fflush() + next +} + +{ + printf \"%s\", \"\\n:\"NR\":1-\"length($0)\": Not in scope: ‘\"$0\"’\\nPrelude> \" + fflush() +} +" "Very stupid fake ghci specific to our tests") + (defvar fake-hsc2hs "#!/usr/bin/awk -f /^#{/ { @@ -85,6 +104,7 @@ Uses fake hsc2hs script from this directory." (delete-file hs))))) (ert-deftest hsc2hs-errors () + (custom-set-variables '(haskell-process-wrapper-function #'identity)) ; altered by some earlier test (let ((error-hsc (concat default-hsc "newtype FOO = FOO { unFOO :: CInt } deriving (Eq,Show)\n" "#{enum FOO, FOO , a_typo = A_TYPO }\n"))) @@ -96,16 +116,18 @@ Uses fake hsc2hs script from this directory." (should (looking-at-p "A_TYPO. undeclared")))))) (ert-deftest hsc2hs-compile-and-load () - (kill-buffer "*haskell*") - (with-hsc2hs default-hsc - (with-current-buffer "*haskell*" ; TODO: Where is this defined? - (goto-char (point-max)) - (insert ":t unNUMBERS rand_max") - (goto-char (point-max)) - (haskell-interactive-handle-expr) - (sit-for 1.0) ; TODO: can we wait until the prompt appears, with a timeout? - (forward-line -1) - (should (looking-at-p "unNUMBERS rand_max :: CInt"))))) + (custom-set-variables '(haskell-process-wrapper-function #'identity)) ; altered by some earlier test + (with-script-path haskell-process-path-ghci fake-ghci 'keep + (custom-set-variables '(haskell-process-args-ghci '("-W" "interactive"))) + (with-hsc2hs default-hsc + (with-current-buffer (haskell-session-interactive-buffer haskell-session) + (goto-char (point-max)) + (insert ":t unNUMBERS rand_max") + (goto-char (point-max)) + (haskell-interactive-handle-expr) + (sit-for 1.0) ; TODO: can we wait until the prompt appears, with a timeout? + (forward-line -1) + (should (looking-at-p "unNUMBERS rand_max :: CInt")))) + (delete-file haskell-process-path-ghci))) ;; haskell-hsc2hs-tests.el ends here -