master 9038890: Cleanup of the test file for cperl-mode

[Lars Ingebrigtsen]

branch: master
commit 9038890ae21eed644251df9511cfda298a594ed9
Author: Harald Jörg <haj@posteo.de>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Cleanup of the test file for cperl-mode
    
    * test/lisp/progmodes/cperl-mode-tests.el
    (cperl--run-test-cases): New macro, factored out from various
    indentation / rewriting tests.  Contains documentation of the
    format used by the cperl-mode-resources files.
    (cperl-test-bug-19709): Replace 'next-line' by 'forward-line'.
    (cperl-test-indent-exp),
    (cperl-test-indent-styles),
    (cperl-test-bug-30393): Use the new macro.
    (cperl-test-bug-19709): Make fit for Emacs 26.
    (cperl-test-indent-styles): Skip for Perl mode (bug#44561).
---
 test/lisp/progmodes/cperl-mode-tests.el | 334 +++++++++++++++-----------------
 1 file changed, 152 insertions(+), 182 deletions(-)

diff --git a/test/lisp/progmodes/cperl-mode-tests.el 
b/test/lisp/progmodes/cperl-mode-tests.el
index bd8a1a9..a0dd391 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -34,6 +34,8 @@
 (require 'ert)
 (require 'ert-x)
 
+;;; Utilities
+
 (defun cperl-test-ppss (text regexp)
   "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
   (interactive)
@@ -44,48 +46,98 @@
     (re-search-forward regexp)
     (syntax-ppss)))
 
-(ert-deftest cperl-mode-test-bug-42168 ()
-  "Verify that '/' is a division after ++ or --, not a regexp.
-Reported in https://github.com/jrockway/cperl-mode/issues/45.
-If seen as regular expression, then the slash is displayed using
-font-lock-constant-face.  If seen as a division, then it doesn't
-have a face property."
-  :tags '(:fontification)
-  ;; The next two Perl expressions have divisions.  Perl "punctuation"
-  ;; operators don't get a face.
-  (let ((code "{ $a++ / $b }"))
-    (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
-  (let ((code "{ $a-- / $b }"))
-    (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
-  ;; The next two Perl expressions have regular expressions.  The
-  ;; delimiter of a RE is fontified with font-lock-constant-face.
-  (let ((code "{ $a+ / $b } # /"))
-    (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
-  (let ((code "{ $a- / $b } # /"))
-    (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
+(defmacro cperl--run-test-cases (file &rest body)
+  "Run all test cases in FILE with BODY.
+This macro helps with tests which reformat Perl code, e.g. when
+indenting or rearranging flow control.  It extracts source code
+snippets and corresponding expected results from a resource file,
+runs BODY on the snippets, and compares the resulting buffer with
+the expected results.
 
-(ert-deftest cperl-mode-test-bug-16368 ()
-  "Verify that `cperl-forward-group-in-re' doesn't hide errors."
+Test cases in FILE are formatted like this:
+
+# -------- NAME: input --------
+Your input to the test case comes here.
+Both input and expected output may span several lines.
+# -------- NAME: expected output --------
+The expected output from running BODY on the input goes here.
+# -------- NAME: end --------
+
+You can have many of these blocks in one test file.  You can
+chose a NAME for each block, which is passed to the 'should'
+clause for easy identification of the first test case that
+failed (if any).  Text outside these the blocks is ignored by the
+tests, so you can use it to document the test cases if you wish."
+  `(with-temp-buffer
+     (insert-file-contents ,file)
+     (goto-char (point-min))
+     (while (re-search-forward
+             (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
+                     "\\(?2:\\(?:.*\n\\)+?\\)"
+                     "# ?-+ \\1: expected output ?-+\n"
+                     "\\(?3:\\(?:.*\n\\)+?\\)"
+                     "# ?-+ \\1: end ?-+")
+             nil t)
+       (let ((name (match-string 1))
+             (code (match-string 2))
+             (expected (match-string 3))
+             got)
+         (with-temp-buffer
+           (insert code)
+           (goto-char (point-min))
+           (funcall cperl-test-mode)
+           ,@body
+           (setq expected (concat "test case " name ":\n" expected))
+           (setq got (concat "test case " name ":\n" (buffer-string)))
+           (should (equal got expected)))))))
+
+;;; Indentation tests
+
+(ert-deftest cperl-test-indent-exp ()
+  "Run various tests for `cperl-indent-exp' edge cases.
+These exercise some standard blocks and also the special
+treatment for Perl expressions where a closing paren isn't the
+end of the statement."
   (skip-unless (eq cperl-test-mode #'cperl-mode))
-  (let ((code "/(\\d{4})(?{2}/;")     ; the regex from the bug report
-        (result))
-    (with-temp-buffer
-      (insert code)
-      (goto-char 9)
-      (setq result (cperl-forward-group-in-re))
-      (should (equal (car result) 'scan-error))
-      (should (equal (nth 1 result) "Unbalanced parentheses"))
-      (should (= (point) 9))))        ; point remains unchanged on error
-  (let ((code "/(\\d{4})(?{2})/;")    ; here all parens are balanced
-        (result))
+  (cperl--run-test-cases
+   (ert-resource-file "cperl-indent-exp.pl")
+   (cperl-indent-exp))) ; here we go!
+
+(ert-deftest cperl-test-indent-styles ()
+  (skip-unless (eq cperl-test-mode #'cperl-mode))
+  (cperl--run-test-cases
+   (ert-resource-file "cperl-indent-styles.pl")
+   (cperl-set-style "PBP")
+   (indent-region (point-min) (point-max)) ; here we go!
+   (cperl-set-style-back)))
+
+;;; Fontification tests
+
+(ert-deftest cperl-test-fontify-punct-vars ()
+  "Test fontification of Perl's punctiation variables.
+Perl has variable names containing unbalanced quotes for the list
+separator $\" and pre- and postmatch $` and $'.  A reference to
+these variables, for example \\$\", should not cause the dollar
+to be escaped, which would then start a string beginning with the
+quote character.  This used to be broken in cperl-mode at some
+point in the distant past, and is still broken in perl-mode. "
+  (skip-unless (eq cperl-test-mode #'cperl-mode))
+  (let ((file (ert-resource-file "fontify-punctuation-vars.pl")))
     (with-temp-buffer
-      (insert code)
-      (goto-char 9)
-      (setq result (cperl-forward-group-in-re))
-      (should (equal result nil))
-      (should (= (point) 15)))))      ; point has skipped the group
+      (insert-file-contents file)
+      (goto-char (point-min))
+      (funcall cperl-test-mode)
+      (while (search-forward "##" nil t)
+        ;; The third element of syntax-ppss is true if in a string,
+        ;; which would indicate bad interpretation of the quote.  The
+        ;; fourth element is true if in a comment, which should be the
+        ;; case.
+        (should (equal (nth 3 (syntax-ppss)) nil))
+        (should (equal (nth 4 (syntax-ppss)) t))))))
 
-(defun cperl-mode-test--run-bug-10483 ()
+;;; Tests for issues reported in the Bug Tracker
+
+(defun cperl-test--run-bug-10483 ()
   "Runs a short program, intended to be under timer scrutiny.
 This function is intended to be used by an Emacs subprocess in
 batch mode.  The message buffer is used to report the result of
@@ -102,7 +154,7 @@ indentation actually takes place.."
       (cperl-indent-exp)
       (message "%s" (buffer-string)))))
 
-(ert-deftest cperl-mode-test-bug-10483 ()
+(ert-deftest cperl-test-bug-10483 ()
   "Check that indenting certain perl code does not loop forever.
 This verifies that indenting a piece of code that ends in a paren
 without a statement terminator on the same line does not loop
@@ -113,7 +165,7 @@ under timeout control."
   (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
   (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
   (let* ((emacs (concat invocation-directory invocation-name))
-         (test-function 'cperl-mode-test--run-bug-10483)
+         (test-function 'cperl-test--run-bug-10483)
          (test-function-name (symbol-name test-function))
          (test-file (symbol-file test-function 'defun))
          (ran-out-of-time nil)
@@ -138,156 +190,54 @@ under timeout control."
       (should (string-match
                "poop ('foo', \n      'bar')" (buffer-string))))))
 
-(ert-deftest cperl-mode-test-indent-exp ()
-  "Run various tests for `cperl-indent-exp' edge cases.
-These exercise some standard blocks and also the special
-treatment for Perl expressions where a closing paren isn't the
-end of the statement."
-  (skip-unless (eq cperl-test-mode #'cperl-mode))
-  (let ((file (ert-resource-file "cperl-indent-exp.pl")))
-    (with-temp-buffer
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (while (re-search-forward
-              (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
-                      "\\(?2:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: expected output ?-+\n"
-                      "\\(?3:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: end ?-+")
-              nil t)
-        (let ((name (match-string 1))
-              (code (match-string 2))
-              (expected (match-string 3))
-              got)
-          (with-temp-buffer
-            (insert code)
-           (cperl-mode)
-            (goto-char (point-min))
-            (cperl-indent-exp) ; here we go!
-            (setq expected (concat "test case " name ":\n" expected))
-            (setq got (concat "test case " name ":\n" (buffer-string)))
-            (should (equal got expected))))))))
-
-(ert-deftest cperl-mode-test-indent-styles ()
-  "Verify correct indentation by style \"PBP\".
-Perl Best Practices sets some indentation values different from
-  the defaults, and also wants an \"else\" or \"elsif\" keyword
-  to align with the \"if\"."
-  (let ((file (ert-resource-file "cperl-indent-styles.pl")))
-    (with-temp-buffer
-      (cperl-set-style "PBP")
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (while (re-search-forward
-              (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
-                      "\\(?2:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: expected output ?-+\n"
-                      "\\(?3:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: end ?-+")
-              nil t)
-        (let ((name (match-string 1))
-              (code (match-string 2))
-              (expected (match-string 3))
-              got)
-          (with-temp-buffer
-            (insert code)
-           (cperl-mode)
-           (indent-region (point-min) (point-max)) ; here we go!
-            (setq expected (concat "test case " name ":\n" expected))
-            (setq got (concat "test case " name ":\n" (buffer-string)))
-            (should (equal got expected)))))
-      (cperl-set-style "CPerl"))))
-
-(ert-deftest cperl-mode-fontify-punct-vars ()
-  "Test fontification of Perl's punctiation variables.
-Perl has variable names containing unbalanced quotes for the list
-separator $\" and pre- and postmatch $` and $'.  A reference to
-these variables, for example \\$\", should not cause the dollar
-to be escaped, which would then start a string beginning with the
-quote character.  This used to be broken in cperl-mode at some
-point in the distant past, and is still broken in perl-mode. "
+(ert-deftest cperl-test-bug-16368 ()
+  "Verify that `cperl-forward-group-in-re' doesn't hide errors."
   (skip-unless (eq cperl-test-mode #'cperl-mode))
-  (let ((file (ert-resource-file "fontify-punctuation-vars.pl")))
+  (let ((code "/(\\d{4})(?{2}/;")     ; the regex from the bug report
+        (result))
     (with-temp-buffer
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (funcall cperl-test-mode)
-      (while (search-forward "##" nil t)
-        ;; The third element of syntax-ppss is true if in a string,
-        ;; which would indicate bad interpretation of the quote.  The
-        ;; fourth element is true if in a comment, which should be the
-        ;; case.
-        (should (equal (nth 3 (syntax-ppss)) nil))
-        (should (equal (nth 4 (syntax-ppss)) t))))))
-
-(ert-deftest cperl-bug30393 ()
-  "Verify that indentation is not disturbed by an open paren in col 0.
-Perl is not Lisp: An open paren in column 0 does not start a function."
-  (let ((file (ert-resource-file "cperl-bug-30393.pl")))
+      (insert code)
+      (goto-char 9)
+      (setq result (cperl-forward-group-in-re))
+      (should (equal (car result) 'scan-error))
+      (should (equal (nth 1 result) "Unbalanced parentheses"))
+      (should (= (point) 9))))        ; point remains unchanged on error
+  (let ((code "/(\\d{4})(?{2})/;")    ; here all parens are balanced
+        (result))
     (with-temp-buffer
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (while (re-search-forward
-              (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
-                      "\\(?2:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: expected output ?-+\n"
-                      "\\(?3:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: end ?-+")
-              nil t)
-        (let ((name (match-string 1))
-              (code (match-string 2))
-              (expected (match-string 3))
-              got)
-          (with-temp-buffer
-            (insert code)
-           (funcall cperl-test-mode)
-            (goto-char (point-min))
-            (while (null (eobp))
-              (cperl-indent-command)
-              (forward-line 1))
-            (setq expected (concat "test case " name ":\n" expected))
-            (setq got (concat "test case " name ":\n" (buffer-string)))
-            (should (equal got expected))))))))
+      (insert code)
+      (goto-char 9)
+      (setq result (cperl-forward-group-in-re))
+      (should (equal result nil))
+      (should (= (point) 15)))))      ; point has skipped the group
 
-(ert-deftest cperl-bug19709 ()
+(ert-deftest cperl-test-bug-19709 ()
   "Verify that indentation of closing paren works as intended.
 Note that Perl mode has no setting for close paren offset, per
 documentation it does the right thing anyway."
-  (let ((file (ert-resource-file "cperl-bug-19709.pl")))
-    (with-temp-buffer
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (while (re-search-forward
-              (concat "^# ?-+ \\_<\\(?1:.+?\\)\\_>: input ?-+\n"
-                      "\\(?2:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: expected output ?-+\n"
-                      "\\(?3:\\(?:.*\n\\)+?\\)"
-                      "# ?-+ \\1: end ?-+")
-              nil t)
-        (let ((name (match-string 1))
-              (code (match-string 2))
-              (expected (match-string 3))
-              got)
-          (with-temp-buffer
-            (insert code)
-           (funcall cperl-test-mode)
-            (setq-local
-             ;; settings from the bug report
-             cperl-indent-level 4
-             cperl-indent-parens-as-block t
-             cperl-close-paren-offset -4
-             ;; same, adapted for per-mode
-             perl-indent-level 4
-             perl-indent-parens-as-block t)
-            (goto-char (point-min))
-            (while (null (eobp))
-              (cperl-indent-command)
-              (next-line))
-            (setq expected (concat "test case " name ":\n" expected))
-            (setq got (concat "test case " name ":\n" (buffer-string)))
-            (should (equal got expected))))))))
+  (cperl--run-test-cases
+   (ert-resource-file "cperl-bug-19709.pl")
+   ;; settings from the bug report
+   (setq-local cperl-indent-level 4)
+   (setq-local cperl-indent-parens-as-block t)
+   (setq-local  cperl-close-paren-offset -4)
+   ;; same, adapted for per-mode
+   (setq-local perl-indent-level 4)
+   (setq-local perl-indent-parens-as-block t)
+   (while (null (eobp))
+     (cperl-indent-command)
+     (forward-line 1))))
 
-(ert-deftest cperl-bug37127 ()
+(ert-deftest cperl-test-bug-30393 ()
+  "Verify that indentation is not disturbed by an open paren in col 0.
+Perl is not Lisp: An open paren in column 0 does not start a function."
+  (cperl--run-test-cases
+   (ert-resource-file "cperl-bug-30393.pl")
+   (while (null (eobp))
+     (cperl-indent-command)
+     (forward-line 1))))
+
+(ert-deftest cperl-test-bug-37127 ()
   "Verify that closing a paren in a regex goes without a message.
 Also check that the message is issued if the regex terminator is
 missing."
@@ -327,4 +277,24 @@ missing."
       (should (string-match "^End of .* string/RE"
                             collected-messages)))))
 
+(ert-deftest cperl-test-bug-42168 ()
+  "Verify that '/' is a division after ++ or --, not a regexp.
+Reported in https://github.com/jrockway/cperl-mode/issues/45.
+If seen as regular expression, then the slash is displayed using
+font-lock-constant-face.  If seen as a division, then it doesn't
+have a face property."
+  :tags '(:fontification)
+  ;; The next two Perl expressions have divisions.  Perl "punctuation"
+  ;; operators don't get a face.
+  (let ((code "{ $a++ / $b }"))
+    (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+  (let ((code "{ $a-- / $b }"))
+    (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
+  ;; The next two Perl expressions have regular expressions.  The
+  ;; delimiter of a RE is fontified with font-lock-constant-face.
+  (let ((code "{ $a+ / $b } # /"))
+    (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
+  (let ((code "{ $a- / $b } # /"))
+    (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
+
 ;;; cperl-mode-tests.el ends here