** CPerl Mode
+---
+*** New face 'perl-heredoc', used for heredoc elements.
+
---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
;; disambiguate with the left-bitshift operator.
"\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
- (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table))
+ (4 (let* ((eol (match-beginning 4))
+ (st (get-text-property eol 'syntax-table))
(name (match-string 2))
(indented (match-beginning 1)))
(goto-char (match-end 2))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ ;; '<<' occurred in a string, or in a comment.
;; Leave the property of the newline unchanged.
st
+ ;; Beware of `foo <<'BAR' #baz` because
+ ;; the newline needs to start the here-doc
+ ;; and can't be used to close the comment.
+ (let ((eol-state (save-excursion (syntax-ppss eol))))
+ (when (nth 4 eol-state)
+ (if (/= (1- eol) (nth 8 eol-state))
+ ;; make the last char of the comment closing it
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax ">"))
+ ;; In `foo <<'BAR' #` the # is the last character
+ ;; before eol and can't both open and close the
+ ;; comment. Workaround: disguise the "#" as
+ ;; whitespace and fontify it as a comment.
+ (put-text-property (1- eol) eol
+ 'syntax-table (string-to-syntax "-"))
+ (put-text-property (1- eol) eol
+ 'font-lock-face
+ 'font-lock-comment-face))))
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
(cons (cons (pcase (aref name 0)
;; as twoarg).
(perl-syntax-propertize-special-constructs limit)))))))))
+(defface perl-heredoc
+ '((t (:inherit font-lock-string-face)))
+ "The face for here-documents. Inherits from font-lock-string-face.")
+
(defun perl-font-lock-syntactic-face-function (state)
(cond
+ ((and (eq 2 (nth 7 state)) ; c-style comment
+ (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) ; HERE doc
+ 'perl-heredoc)
((and (nth 3 state)
(eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
;; This is a second-arg of s{..}{...} form; let's check if this second
--- /dev/null
+use 5.020;
+
+=head1 NAME
+
+here-docs.pl - resource file for cperl-test-here-docs
+
+=head1 DESCRIPTION
+
+This file holds a couple of HERE documents, with a variety of normal
+and edge cases. For a formatted view of this description, run:
+
+ (cperl-perldoc "here-docs.pl")
+
+For each of the HERE documents, the following checks will done:
+
+=over 4
+
+=item *
+
+All occurrences of the string "look-here" are fontified correcty.
+Note that we deliberately test the face, not the syntax property:
+Users won't care for the syntax property, but they see the face.
+Different implementations with different syntax properties have been
+seen in the past.
+
+=item *
+
+Indentation of the line(s) containing "look-here" is 0, i.e. there are no
+leading spaces.
+
+=item *
+
+Indentation of the following perl statement containing "indent" should
+be 0 if the statement contains "noindent", and according to the mode's
+continued-statement-offset otherwise.
+
+=back
+
+=cut
+
+# Prologue to make the test file valid without warnings
+
+my $text;
+my $any;
+my $indentation;
+my $anywhere = 'back again';
+my $noindent;
+
+=head1 The Tests
+
+=head2 Test Case 1
+
+We have two HERE documents in one line with different quoting styles.
+
+=cut
+
+## test case
+
+$text = <<"HERE" . <<'THERE' . $any;
+#look-here and
+HERE
+$tlook-here and
+THERE
+
+$noindent = "This should be left-justified";
+
+=head2 Test case 2
+
+A HERE document followed by a continuation line
+
+=cut
+
+## test case
+
+$text = <<HERE
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 3
+
+A here document with a line-end comment in the starter line,
+after a complete statement
+
+=cut
+
+## test case
+
+$text = <<HERE; # start here
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 4
+
+A HERE document with a to-be-continued statement and a comment in the
+starter line.
+
+=cut
+
+## test case
+
+$text = <<HERE # start here
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+=head2 Test case 5
+
+A HERE document with a comment sign, but no comment to follow.
+
+
+=cut
+
+## test case
+
+$text = <<HERE; #
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 6
+
+A HERE document with a comment sign, but no comment to follow, with a
+statement to be continued. Also, the character before the comment
+sign has a relevant syntax property (end of string in our case) which
+must be preserved.
+
+=cut
+
+## test case
+
+$text = <<"HERE"#
+look-here
+HERE
+
+. 'indent-level'; # Continuation, should be indented
+
+__END__
(should (equal (nth 3 (syntax-ppss)) nil))
(should (equal (nth 4 (syntax-ppss)) t))))))
+(ert-deftest cperl-test-heredocs ()
+ "Test that HERE-docs are fontified with the appropriate face."
+ (require 'perl-mode)
+ (let ((file (ert-resource-file "here-docs.pl"))
+ (cperl-continued-statement-offset perl-continued-statement-offset)
+ (target-font (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc
+ 'font-lock-string-face))
+ (case-fold-search nil))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (funcall cperl-test-mode)
+ (indent-region (point-min) (point-max))
+ (font-lock-ensure (point-min) (point-max))
+ (while (search-forward "## test case" nil t)
+ (save-excursion
+ (while (search-forward "look-here" nil t)
+ (should (equal
+ (get-text-property (match-beginning 0) 'face)
+ target-font))
+ (beginning-of-line)
+ (should (null (looking-at "[ \t]")))
+ (forward-line 1)))
+ (should (re-search-forward
+ (concat "^\\([ \t]*\\)" ; the actual indentation amount
+ "\\([^ \t\n].*?\\)\\(no\\)?indent")
+ nil t))
+ (should (equal (- (match-end 1) (match-beginning 1))
+ (if (match-beginning 3) 0
+ perl-indent-level)))))))
+
;;; Tests for issues reported in the Bug Tracker
(defun cperl-test--run-bug-10483 ()
(interactive)
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
(skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
(let* ((emacs (concat invocation-directory invocation-name))
(test-function 'cperl-test--run-bug-10483)
(test-function-name (symbol-name test-function))
projects / emacs.git / commitdiff