]> git.eshelyaron.com Git - emacs.git/commitdiff
cperl-mode: Eliminate bad interpretation of ?foo?
authorHarald Jörg <haj@posteo.de>
Thu, 6 May 2021 10:33:40 +0000 (12:33 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Thu, 6 May 2021 10:33:40 +0000 (12:33 +0200)
* 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 (bug#47598).

lisp/progmodes/cperl-mode.el
test/lisp/progmodes/cperl-mode-tests.el

index bff3e60e90e7fa78428e6805b4a764f71464d918..fa384bcad68757c38c308046f53dc7e66a2003db 100644 (file)
@@ -3585,7 +3585,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                "\\<\\(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 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                ;; 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 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                (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 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                               ;; 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 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                           (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 @@ $~        The name of the current report format.
 ... >= ...     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.
index 9867aa884c67fe709e1c61015a1ebd4e087548d2..7cdfa45d6f735e96edb462ca227f56ea345d94ed 100644 (file)
@@ -524,4 +524,31 @@ however, must not happen when the keyword occurs in a variable
     ;; No block should have been created here
     (should-not (search-forward-regexp "{" nil t))))
 
+(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