[elpa] externals/assess 238d9028e2 19/95: Support for indentation checking.

[ELPA Syncer]

branch: externals/assess
commit 238d9028e26a37a7c1c52a37d111f15e23316aa2
Author: Phillip Lord <phillip.lord@russet.org.uk>
Commit: Phillip Lord <phillip.lord@russet.org.uk>

    Support for indentation checking.
    
    Including support for opening and copying files.
---
 dev-resources/elisp-indented.el   |   5 ++
 dev-resources/elisp-unindented.el |   5 ++
 sisyphus.el                       | 150 +++++++++++++++++++++++++++++++++++++-
 test/sisyphus-test.el             | 145 +++++++++++++++++++++++++++++++++---
 4 files changed, 291 insertions(+), 14 deletions(-)

diff --git a/dev-resources/elisp-indented.el b/dev-resources/elisp-indented.el
new file mode 100644
index 0000000000..faf0165354
--- /dev/null
+++ b/dev-resources/elisp-indented.el
@@ -0,0 +1,5 @@
+(
+ (
+  (
+   (
+    ))))
diff --git a/dev-resources/elisp-unindented.el 
b/dev-resources/elisp-unindented.el
new file mode 100644
index 0000000000..cb5bab9dc9
--- /dev/null
+++ b/dev-resources/elisp-unindented.el
@@ -0,0 +1,5 @@
+(
+(
+(
+(
+))))
\ No newline at end of file
diff --git a/sisyphus.el b/sisyphus.el
index ec61515286..86c1cfd115 100644
--- a/sisyphus.el
+++ b/sisyphus.el
@@ -115,6 +115,17 @@
 (defun sisyphus-file (f)
   "Add type data to the string F marking it as a file."
   `(:file ,f))
+
+(defun sisyphus-to-file-name (file)
+  "Return file name for FILE.
+
+FILE can be either a string, or a plist returned by
+`sisyphus-file' or `sisyphus-make-related-file'."
+  (pcase file
+    ((pred stringp) file)
+    (`(:file ,f) f)
+    (_ (error "Type not recognised"))))
+
 ;; #+end_src
 
 ;; *** String Comparision
@@ -247,13 +258,73 @@ killed at the end of the form."
 
 ;; Again, same issues -- what if the file is already open. Especially if are
 ;; going to save it.
+(defun sisyphus--make-related-file-1 (file &optional directory)
+  (make-temp-file
+   (concat
+    (or directory
+        temporary-file-directory)
+    (file-name-nondirectory file))
+   nil
+   (concat "."
+           (file-name-extension file))))
+
+(defun sisyphus-make-related-file (file &optional directory)
+  "Open a copy of FILE in DIRECTORY.
+
+FILE is copied to a temporary file in DIRECTORY or
+`temporary-file-directory'. The copy has a unique name but shares
+the same file extension.
+
+This is useful for making test changes to FILE without actually
+altering it."
+  (let* ((file (sisyphus-to-file-name file))
+         (related-file
+          (sisyphus--make-related-file-1 file directory)))
+    (copy-file file related-file t)
+    (sisyphus-file
+     related-file)))
+
+(defmacro sisyphus-with-find-file (file &rest body)
+  "Open FILE and evaluate BODY in resultant buffer.
+
+FILE is opened with `find-file-noselect' so all the normal hooks
+for file opening should occur. The buffer is killed after the
+macro exits, unless it was already open. This happens
+unconditionally, even if the buffer has changed.
+
+See also `sisyphus-make-related-file'."
+  (declare (debug t) (indent 1))
+  (let ((temp-buffer (make-symbol "temp-buffer"))
+        (file-has-buffer-p (make-symbol "file-has-buffer-p"))
+        (file-s (make-symbol "file")))
+    `(let* ((,file-s ,file)
+            (,file-s (sisyphus-to-file-name ,file-s))
+            (,file-has-buffer-p
+             (find-buffer-visiting ,file-s))
+            (,temp-buffer))
+       (unwind-protect
+           (with-current-buffer
+               (setq ,temp-buffer
+                     (find-file-noselect ,file-s))
+             ,@body)
+         (when
+          ;; kill the buffer unless it was already open.
+             (and (not ,file-has-buffer-p)
+                  (buffer-live-p ,temp-buffer))
+           ;; kill unconditionally
+           (with-current-buffer ,temp-buffer
+             (set-buffer-modified-p nil))
+           (kill-buffer ,temp-buffer))))))
+
 
 ;; ** Indentation functions
 
 ;; This is largely a re--implementation of `indent-region' but without the
 ;; noise.
-(defun sisyphus--indent-buffer ()
+(defun sisyphus--indent-buffer (&optional column)
   (cond
+   (column
+    (indent-region (point-min) (point-max) column))
    ;; if indent-region-function is set, use it, and hope that it is not
    ;; noisy.
    (indent-region-function
@@ -277,7 +348,10 @@ killed at the end of the form."
   "Return non-nil if UNINDENTED indents in MODE to INDENTED.
 Both UNINDENTED and INDENTED can be any value usable by
 `sisyphus-to-string'. Indentation is performed using
-`indent-region'."
+`indent-region', which MODE should set up appropriately.
+
+See also `sisyphus-file-roundtrip-indentation=' for an
+alternative mechanism."
   (sisyphus=
    (sisyphus--indent-in-mode
     mode
@@ -285,6 +359,7 @@ Both UNINDENTED and INDENTED can be any value usable by
    indented))
 
 (defun sisyphus-explain-indentation= (mode unindented indented)
+  "Explanation function for `sisyphus-indentation='."
   (sisyphus-explain=
    (sisyphus--indent-in-mode
     mode
@@ -293,7 +368,76 @@ Both UNINDENTED and INDENTED can be any value usable by
 
 (put 'sisyphus-indentation= 'ert-explainer 'sisyphus-explain-indentation=)
 
-;; Set mode, indent normally, then compare
+(defun sisyphus--buffer-unindent (buffer)
+  (with-current-buffer
+      buffer
+    (sisyphus--indent-buffer 0)))
+
+(defun sisyphus--roundtrip-1 (comp mode indented)
+  (with-temp-buffer
+    (funcall comp
+             mode
+             (progn
+               (insert
+                (sisyphus-to-string indented))
+               (sisyphus--buffer-unindent (current-buffer))
+               (buffer-string))
+             indented)))
+
+(defun sisyphus-roundtrip-indentation= (mode indented)
+  "Return t if in MODE, text in INDENTED is corrected indented.
+
+This is checked by unindenting the text, then reindenting it according
+to MODE.
+
+See also `sisyphus-indentation=' and
+`sisyphus-file-roundtrip-indentation=' for alternative
+mechanisms of checking indentation."
+  (sisyphus--roundtrip-1
+   #'sisyphus-indentation=
+   mode indented))
+
+(defun sisyphus-explain-roundtrip-indentation= (mode indented)
+  "Explanation function for `sisyphus-roundtrip-indentation='."
+  (sisyphus--roundtrip-1
+   #'sisyphus-explain-indentation=
+   mode indented))
+
+(put 'sisyphus-roundtrip-indentation=
+     'ert-explainer
+     'sisyphus-explain-roundtrip-indentation=)
+
+(defun sisyphus--file-roundtrip-1 (comp file)
+  (funcall
+   comp
+   (sisyphus-with-find-file
+       (sisyphus-make-related-file file)
+     (sisyphus--buffer-unindent (current-buffer))
+     (sisyphus--indent-buffer)
+     (buffer-string))
+   file))
+
+(defun sisyphus-file-roundtrip-indentation= (file)
+  "Return t if text in FILE is indented correctly.
+
+FILE is copied with `sisyphus-make-related-file', so this
+function should be side-effect free whether or not FILE is
+already open. The file is opened with `find-file-noselect', so
+hooks associated with interactive visiting of a file should all
+be called, with the exception of directory local variables, as
+the copy of FILE will be in a different directory."
+  (sisyphus--file-roundtrip-1
+   #'sisyphus= file))
+
+(defun sisyphus-explain-file-roundtrip-indentation= (file)
+  "Explanation function for `sisyphus-file-roundtrip-indentation=."
+  (sisyphus--file-roundtrip-1
+   #'sisyphus-explain= file))
+
+(put 'sisyphus-file-roundtrip-indentation=
+     'ert-explainer
+     'sisyphus-explain-file-roundtrip-indentation=)
+
 
 ;; ** Font-lock support functions
 
diff --git a/test/sisyphus-test.el b/test/sisyphus-test.el
index e65b9fa99e..f5df801122 100644
--- a/test/sisyphus-test.el
+++ b/test/sisyphus-test.el
@@ -1,24 +1,41 @@
+;;; sisyphus-test.el --- Tests for sisyphus.el -*- lexical-binding: t -*-
+
+;;; Header:
+
 ;; The contents of this file are subject to the GPL License, Version 3.0.
-;;
+
 ;; Copyright (C) 2015, Phillip Lord, Newcastle University
-;;
+
 ;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
 ;; (at your option) any later version.
-;;
+
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+
+;;; Code:
+
+;; ** Requires
+
+;; #+begin_src emacs-lisp
 (require 'load-relative)
 (require 'sisyphus)
 (require 'cl-lib)
+;; #+end_src
 
+;; ** Test Extraction
+
+;; Sisyphus supports tests functions which means that we need the ability to 
test
+;; tests. This code simple extracts knowledge from the results of tests.
+
+;; #+begin_src emacs-lisp
 (defun sisyphus-test--plist-from-result (result)
   (cl-cdadr
    (ert-test-result-with-condition-condition result)))
@@ -52,13 +69,6 @@ This also tests the advice on string=."
         (should
          (sisyphus= "1" "2"))))))))
 
-(ert-deftest sisyphus-test--string= ()
-  "Test that string= works after explanation added."
-  (should
-   (string= "1" "1"))
-  (should-not
-   (string= "1" "2")))
-
 (defun sisyphus-test--explanation (f)
   (sisyphus-test--explanation-from-result
    (ert-run-test
@@ -73,7 +83,12 @@ This also tests the advice on string=."
     (lambda ()
       (should
        (sisyphus= "1" "2"))))))
+;; #+end_src
 
+
+;; ** To-String testing
+
+;; #+begin_src emacs-lisp
 (defvar sisyphus-test-hello.txt
   (sisyphus-file
    (relative-expand-file-name "../dev-resources/hello.txt")))
@@ -105,6 +120,12 @@ This also tests the advice on string=."
   (should-error
    (sisyphus-to-string :hello)))
 
+;; #+end_src
+
+;; ** Compare Buffer to String
+
+;; #+begin_src emacs-lisp
+
 (ert-deftest buffer-string= ()
   (with-temp-buffer
     (insert "hello")
@@ -128,6 +149,12 @@ This also tests the advice on string=."
           (current-buffer)
           "hello")))))))
 
+;; #+end_src
+
+;; ** Buffer to Buffer
+
+;; #+begin_src emacs-lisp
+
 (ert-deftest buffer= ()
   (sisyphus-with-temp-buffers
       ((a
@@ -154,6 +181,11 @@ This also tests the advice on string=."
          (sisyphus=
           a b)))))))
 
+;; #+end_src
+
+;; ** Buffer to file
+
+;; #+begin_src emacs-lisp
 (ert-deftest file-string= ()
   (should
    (sisyphus=
@@ -172,6 +204,12 @@ This also tests the advice on string=."
         "goodbye"))))))
 
 
+;; #+end_src
+
+;; ** Preserved Buffer List and With Temp Buffers
+
+;; #+begin_src emacs-lisp
+
 (ert-deftest preserved-buffer-list ()
   (should
    (=
@@ -220,6 +258,40 @@ This also tests the advice on string=."
       (sisyphus-with-temp-buffers (a b))
       (length (buffer-list))))))
 
+;; #+end_src
+
+;; ** Open Close files
+
+;; #+begin_src emacs-lisp
+
+(ert-deftest sisyphus-test-related-file ()
+  (should
+   (file-exists-p
+    (sisyphus-to-file-name
+     (sisyphus-make-related-file sisyphus-test-hello.txt))))
+  (should
+   (sisyphus=
+    sisyphus-test-hello.txt
+    (sisyphus-make-related-file sisyphus-test-hello.txt))))
+
+(ert-deftest sisyphus-test-with-find-file ()
+  (should
+   (sisyphus-with-find-file
+       (sisyphus-make-related-file sisyphus-test-hello.txt)))
+  (should-not
+   (sisyphus=
+    sisyphus-test-hello.txt
+    (sisyphus-with-find-file
+        (sisyphus-make-related-file sisyphus-test-hello.txt)
+      (insert "hello")
+      (buffer-string)))))
+
+;; #+end_src
+
+;; ** Indentation Tests
+
+;; #+begin_src emacs-lisp
+
 (ert-deftest sisyphus--test-indent-in-mode ()
   (should
    (sisyphus=
@@ -255,3 +327,54 @@ This also tests the advice on string=."
         'emacs-lisp-mode
         "hello"
         "goodbye"))))))
