bug#47598: cperl-mode: Highlighting confused with ternary and -x [PATCH]

[haj@posteo.de (Harald Jörg)]

[-- Attachment #1: Type: text/plain, Size: 861 bytes --]

E. Choroba writes:

> When combining the ternary operator with file tests using the default
> argument, cperl-mode gets confused.
>
> For example:
>
> my $f = -f ? 'file'
>       : -l ? [readlink]
>       : -d ? 'dir'
>            : 'unknown';
>
> It seems to think the ?'s are not part of a ternary operator, but
> rather a match-once operator. ...

Exactly, that is what is happening here.

> ... Note that m?? without m results in a
> syntax error since Perl 5.22.

Because of that it seems appropriate to stop dealing with bare ?foo?
altogether.  So, the patch eliminates the recognition of bare ?foo?, and
also deletes the corresponding lines from CPerl's builtin short
documentation.  The test in the patch uses the text from the bug report,
and also checks that m?foo? is still processed as a regular expression,
and a bare ?foo?  isn't.
-- 
Cheers,
haj

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Don't support ?foo? --]
[-- Type: text/x-diff, Size: 4935 bytes --]

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