branch: externals/assess
commit 890906bfcb7b07dde82673a16c312737ec1cde00
Author: Phillip Lord <phillip.l...@newcastle.ac.uk>
Commit: Phillip Lord <phillip.l...@newcastle.ac.uk>
Interface written as single overloaded function.
Previously, sisyphus had lots of independent functions for each type,
but this was starting to get unmanageable. It now has a single function
which does things appropriate for the type of argument passed to it.
---
sisyphus.el | 133 ++++++++++++++++++++------------------------------
test/sisyphus-test.el | 55 ++++++++++++++++-----
2 files changed, 96 insertions(+), 92 deletions(-)
diff --git a/sisyphus.el b/sisyphus.el
index 356f89ac61..60b84be10a 100644
--- a/sisyphus.el
+++ b/sisyphus.el
@@ -62,14 +62,16 @@
;; #+begin_src emacs-lisp
-(defun sisyphus--ert-pp-with-indentation-and-newline (orig object)
- (let ((pp-escape-newlines nil))
- (funcall orig object)))
-
-(advice-add
- 'ert--pp-with-indentation-and-newline
- :around
- #'sisyphus--ert-pp-with-indentation-and-newline)
+(when (= emacs-major-version 24)
+
+ (defun sisyphus--ert-pp-with-indentation-and-newline (orig object)
+ (let ((pp-escape-newlines nil))
+ (funcall orig object)))
+
+ (advice-add
+ 'ert--pp-with-indentation-and-newline
+ :around
+ #'sisyphus--ert-pp-with-indentation-and-newline))
;; #+end_src
@@ -91,7 +93,24 @@
;; How do do this cleanly? Apply patch to ert.el?
-
+;; #+begin_src emacs-lisp
+(defun sisyphus-to-string (x)
+ "Turn X into a string in a type appropriate way."
+ (pcase x
+ ((pred stringp) x)
+ ((pred bufferp) (m-buffer-at-string x))
+ (`(:buffer ,b) (sisyphus-to-string (get-buffer-create b)))
+ (`(:file ,f)
+ (with-temp-buffer
+ (insert-file-contents f)
+ (buffer-string)))
+ ;; error condition
+ (_ (error "Type not recognised"))))
+
+(defun sisyphus-file (f)
+ "Add type data to F marking it as a file."
+ `(:file ,f))
+;; #+end_src
;; *** String Comparision
@@ -150,79 +169,35 @@ print any messages!"
;; We could do a bit more here.
(format "String :%s:%s: are not equal."))
-(defun sisyphus-explain-string= (a b)
- "Compare strings and return an explanation."
- (cond
- ((string= a b)
- t)
- ((executable-find "diff")
- (sisyphus--explainer-diff-string= a b))
- (t
- (sisyphus--explainer-simple-string= a b))))
-
-(put 'string= 'ert-explainer 'sisyphus-explain-string=)
-;; #+end_src
-
-;;; *** String to buffer
-
-;; #+begin_src emacs-lisp
-(defun sisyphus-buffer-string= (buffer string)
- (string=
- (m-buffer-at-string buffer)
- string))
-
-(defun sisyphus-explain-buffer-string= (buffer string)
- (sisyphus-explain-string=
- (m-buffer-at-string buffer)
- string))
+(defun sisyphus= (a b)
+ "Compare A and B to see if they are the same.
-(put 'sisyphus-buffer-string=
- 'ert-explainer
- 'sisyphus-explain-buffer-string=)
-;; #+end_src
-
-
-;; Compare buffer to buffer
-;; #+begin_src emacs-lisp
-(defun sisyphus-buffer= (a b)
+Equality in this sense means compare the contents in a way which
+is appropriate for the type of the two arguments. So, if they are
+strings, the compare strings, if buffers, then compare the buffer
+contents and so on."
(string=
- (m-buffer-at-string a)
- (m-buffer-at-string b)))
-
-(defun sisyphus-explain-buffer= (a b)
- (sisyphus-explain-string=
- (m-buffer-at-string a)
- (m-buffer-at-string b)))
-
-(put 'sisyphus-buffer=
- 'ert-explainer
- 'sisyphus-explain-buffer=)
+ (sisyphus-to-string a)
+ (sisyphus-to-string b)))
+
+(defun sisyphus-explain= (a b)
+ "Compare A and B and return an explanation.
+See `sisyphus=' for more information."
+ (let ((a (sisyphus-to-string a))
+ (b (sisyphus-to-string b)))
+ (cond
+ ((sisyphus= a b)
+ t)
+ ((executable-find "diff")
+ (sisyphus--explainer-diff-string= a b))
+ (t
+ (sisyphus--explainer-simple-string= a b)))))
+
+(put 'sisyphus= 'ert-explainer 'sisyphus-explain=)
;; #+end_src
-;; Compare string to file
-(defun sisyphus-file-string= (file string)
- (string=
- (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))
- string))
-
-(defun sisyphus-explain-file-string= (file string)
- (sisyphus-explain-string=
- (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))
- string))
-
-(put 'sisyphus-file-string=
- 'ert-explainer
- 'sisyphus-explain-file-string=)
-
-;; Compare buffer to file
-
-;; Compare file to file.
-;; ** Create buffers
+;; ** create buffers
@@ -250,10 +225,10 @@ print any messages!"
(current-buffer)))))
(defmacro sisyphus-with-temp-buffers (varlist &rest body)
- "Bind variables in VARLIST to temp buffers, then eval BODY.
+ "Bind variables in varlist to temp buffers, then eval BODY.
VARLIST is of the same form as a `let' binding. Each element is a
-symbol or a list (SYMBOL VALUEFORMS). Each symbol is bound to a
+symbol or a list (symbol valueforms). Each symbol is bound to a
buffer generated with `generate-new-buffer'. VALUEFORMS are
evaluated with the buffer current. Buffers are unconditionally
killed at the end of the form."
diff --git a/test/sisyphus-test.el b/test/sisyphus-test.el
index a0edcc5574..75611eb165 100644
--- a/test/sisyphus-test.el
+++ b/test/sisyphus-test.el
@@ -50,7 +50,7 @@ This also tests the advice on string=."
:body
(lambda ()
(should
- (string= "1" "2"))))))))
+ (sisyphus= "1" "2"))))))))
(ert-deftest sisyphus-test--string= ()
"Test that string= works after explanation added."
@@ -72,19 +72,50 @@ This also tests the advice on string=."
(sisyphus-test--explanation
(lambda ()
(should
- (string= "1" "2"))))))
+ (sisyphus= "1" "2"))))))
+
+(defvar sisyphus-test-hello.txt
+ (sisyphus-file
+ (relative-expand-file-name "../dev-resources/hello.txt")))
+
+(ert-deftest to-string ()
+ (should
+ (equal "hello"
+ (sisyphus-to-string "hello")))
+ (should
+ (with-temp-buffer
+ (equal "hello"
+ (progn
+ (insert "hello")
+ (sisyphus-to-string (current-buffer))))))
+ (should
+ (with-temp-buffer
+ (equal "hello"
+ (progn
+ (insert "hello")
+ (sisyphus-to-string
+ (list
+ :buffer
+ (buffer-name (current-buffer))))))))
+ (should
+ (with-temp-buffer
+ (equal "hello\n"
+ (sisyphus-to-string
+ sisyphus-test-hello.txt))))
+ (should-error
+ (sisyphus-to-string :hello)))
(ert-deftest buffer-string= ()
(with-temp-buffer
(insert "hello")
(should
- (sisyphus-buffer-string=
+ (sisyphus=
(current-buffer)
"hello")))
(with-temp-buffer
(insert "goodbye")
(should-not
- (sisyphus-buffer-string=
+ (sisyphus=
(current-buffer)
"hello")))
(should
@@ -93,7 +124,7 @@ This also tests the advice on string=."
(with-temp-buffer
(insert "goodbye")
(should
- (sisyphus-buffer-string=
+ (sisyphus=
(current-buffer)
"hello")))))))
@@ -104,14 +135,14 @@ This also tests the advice on string=."
(b
(insert "hello")))
(should
- (sisyphus-buffer= a b)))
+ (sisyphus= a b)))
(sisyphus-with-temp-buffers
((a
(insert "hello"))
(b
(insert "goodbye")))
(should-not
- (sisyphus-buffer=
+ (sisyphus=
a b)))
(should
(sisyphus-with-temp-buffers
@@ -120,27 +151,25 @@ This also tests the advice on string=."
(sisyphus-test--explanation
(lambda ()
(should
- (sisyphus-buffer=
+ (sisyphus=
a b)))))))
-(defvar sisyphus-test-hello.txt
- (relative-expand-file-name "../dev-resources/hello.txt"))
(ert-deftest file-string= ()
(should
- (sisyphus-file-string=
+ (sisyphus=
sisyphus-test-hello.txt
"hello\n"))
(should-not
- (sisyphus-file-string=
+ (sisyphus=
sisyphus-test-hello.txt
"goodbye"))
(should
(sisyphus-test--explanation
(lambda ()
(should
- (sisyphus-file-string=
+ (sisyphus=
sisyphus-test-hello.txt
"goodbye"))))))