+
+(defvar sisyphus-dev-resources
+  (relative-expand-file-name "../dev-resources/"))
+
+(defvar sisyphus-dev-elisp-indented
+  (sisyphus-file
+   (concat sisyphus-dev-resources
+           "elisp-indented.el")))
+
+(defvar sisyphus-dev-elisp-unindented
+  (sisyphus-file
+   (concat sisyphus-dev-resources
+           "elisp-unindented.el")))
+
+(ert-deftest sisyphus-test-roundtrip-indentation= ()
+  (should
+   (sisyphus-roundtrip-indentation=
+    'emacs-lisp-mode
+    sisyphus-dev-elisp-indented))
+  (should-not
+   (sisyphus-roundtrip-indentation=
+    'emacs-lisp-mode
+    sisyphus-dev-elisp-unindented)))
+
+(ert-deftest sisyphus-test-roundtrip-indentation-explain= ()
+  (should
+   (sisyphus-test--explanation
+    (lambda ()
+      (should
+       (sisyphus-roundtrip-indentation=
+        'emacs-lisp-mode
+        sisyphus-dev-elisp-unindented))))))
+
+(ert-deftest sisyphus-test-file-roundtrip-indentation= ()
+  (should
+   (sisyphus-file-roundtrip-indentation=
+    sisyphus-dev-elisp-indented))
+  (should-not
+   (sisyphus-file-roundtrip-indentation=
+    sisyphus-dev-elisp-unindented)))
+
+(ert-deftest sisyphus-test-file-roundtrip-indentation-explain= ()
+  (should
+   (sisyphus-test--explanation
+    (lambda ()
+      (should
+       (sisyphus-file-roundtrip-indentation=
+        sisyphus-dev-elisp-unindented))))))
+
+
+;; #+end_src