From 3e9b727d2b7215ca73bc9334bf5b904916640055 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Harald=20J=C3=B6rg?= <haj@posteo.de>
Date: Tue, 6 Apr 2021 20:21:25 +0200
Subject: [PATCH] ; cperl-mode: Eliminate bad interpretation of ?foo?
 (bug#47598)

* lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Delete
?? from the allowed bare regexp delimiters.
(cperl-short-docs): Delete ?...? from the documentation.

* test/lisp/progmodes/cperl-mode-tests.el (cperl-bug-47598):
Add tests for good, bad, and ambiguous use of ? as regex
delimiter.
---
 lisp/progmodes/cperl-mode.el            | 16 ++++++---------
 test/lisp/progmodes/cperl-mode-tests.el | 27 +++++++++++++++++++++++++
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 7878e91096..d58b126ae9 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -3585,7 +3585,7 @@ cperl-find-pods-heres
 		"\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT
 		"\\|"
 		;; 1+6+2+1=10 extra () before this:
-		"\\([?/<]\\)"	; /blah/ or ?blah? or <file*glob>
+		"\\([/<]\\)"	; /blah/ or <file*glob>
 		"\\|"
 		;; 1+6+2+1+1=11 extra () before this
 		"\\<" cperl-sub-regexp "\\>" ;  sub with proto/attr
@@ -3920,7 +3920,7 @@ cperl-find-pods-heres
 		;; 1+6+2=9 extra () before this:
 		;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
 		;; "\\|"
-		;; "\\([?/<]\\)"	; /blah/ or ?blah? or <file*glob>
+		;; "\\([/<]\\)"	; /blah/ or <file*glob>
 		(setq b1 (if (match-beginning 10) 10 11)
 		      argument (buffer-substring
 				(match-beginning b1) (match-end b1))
@@ -3958,7 +3958,7 @@ cperl-find-pods-heres
 		(goto-char (match-beginning b1))
 		(cperl-backward-to-noncomment (point-min))
 		(or bb
-		    (if (eq b1 11)	; bare /blah/ or ?blah? or <foo>
+		    (if (eq b1 11)	; bare /blah/ or <foo>
 			(setq argument ""
 			      b1 nil
 			      bb	; Not a regexp?
@@ -3966,7 +3966,7 @@ cperl-find-pods-heres
 			       ;; What is below: regexp-p?
 			       (and
 				(or (memq (preceding-char)
-					  (append (if (memq c '(?\? ?\<))
+					  (append (if (char-equal c ?\<)
 						      ;; $a++ ? 1 : 2
 						      "~{(=|&*!,;:["
 						    "~{(=|&+-*!,;:[") nil))
@@ -3977,14 +3977,11 @@ cperl-find-pods-heres
 					   (forward-sexp -1)
 ;; After these keywords `/' starts a RE.  One should add all the
 ;; functions/builtins which expect an argument, but ...
-					   (if (eq (preceding-char) ?-)
-					       ;; -d ?foo? is a RE
-					       (looking-at "[a-zA-Z]\\>")
 					     (and
 					      (not (memq (preceding-char)
 							 '(?$ ?@ ?& ?%)))
 					      (looking-at
-					       "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))))
+					       "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>"))))
 				    (and (eq (preceding-char) ?.)
 					 (eq (char-after (- (point) 2)) ?.))
 				    (bobp))
@@ -7232,8 +7229,7 @@ cperl-short-docs
 ... >= ...	Numeric greater than or equal to.
 ... >> ...	Bitwise shift right.
 ... >>= ...	Bitwise shift right assignment.
-... ? ... : ...	Condition=if-then-else operator.   ?PAT? One-time pattern match.
-?PATTERN?	One-time pattern match.
+... ? ... : ...	Condition=if-then-else operator.
 @ARGV	Command line arguments (not including the command name - see $0).
 @INC	List of places to look for perl scripts during do/include/use.
 @_    Parameter array for subroutines; result of split() unless in list context.
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 14bc48b92f..1b3a816d87 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -495,4 +495,31 @@ cperl-test-bug-47112
                          'font-lock-constant-face
                        font-lock-string-face))))))
 
+(ert-deftest cperl-test-bug-47598 ()
+  "Check that a file test followed by ? is no longer interpreted
+as a regex."
+  ;; Testing the text from the bug report
+  (with-temp-buffer
+    (insert "my $f = -f ? 'file'\n")
+    (insert "      : -l ? [readlink]\n")
+    (insert "      : -d ? 'dir'\n")
+    (insert "      : 'unknown';\n")
+    (funcall cperl-test-mode)
+    ;; Perl mode doesn't highlight file tests as functions, so we
+    ;; can't test for the function's face.  But we can verify that the
+    ;; function is not a string.
+    (goto-char (point-min))
+    (search-forward "?")
+    (should-not (nth 3 (syntax-ppss (point)))))
+  ;; Testing the actual targets for the regexp: m?foo? (still valid)
+  ;; and ?foo? (invalid since Perl 5.22)
+  (with-temp-buffer
+    (insert "m?foo?;")
+    (funcall cperl-test-mode)
+    (should (nth 3 (syntax-ppss 3))))
+  (with-temp-buffer
+    (insert " ?foo?;")
+    (funcall cperl-test-mode)
+    (should-not (nth 3 (syntax-ppss 3)))))
+
 ;;; cperl-mode-tests.el ends here
-- 
2.20.1