Fix infloop when indenting in cperl-mode

* lisp/progmodes/cperl-mode.el (cperl-indent-exp): Fix (Bug#10483)
Perl expressions (e.g. function calls) ending in ")" without
statement terminator on the same line no longer loop endlessly.

3 files changed, 144 insertions, 6 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index e2628c834ce..5dee5007e2e 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -4819,9 +4819,10 @@ conditional/loop constructs."
 	  (while (< (point) tmp-end)
 	    (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
 	    (or (eolp) (forward-sexp 1)))
-	  (if (> (point) tmp-end)	; Yes, there an unfinished block
+	  (if (> (point) tmp-end)	; Check for an unfinished block
 	      nil
 	    (if (eq ?\) (preceding-char))
+		;; closing parens can be preceded by up to three sexps
 		(progn ;; Plan B: find by REGEXP block followup this line
 		  (setq top (point))
 		  (condition-case nil
@@ -4842,7 +4843,9 @@ conditional/loop constructs."
 			    (progn
 			      (goto-char top)
 			      (forward-sexp 1)
-			      (setq top (point)))))
+			      (setq top (point)))
+			  ;; no block to be processed: expression ends here
+			  (setq done t)))
 		    (error (setq done t)))
 		  (goto-char top))
 	      (if (looking-at		; Try Plan C: continuation block
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl
new file mode 100644
index 00000000000..4a9842ffa56
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.020;
+
+# This file contains test input and expected output for the tests in
+# cperl-mode-tests.el, cperl-mode-test-indent-exp.  The code is
+# syntactically valid, but doesn't make much sense.
+
+# -------- for loop: input --------
+for my $foo (@ARGV)
+{
+...;
+}
+# -------- for loop: expected output --------
+for my $foo (@ARGV) {
+  ...;
+}
+# -------- for loop: end --------
+
+# -------- while loop: input --------
+{
+while (1)
+{
+say "boring loop";
+}
+continue
+{
+last; # no endless loop, though
+}
+}
+# -------- while loop: expected output --------
+{
+  while (1) {
+    say "boring loop";
+  } continue {
+    last; # no endless loop, though
+  }
+}
+# -------- while loop: end --------
+
+# -------- if-then-else: input --------
+if (my $foo) { bar() } elsif (quux()) { baz() } else { quuux }
+# -------- if-then-else: expected output --------
+if (my $foo) {
+  bar();
+} elsif (quux()) {
+  baz();
+} else {
+  quuux;
+}
+# -------- if-then-else: end --------
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 1efcad50078..b549b924042 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -24,10 +24,7 @@
 
 ;;; Commentary:
 
-;; This is a collection of tests for the fontification of CPerl-mode.
-
-;; Run these tests interactively:
-;; (ert-run-tests-interactively '(tag :fontification))
+;; This is a collection of tests for CPerl-mode.
 
 ;;; Code:
 
@@ -35,6 +32,14 @@
 
 (require 'cperl-mode)
 
+(defvar cperl-mode-tests-data-directory
+  (expand-file-name "lisp/progmodes/cperl-mode-resources"
+                    (or (getenv "EMACS_TEST_DIRECTORY")
+                        (expand-file-name "../../../"
+                                          (or load-file-name
+                                              buffer-file-name))))
+  "Directory containing cperl-mode test data.")
+
 (defun cperl-test-ppss (text regexp)
   "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
   (interactive)
@@ -86,4 +91,82 @@ have a face property."
       (should (equal result nil))
       (should (= (point) 15)))))      ; point has skipped the group
 
+(defun cperl-mode-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
+running `cperl-indent-exp' for a very simple input.  The result
+is expected to be different from the input, to verify that
+indentation actually takes place.."
+  (let ((code "poop ('foo', \n'bar')")) ; see the bug report
+    (message "Test Bug#10483 started")
+    (with-temp-buffer
+      (insert code)
+      (funcall cperl-test-mode)
+      (goto-char (point-min))
+      (search-forward "poop")
+      (cperl-indent-exp)
+      (message "%s" (buffer-string)))))
+
+(ert-deftest cperl-mode-test-bug-10483 ()
+  "Verifies that a piece of code which ends in a paren without a
+statement terminato ron tne same line does not loop forever.  The
+test starts an asynchronous Emacs batch process under timeout
+control."
+  (interactive)
+  (let* ((emacs (concat invocation-directory invocation-name))
+         (test-function 'cperl-mode-test--run-bug-10483)
+         (test-function-name (symbol-name test-function))
+         (test-file (symbol-file test-function 'defun))
+         (ran-out-of-time nil)
+         (process-connection-type nil)
+         runner)
+    (with-temp-buffer
+      (with-timeout (1
+                     (delete-process runner)
+                     (setq ran-out-of-time t))
+        (setq runner (start-process "speedy"
+                                    (current-buffer)
+                                    emacs
+                                    "-batch"
+                                    "--quick"
+                                    "--load" test-file
+                                    "--funcall" test-function-name))
+        (while (accept-process-output runner)))
+      (should (equal ran-out-of-time nil))
+      (goto-char (point-min))
+      ;; just a very simple test for indentation: This should
+      ;; be rather robust with regard to indentation defaults
+      (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."
+  (let ((file (expand-file-name "cperl-indent-exp.pl"
+                                cperl-mode-tests-data-directory)))
+    (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))
+            (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))))))))
+
 ;;; cperl-mode-tests.el ends here