From 792f23db44a04db179921e72b11634e03d04ebb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Harald=20J=C3=B6rg?= Date: Wed, 3 Mar 2021 14:07:44 +0100 Subject: [PATCH] ; cperl-mode: fix indentation issues MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/progmodes/cperl-mode.el (cperl-core-named-block-keywords), (cperl-bare-block-keywords): New variables to allow adding new keywords without mangling regular expressions.. (cperl--label-rx), (cperl--false-label-rx) and more: String regexps are replaced by rx forms, errors reported by relint are fixed. (thanks Mattias Engdegård!) (cperl-block-declaration-p): New function to replace several inconsistent regexps. (cperl-beginning-of-defun): New function to capture lexical subs and functions where the opening brace is on a line of its own (or even separated by attributes, signatures etc.) (cperl-maybe-white-and-comment-rex), (cperl-white-and-comment-rex): Now implemented in terms of rx-forms. (cperl-after-sub-regexp): Deleted, no more used. (cperl-imenu--function-name-regexp-perl): Deleted, no more used. (cperl-indent-line): Use the new rx-forms. (cperl-sniff-for-indent): Use the new rx-formxs. (cperl-after-block-p): Use the new keyword lists. (cperl-init-faces): Replace literal regexps by rx forms. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-indent-region): New indentation test for lexical subroutines and packages with version and/or blocks. (cperl-test-ws+-rx): Test the rx S-expression instead of the string regexp. * test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl: New testcases for indenting labels and "new style" packages. * test/lisp/progmodes/cperl-mode-resources/cperl-indent-region.pl: New file for indentation tests spanning more than one expression. --- lisp/progmodes/cperl-mode.el | 396 ++++++++++-------- .../cperl-mode-resources/cperl-indent-exp.pl | 76 ++++ .../cperl-indent-region.pl | 118 ++++++ test/lisp/progmodes/cperl-mode-tests.el | 14 +- 4 files changed, 430 insertions(+), 174 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/cperl-indent-region.pl diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 6b22228397..d2788da625 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1212,73 +1212,98 @@ cperl-menu ;; minimalistic Perl grammar, to be used instead of individual (and ;; not always consistent) literal regular expressions. -(defconst cperl--basic-identifier-regexp - (rx (sequence (or alpha "_") (* (or word "_")))) - "A regular expression for the name of a \"basic\" Perl variable. +;; Perl Keyword sets +;; These might be extended by extension modules or future Perl +;; versions. Therefore it should be possible to change the values +;; at runtime, or even: for one CPerl mode buffer. +(defconst cperl-core-named-block-keywords + '("BEGIN" "CHECK" "END" "INIT" "UNITCHECK" + ;; These two _should_ be following a sub statement, but are + ;; actually valid Perl without. + "DESTROY" "AUTOLOAD") + "These keywords introduce a block which ends a statement + without 'sub', and without a semicolon. This affects + indentation.") + +(defconst cperl-bare-block-keywords + (append cperl-core-named-block-keywords + '("else" + ;; FIXME: The next keywords have been taken over from + ;; history. Do they really belong here? - haj 2021-02-25 + "grep" "map" + ;; FIXME: The following keywords are not Perl core + ;; and there are subtle syntactical differences between + ;; different extensions providing them - haj 2021-02-25 + "try" "catch" "continue")) + "Keywords which are directly followed by a block.") + +(eval-and-compile + (defconst cperl--ws-rx + '(sequence (or space "\n")) + "Regular expression for a single whitespace in Perl.") + + (defconst cperl--eol-comment-rx + '(sequence "#" (0+ (not (in "\n"))) "\n") + "Regular expression for a single end-of-line comment in Perl") + + (defconst cperl--ws-or-comment-rx + '(or (eval cperl--ws-rx) + (eval cperl--eol-comment-rx)) + "A regular expression for either whitespace or comment") + + (defconst cperl--ws*-rx + '(0+ (eval cperl--ws-or-comment-rx)) + "Regular expression for optional whitespaces or comments in Perl") + + (defconst cperl--ws+-rx + '(1+ (eval cperl--ws-or-comment-rx)) + "Regular expression for a sequence of whitespace and comments in Perl.") + + (defconst cperl--basic-identifier-rx + '(sequence (or alpha "_") (* (or word "_"))) + "A regular expression for the name of a \"basic\" Perl variable. Neither namespace separators nor sigils are included. As is, this regular expression applies to labels,subroutine calls where the ampersand sigil is not required, and names of subroutine attributes.") -(defconst cperl--label-regexp - (rx-to-string - `(sequence - symbol-start - (regexp ,cperl--basic-identifier-regexp) - (0+ space) - ":")) - "A regular expression for a Perl label. + (defconst cperl--label-rx + '(sequence symbol-start + (eval cperl--basic-identifier-rx) + (0+ space) + ":") + "A regular expression for a Perl label. By convention, labels are uppercase alphabetics, but this isn't enforced.") -(defconst cperl--normal-identifier-regexp - (rx-to-string - `(or - (sequence - (1+ (sequence - (opt (regexp ,cperl--basic-identifier-regexp)) - "::")) - (opt (regexp ,cperl--basic-identifier-regexp))) - (regexp ,cperl--basic-identifier-regexp))) - "A regular expression for a Perl variable name with optional namespace. + (defconst cperl--false-label-rx + '(sequence (or (in "sym") "tr") (0+ space) ":") + "A regular expression which is similar to a label, but might as + well be a quote-like operator with a colon as delimiter.") + + (defconst cperl--normal-identifier-rx + '(or (sequence (1+ (sequence + (opt (eval cperl--basic-identifier-rx)) + "::")) + (opt (eval cperl--basic-identifier-rx))) + (eval cperl--basic-identifier-rx)) + "A regular expression for a Perl variable name with optional namespace. Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that is a legal variable name).") -(defconst cperl--special-identifier-regexp - (rx-to-string - `(or - (1+ digit) ; $0, $1, $2, ... - (sequence "^" (any "A-Z" "]^_?\\")) ; $^V - (sequence "{" (0+ space) ; ${^MATCH} - "^" (any "A-Z" "]^_?\\") - (0+ (any "A-Z" "_" digit)) - (0+ space) "}") - (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or ${ - "The list of Perl \"punctuation\" variables, as listed in perlvar.") - -(defconst cperl--ws-regexp - (rx-to-string - '(or space "\n")) - "Regular expression for a single whitespace in Perl.") - -(defconst cperl--eol-comment-regexp - (rx-to-string - '(sequence "#" (0+ (not (in "\n"))) "\n")) - "Regular expression for a single end-of-line comment in Perl") - -(defconst cperl--ws-or-comment-regexp - (rx-to-string - `(1+ - (or - (regexp ,cperl--ws-regexp) - (regexp ,cperl--eol-comment-regexp)))) - "Regular expression for a sequence of whitespace and comments in Perl.") - -(defconst cperl--ows-regexp - (rx-to-string - `(opt (regexp ,cperl--ws-or-comment-regexp))) - "Regular expression for optional whitespaces or comments in Perl") - + (defconst cperl--special-identifier-rx + '(or + (1+ digit) ; $0, $1, $2, ... + (sequence "^" (any "A-Z" "]^_?\\")) ; $^V + (sequence "{" (0+ space) ; ${^MATCH} + "^" (any "A-Z" "]^_?\\") + (0+ (any "A-Z" "_" digit)) + (0+ space) "}") + (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~")) ; $., $|, $", ... but not $^ or ${ + "The list of Perl \"punctuation\" variables, as listed in perlvar.")) + +;; This is left as a string regexp. There are many version schemes in +;; the wild, so people might want to fiddle with this variable. (defconst cperl--version-regexp (rx-to-string `(or @@ -1296,11 +1321,11 @@ cperl--package-regexp `(sequence "package" ; FIXME: the "class" and "role" keywords need to be ; recognized soon...ish. - (regexp ,cperl--ws-or-comment-regexp) - (group (regexp ,cperl--normal-identifier-regexp)) + (eval cperl--ws+-rx) + (group (eval cperl--normal-identifier-rx)) (opt (sequence - (regexp ,cperl--ws-or-comment-regexp) + (eval cperl--ws+-rx) (group (regexp ,cperl--version-regexp)))))) "A regular expression for package NAME VERSION in Perl. Contains two groups for the package name and version.") @@ -1309,7 +1334,7 @@ cperl--package-for-imenu-regexp (rx-to-string `(sequence (regexp ,cperl--package-regexp) - (regexp ,cperl--ows-regexp) + (eval cperl--ws*-rx) (group (or ";" "{")))) "A regular expression to collect package names for `imenu`. Catches \"package NAME;\", \"package NAME VERSION;\", \"package @@ -1321,19 +1346,28 @@ cperl--sub-name-regexp (rx-to-string `(sequence (optional (sequence (group (or "my" "state" "our")) - (regexp ,cperl--ws-or-comment-regexp))) + (eval cperl--ws+-rx))) "sub" ; FIXME: the "method" and maybe "fun" keywords need to be ; recognized soon...ish. - (regexp ,cperl--ws-or-comment-regexp) - (group (regexp ,cperl--normal-identifier-regexp)))) + (eval cperl--ws+-rx) + (group (eval cperl--normal-identifier-rx)))) "A regular expression to detect a subroutine start. Contains two groups: One for to distinguish lexical from \"normal\" subroutines and one for the subroutine name.") -(defconst cperl--pod-heading-regexp +(defconst cperl--block-declaration-regexp (rx-to-string `(sequence - line-start "=head" + (or "package" "sub") ; "class" and "method" coming soon + (1+ (eval cperl--ws-or-comment-rx)) + (eval cperl--normal-identifier-rx))) + "A regular expression to find a declaration for a named block. +Used for indentation. These declarations introduce a block which +does not need a semicolon to terminate the statement.") + +(defconst cperl--pod-heading-regexp + (rx-to-string + `(sequence line-start "=head" (group (in "1-4")) (1+ (in " \t")) (group (1+ (not (in "\n")))) @@ -1346,61 +1380,84 @@ cperl--imenu-entries-regexp (rx-to-string `(or (regexp ,cperl--package-for-imenu-regexp) ; 1..3 - (regexp ,cperl--sub-name-regexp) ; 4..5 + (regexp ,cperl--sub-name-regexp) ; 4..5 (regexp ,cperl--pod-heading-regexp))) ; 6..7 "A regular expression to collect stuff that goes into the `imenu` index. Covers packages, subroutines, and POD headings.") +(defun cperl-block-declaration-p () + "Tests whether the following ?\\{ opens a declaration block. +Returns the column where the declarating keyword is found, or nil +if this isn't a declaration block. Declaration blocks are named +subroutines, packages and the like. They start with a keyword +and a name, to be followed by various descriptive items which are +just skipped over for our purpose." + ;; A scan error means that none of the declarators has been found + (condition-case nil + (let ((is-block-declaration nil) + (continue-searching t)) + (while (and continue-searching (not (bobp))) + (forward-sexp -1) + (cond + ((looking-at cperl--block-declaration-regexp) + (setq is-block-declaration (current-column) + continue-searching nil)) + ;; Another brace means this is no block declaration + ((looking-at "{") + (setq continue-searching nil)) + (t + (cperl-backward-to-noncomment (point-min)) + ;; A semicolon or an opening brace prevent this block from + ;; being a block declaration + (when (or (eq (preceding-char) ?\;) + (eq (preceding-char) ?{)) + (setq continue-searching nil))))) + is-block-declaration) + (error nil))) + +(defun cperl-beginning-of-defun (&optional arg) + "Move backward to the beginning of a subroutine or package ARG times. +If point is within a function, then go to the line where its +definition starts. If point is outside of a function but within +a package, go to the first line of the package. Returns t if the +search succeeded. If there's neither a package nor a subroutine +around point, leaves point undhanged and returns nil. This +function ignores `open-paren-in-column-0-is-defun-start', +and also ignores ARG. + +This is the substitute for `beginning-of-defun-raw', so it does +not jump to the beginning of the line where the target was +found." + (interactive "^p") + (unless arg (setq arg 1)) + (let ((state (syntax-ppss (point)))) + (catch 'done + (dolist (paren-pos (reverse (nth 9 state))) + (when (char-equal (char-after paren-pos) ?{) + (goto-char paren-pos) + (when (cperl-block-declaration-p) + (throw 'done t)))) + (re-search-backward + (rx-to-string `(sequence line-start + (regexp ,cperl--package-regexp))) + nil 'move)))) + + ;; These two must be unwound, otherwise take exponential time -(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" +(defconst cperl-maybe-white-and-comment-rex + (rx-to-string `(group (eval cperl--ws*-rx))) + ;; was: "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. Should contain exactly one group.") ;; This one is tricky to unwind; still very inefficient... -(defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+" +(defconst cperl-white-and-comment-rex + (rx-to-string `(group (eval cperl--ws+-rx))) + ;; was: "\\([ \t\n]\\|#[^\n]*\n\\)+" "Regular expression to match whitespace with interspersed comments. Should contain exactly one group.") - -;; Is incorporated in `cperl-outline-regexp', `defun-prompt-regexp'. -;; Details of groups in this may be used in several functions; see comments -;; near mentioned above variable(s)... -;; sub($$):lvalue{} sub:lvalue{} Both allowed... -(defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr... - "Match the text after `sub' in a subroutine declaration. -If NAMED is nil, allows anonymous subroutines. Matches up to the first \":\" -of attributes (if present), or end of the name or prototype (whatever is -the last)." - (concat ; Assume n groups before this... - "\\(" ; n+1=name-group - cperl-white-and-comment-rex ; n+2=pre-name - "\\(::[a-zA-Z_0-9:']+\\|[a-zA-Z_'][a-zA-Z_0-9:']*\\)" ; n+3=name - "\\)" ; END n+1=name-group - (if named "" "?") - "\\(" ; n+4=proto-group - cperl-maybe-white-and-comment-rex ; n+5=pre-proto - "\\(([^()]*)\\)" ; n+6=prototype - "\\)?" ; END n+4=proto-group - "\\(" ; n+7=attr-group - cperl-maybe-white-and-comment-rex ; n+8=pre-attr - "\\(" ; n+9=start-attr - ":" - (if attr (concat - "\\(" - cperl-maybe-white-and-comment-rex ; whitespace-comments - "\\(\\sw\\|_\\)+" ; attr-name - ;; attr-arg (1 level of internal parens allowed!) - "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?" - "\\(" ; optional : (XXX allows trailing???) - cperl-maybe-white-and-comment-rex ; whitespace-comments - ":\\)?" - "\\)+") - "[^:]") - "\\)" - "\\)?" ; END n+6=proto-group - )) - ;; Tired of editing this in 8 places every time I remember that there ;; is another method-defining keyword (defvar cperl-sub-keywords @@ -1414,28 +1471,8 @@ cperl-char-ends-sub-keyword-p when (eq char (aref keyword (1- (length keyword)))) return t)) -;; Details of groups in this are used in `cperl-imenu--create-perl-index' -;; and `cperl-outline-level'. -;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) -(defvar cperl-imenu--function-name-regexp-perl - (concat - "^\\(" ; 1 = all - "\\([ \t]*package" ; 2 = package-group - "\\(" ; 3 = package-name-group - cperl-white-and-comment-rex ; 4 = pre-package-name - "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name - "\\|" - "[ \t]*" - cperl-sub-regexp - (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start - cperl-maybe-white-and-comment-rex ; 15=pre-block - "\\|" - "=head\\([1-4]\\)[ \t]+" ; 16=level - "\\([^\n]+\\)$" ; 17=text - "\\)")) - (defvar cperl-outline-regexp - (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`")) + (concat "^[ \t]*" cperl--imenu-entries-regexp "\\|" "\\`")) (defvar cperl-mode-syntax-table nil "Syntax table in use in CPerl mode buffers.") @@ -1713,20 +1750,11 @@ cperl-mode (setq-local comment-end "") (setq-local comment-column cperl-comment-column) (setq-local comment-start-skip "#+ *") - -;; "[ \t]*sub" -;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start -;; cperl-maybe-white-and-comment-rex ; 15=pre-block - (setq-local defun-prompt-regexp - (concat "^[ \t]*\\(" - cperl-sub-regexp - (cperl-after-sub-regexp 'named 'attr-groups) - "\\|" ; per toke.c - "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)" - "\\)" - cperl-maybe-white-and-comment-rex)) (setq-local comment-indent-function #'cperl-comment-indent) + + (setq-local beginning-of-defun-function #'cperl-beginning-of-defun) (setq-local fill-paragraph-function #'cperl-fill-paragraph) + (setq-local parse-sexp-ignore-comments t) (setq-local indent-region-function #'cperl-indent-region) ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off! @@ -2523,8 +2551,9 @@ cperl-indent-line (t (skip-chars-forward " \t") (if (listp indent) (setq indent (car indent))) - (cond ((and (looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]") - (not (looking-at "[smy]:\\|tr:"))) + (cond ((and (looking-at (rx (sequence (eval cperl--label-rx) + (not (in ":"))))) + (not (looking-at (rx (eval cperl--false-label-rx))))) (and (> indent 0) (setq indent (max cperl-min-label-indent (+ indent cperl-label-offset))))) @@ -2716,6 +2745,8 @@ cperl-sniff-for-indent (and (eq (preceding-char) ?\}) (cperl-after-block-and-statement-beg (point-min))) ; Was start - too close + (and char-after (char-equal char-after ?{) + (save-excursion (cperl-block-declaration-p))) (memq char-after (append ")]}" nil)) (and (eq (preceding-char) ?\:) ; label (progn @@ -2759,12 +2790,10 @@ cperl-sniff-for-indent ;; Back up over label lines, since they don't ;; affect whether our line is a continuation. ;; (Had \, too) - (while;;(or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (or;;(eq (char-after (- (point) 2)) ?\') ; ???? - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_)))) - ;;) + (while (and (eq (preceding-char) ?:) + (re-search-backward + (rx (sequence (eval cperl--label-rx) point)) + nil t)) ;; This is always FALSE? (if (eq (preceding-char) ?\,) ;; Will go to beginning of line, essentially. @@ -2776,6 +2805,7 @@ cperl-sniff-for-indent (if (not (or (eq (1- (point)) containing-sexp) (and cperl-indent-parens-as-block (not is-block)) + (save-excursion (cperl-block-declaration-p)) (memq (preceding-char) (append (if is-block " ;{" " ,;{") '(nil))) (and (eq (preceding-char) ?\}) @@ -2804,10 +2834,17 @@ cperl-sniff-for-indent (forward-char 1) (let ((colon-line-end 0)) (while - (progn (skip-chars-forward " \t\n") - ;; s: foo : bar :x is NOT label - (and (looking-at "#\\|\\([a-zA-Z0-9_$]+\\):[^:]\\|=[a-zA-Z]") - (not (looking-at "[sym]:\\|tr:")))) + (progn + (skip-chars-forward " \t\n") + ;; s: foo : bar :x is NOT label + (and (looking-at + (rx + (or "#" + (sequence (eval cperl--label-rx) + (not (in ":"))) + (sequence "=" (in "a-zA-Z"))))) + (not (looking-at + (rx (eval cperl--false-label-rx)))))) ;; Skip over comments and labels following openbrace. (cond ((= (following-char) ?\#) (forward-line 1)) @@ -3066,7 +3103,10 @@ cperl-calculate-indent ;; If line starts with label, calculate label indentation (if (save-excursion (beginning-of-line) - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) + (looking-at (rx + (sequence (0+ space) + (eval cperl--label-rx) + (not (in ":")))))) (if (> (current-indentation) cperl-min-label-indent) (- (current-indentation) cperl-label-offset) ;; Do not move `parse-data', this should @@ -4645,15 +4685,19 @@ cperl-backward-to-noncomment (if (< p (point)) (goto-char p)) (setq stop t)))))) -;; Used only in `cperl-calculate-indent'... +;; Used only in `cperl-sniff-for-indent'... (defun cperl-block-p () - "Point is before ?\\{. Checks whether it starts a block." + "Point is before ?\\{. Returns true if it starts a block." ;; No save-excursion! This is more a distinguisher of a block/hash ref... (cperl-backward-to-noncomment (point-min)) (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp ; Label may be mixed up with `$blah :' (save-excursion (cperl-after-label)) + ;; text with the 'attrib-group property is also covered by the + ;; next clause. We keep it because it is faster (for + ;; subroutines with attributes). (get-text-property (cperl-1- (point)) 'attrib-group) + (save-excursion (cperl-block-declaration-p)) (and (memq (char-syntax (preceding-char)) '(?w ?_)) (progn (backward-sexp) @@ -4691,20 +4735,16 @@ cperl-after-block-p (save-excursion (cperl-after-label)) ;; sub :attr {} (get-text-property (cperl-1- (point)) 'attrib-group) + (save-excursion (cperl-block-declaration-p)) (if (memq (char-syntax (preceding-char)) '(?w ?_)) ; else {} (save-excursion (forward-sexp -1) ;; else {} but not else::func {} - (or (and (looking-at "\\(else\\|catch\\|try\\|continue\\|grep\\|map\\|BEGIN\\|END\\|UNITCHECK\\|CHECK\\|INIT\\)\\>") - (not (looking-at "\\(\\sw\\|_\\)+::"))) - ;; sub f {} - (progn - (cperl-backward-to-noncomment lim) - (and (cperl-char-ends-sub-keyword-p (preceding-char)) - (progn - (forward-sexp -1) - (looking-at - (concat cperl-sub-regexp "[ \t\n\f#]"))))))) + (or (and (looking-at + (rx-to-string `(sequence + (eval (cons 'or cperl-bare-block-keywords)) + word-end))) + (not (looking-at "\\(\\sw\\|_\\)+::"))))) ;; What precedes is not word... XXXX Last statement in sub??? (cperl-after-expr-p lim)))) (error nil)))) @@ -5326,9 +5366,9 @@ cperl-imenu--create-perl-index (setq current-package-end (save-excursion (goto-char (match-beginning 3)) (forward-sexp) - (point))) + (point)))) (push (cons name marker) index-package-alist) - (push (cons (concat "package " name) marker) index-unsorted-alist)))) + (push (cons (concat "package " name) marker) index-unsorted-alist))) ((match-string 5) ; found a sub name! (unless (nth 4 state) ; skip if in a comment (setq name (match-string-no-properties 5) @@ -5592,10 +5632,24 @@ cperl-init-faces 2 font-lock-string-face t))) '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) - '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 - font-lock-constant-face) ; labels - '("\\<\\(continue\\|next\\|last\\|redo\\|break\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets - 2 font-lock-constant-face) + ;; labels + `(,(rx-to-string + `(sequence + (0+ space) + (group (eval cperl--label-rx)) + (0+ space) + (or line-end "#" "{" + (sequence word-start + (or "until" "while" "for" "foreach" "do") + word-end)))) + 1 font-lock-constant-face) + ;; labels as targets (no trailing colon!) + `(,(rx-to-string + '(sequence + (or "continue" "next" "last" "redo" "break" "goto") + (0+ space) + (group (eval cperl--basic-identifier-rx)))) + 1 font-lock-constant-face) ;; Uncomment to get perl-mode-like vars ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl index 8c1883a10f..33d0d7942e 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-exp.pl @@ -50,3 +50,79 @@ quuux; } # -------- if-then-else: end -------- + +# -------- labels: input -------- +{ +LABEL: +for (0..1) { +next LABEL if $_; +unless ($_) last LABEL; +} +LABEL_WITH_SPACE : +while (1) { +last LABEL_WITH_SPACE; +} +LABEL_WITH_COMMENT : # explain that label +say "This label has a comment." +} +# -------- labels: expected output -------- +{ + LABEL: + for (0..1) { + next LABEL if $_; + unless ($_) last LABEL; + } + LABEL_WITH_SPACE : + while (1) { + last LABEL_WITH_SPACE; + } + LABEL_WITH_COMMENT : # explain that label + say "This label has a comment." +} +# -------- labels: end -------- + +# -------- packages: input -------- +package Foo { +package Foo::Inner::One { +...; +} +package Foo::Inner::Two { +...; +} +} +# -------- packages: expected output -------- +package Foo { + package Foo::Inner::One { + ...; + } + package Foo::Inner::Two { + ...; + } +} +# -------- packages: end -------- + +# -------- braces after newline: input -------- +package Outer { +package Inner +{ +sub foo +{ +} +sub bar +{ +} +} +} +# -------- braces after newline: expected output -------- +package Outer { + package Inner + { + sub foo + { + } + sub bar + { + } + } +} +# -------- braces after newline: end -------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indent-region.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-region.pl new file mode 100644 index 0000000000..219d5292ca --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indent-region.pl @@ -0,0 +1,118 @@ +#!/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-test-indent-region. The code is +# syntactically valid, but doesn't make much sense. + +# (Bug#11733) https://debbugs.gnu.org/cgi/bugreport.cgi?bug=11733 +# -------- sub \n brace: input -------- +sub foo + { + } + +sub bar + { + } +# -------- sub \n brace: expected output -------- +sub foo +{ +} + +sub bar +{ +} +# -------- sub \n brace: end -------- + +# -------- map \n brace: input -------- +{ +my %hash = map +{ +$_ = 1 +} +@_; +} +# -------- map \n brace: expected output -------- +{ + my %hash = map + { + $_ = 1 + } + @_; +} +# -------- map \n brace: end -------- + +# -------- if \n brace: input -------- +if (1 == @_) + { + say "one argument"; + } else { + say "No arguments, or plenty"; + } +# -------- if \n brace: expected output -------- +if (1 == @_) { + say "one argument"; +} else { + say "No arguments, or plenty"; +} +# -------- if \n brace: end -------- + +# -------- simple sub: input -------- +sub middle { + my ($left,$right) = @_; + return 0.5 * ($left + $right); +} +$this_should_be_justified = 'left'; +# -------- simple sub: expected output -------- +sub middle { + my ($left,$right) = @_; + return 0.5 * ($left + $right); +} +$this_should_be_justified = 'left'; +# -------- simple sub: end -------- + +# ------- hash reference: input -------- +my $result = { ok => 'true' } + if ($this_should_be_indented == 'cperl-continued-statement-offset'); +# ------- hash reference: expected output -------- +my $result = { ok => 'true' } + if ($this_should_be_indented == 'cperl-continued-statement-offset'); +# ------- hash reference: end -------- + +# The following syntax was introduced in Perl v5.14: +# ------- package BLOCK: input -------- +package Puck { +our $cperl_indent_level = 4; +} +our $good_indentation = 0; +# ------- package BLOCK: expected output -------- +package Puck { + our $cperl_indent_level = 4; +} +our $good_indentation = 0; +# ------- package BLOCK: end -------- + +# as of Perl 5.18, subroutines can be lexical +# -------- simple sub: input -------- +package Pick 1.23 { + my sub middle { + my ($left,$right) = @_; + return 0.5 * ($left + $right); + $this_should_be_indented = + $cperl_indent_level; + } +} +$this_should_be_justified = 'left'; +# -------- simple sub: expected output -------- +package Pick 1.23 { + my sub middle { + my ($left,$right) = @_; + return 0.5 * ($left + $right); + $this_should_be_indented = + $cperl_indent_level; + } +} +$this_should_be_justified = 'left'; +# -------- simple sub: end -------- diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 61e4ece49b..1bcc41ab9f 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -103,6 +103,14 @@ cperl-test-indent-exp (ert-resource-file "cperl-indent-exp.pl") (cperl-indent-exp))) ; here we go! +(ert-deftest cperl-test-indent-region () + "Test indenting of regions which can span more than one +expression." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (cperl--run-test-cases + (ert-resource-file "cperl-indent-region.pl") + (indent-region (point-min) (point-max)))) + (ert-deftest cperl-test-indent-styles () (skip-unless (eq cperl-test-mode #'cperl-mode)) (cperl--run-test-cases @@ -189,17 +197,17 @@ cperl-test-ws-regexp '(" " "\t" "\n")) (invalid '("a" " " ""))) - (cperl-test--validate-regexp cperl--ws-regexp + (cperl-test--validate-regexp (rx (eval cperl--ws-rx)) valid invalid))) -(ert-deftest cperl-test-ws-or-comment-regexp () +(ert-deftest cperl-test-ws+-rx () "Tests sequences of whitespace and comment lines." (let ((valid `(" " "\t#\n" "\n# \n" ,(concat "# comment\n" "# comment\n" "\n" "#comment\n"))) (invalid '("=head1 NAME\n" ))) - (cperl-test--validate-regexp cperl--ws-or-comment-regexp + (cperl-test--validate-regexp (rx (eval cperl--ws+-rx)) valid invalid))) (ert-deftest cperl-test-version-regexp () -- 2.20.1