Subject: [PATCH] 28.0; cperl-mode: Test file makeover

From: [email-masked] (Harald Jörg)
Date: Tue, 10 Nov 2020 23:04:34 +0100

As the number of tests for (c)perl mode increases, the test file turns
out to be somewhat untidy.  The patch establishes a consistent naming
scheme, factors out a piece of code which is used in several tests, and
reorders the tests.

The patch also eliminates a warning caused by using (next-line) instead
of (forward-line 1), and allows the tests to run under Emacs 26.
>From 43b3ddccba944e4f3d2b22091338f1bf304c207d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <[email-masked]>
Date: Tue, 10 Nov 2020 23:01:00 +0100
Subject: [PATCH] ; Cleanup of the test file for cperl-mode.

Eliminate a warning, enable tests to run under Emacs 26.
Bug tests are consistently named and reordered.
Repeated code is factored out.

* 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.
---
 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 bd8a1a9f16..a0dd391840 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -34,6 +34,8 @@ cperl-test-mode
 (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 @@ cperl-test-ppss
     (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 @@ cperl-mode-test--run-bug-10483
       (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 @@ cperl-mode-test-bug-10483
   (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 @@ cperl-mode-test-bug-10483
       (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 @@ cperl-bug37127
       (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
-- 
2.20.1