diff options
Diffstat (limited to 'test/lisp/progmodes')
36 files changed, 3409 insertions, 231 deletions
diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 790582aed4c..e5b207748bf 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -25,6 +25,7 @@ (require 'bug-reference) (require 'ert) +(require 'ert-x) (defun test--get-github-entry (url) (and (string-match @@ -125,4 +126,18 @@ (test--get-gitea-entry "https://gitea.com/magit/magit/") "magit/magit"))) +(ert-deftest test-thing-at-point () + "Ensure that (thing-at-point 'url) returns the bug URL." + (ert-with-test-buffer (:name "thingatpt") + (setq-local bug-reference-url-format "https://debbugs.gnu.org/%s") + (insert "bug#1234") + (bug-reference-mode) + (jit-lock-fontify-now (point-min) (point-max)) + (goto-char (point-min)) + ;; Make sure we get the URL when `bug-reference-mode' is active... + (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234")) + (bug-reference-mode -1) + ;; ... and get nil when `bug-reference-mode' is inactive. + (should-not (thing-at-point 'url)))) + ;;; bug-reference-tests.el ends here diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 078eef36774..d497644c389 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -121,9 +121,7 @@ ;; cucumber (cucumber "Scenario: undefined step # features/cucumber.feature:3" 29 nil 3 "features/cucumber.feature") - ;; This rule is actually handled by the `cucumber' pattern but when - ;; `omake' is included, then `gnu' matches it first. - (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" + (cucumber " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'" 1 nil 500 "/home/gusev/.rvm/foo/bar.rb") ;; edg-1 edg-2 (edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier \"foo\" is undefined" @@ -312,10 +310,6 @@ 1 nil 109 "..\\src\\ctrl\\lister.c") (watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code" 1 nil 120 "..\\src\\ctrl\\lister.c") - ;; omake - ;; FIXME: This doesn't actually test the omake rule. - (gnu " alpha.c:5:15: error: expected ';' after expression" - 1 15 5 "alpha.c") ;; oracle (oracle "Semantic error at line 528, column 5, file erosacqdb.pc:" 1 5 528 "erosacqdb.pc") @@ -497,8 +491,22 @@ The test data is in `compile-tests--test-regexps-data'." (font-lock-mode -1) (let ((compilation-num-errors-found 0) (compilation-num-warnings-found 0) - (compilation-num-infos-found 0)) - (mapc #'compile--test-error-line compile-tests--test-regexps-data) + (compilation-num-infos-found 0) + (all-rules (mapcar #'car compilation-error-regexp-alist-alist))) + + ;; Test all built-in rules except `omake' to avoid interference. + (let ((compilation-error-regexp-alist (remq 'omake all-rules))) + (mapc #'compile--test-error-line compile-tests--test-regexps-data)) + + ;; Test the `omake' rule separately. + ;; This doesn't actually test the `omake' rule itself but its + ;; indirect effects. + (let ((compilation-error-regexp-alist all-rules) + (test + '(gnu " alpha.c:5:15: error: expected ';' after expression" + 1 15 5 "alpha.c"))) + (compile--test-error-line test)) + (should (eq compilation-num-errors-found 100)) (should (eq compilation-num-warnings-found 35)) (should (eq compilation-num-infos-found 28))))) diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl new file mode 100644 index 00000000000..a474e431222 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-11733.pl @@ -0,0 +1,50 @@ +# This resource file can be run with cperl--run-testcases from +# cperl-tests.el and works with both perl-mode and cperl-mode. + +# -------- Multiline declaration: input ------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +sub foo + { + } + +sub bar + { + } +# -------- Multiline declaration: expected output ------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +sub foo +{ +} + +sub bar +{ +} +# -------- Multiline declaration: end ------- + +# -------- Fred Colon at work: input -------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +while (<>) +{ +m:^ \d+ p: +or die; +m:^ \d+ : +or die; +} +# -------- Fred Colon at work: expected output -------- +#!/usr/bin/env perl +# -*- mode: cperl -*- + +while (<>) + { + m:^ \d+ p: + or die; + m:^ \d+ : + or die; + } +# -------- Fred Colon at work: end -------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl new file mode 100644 index 00000000000..e3f96241ab7 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl @@ -0,0 +1,36 @@ +# This resource file can be run with cperl--run-testcases from +# cperl-tests.el and works with both perl-mode and cperl-mode. + +# -------- Bug#35925: input ------- +format FH = +@### @.### @### +42, 3.1415, 0 +. +write FH; + +# -------- Bug#35925: expected output ------- +format FH = +@### @.### @### +42, 3.1415, 0 +. +write FH; + +# -------- Bug#35925: end ------- + +# -------- format not as top-level: input ------- +foo: { + format STDOUT = +^<<<< +$foo +. +write; +} +# -------- format not as top-level: expected output ------- +foo: { + format STDOUT = +^<<<< +$foo +. + write; +} +# -------- format not as top-level: end ------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64190.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64190.pl new file mode 100644 index 00000000000..c7621e1c47b --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64190.pl @@ -0,0 +1,24 @@ +# Example 1 + +my ($var1, + $var2, + $var3); + +# Example 2 + +package Foo + 0.1; + +# Example 3 (intentionally incomplete, body is inserted by test) + +sub do_stuff + +# Example 4 + +sub do_more_stuff ($param1, +$param2) +{ + ...; +} + +sub oops { ...; } diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl new file mode 100644 index 00000000000..62ef6982f38 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-64364.pl @@ -0,0 +1,55 @@ +# This resource file can be run with cperl--run-testcases from +# cperl-tests.el and works with both perl-mode and cperl-mode. + +# -------- Bug#64364: input ------- +package P { +sub way { ...; } +# +sub bus +:lvalue +($sig,$na,@ture) +{ +...; +} +} +# -------- Bug#64364: expected output ------- +package P { + sub way { ...; } + # + sub bus + :lvalue + ($sig,$na,@ture) + { + ...; + } +} +# -------- Bug#64364: end ------- + +# Now do this with multiline initializers +# -------- signature with init: input ------- +package P { +sub way { ...; } +# perl 5.38 or newer +sub bus +:lvalue +($sig, +$na //= 42, +@ture) +{ +...; +} +} +# -------- signature with init: expected output ------- +package P { + sub way { ...; } + # perl 5.38 or newer + sub bus + :lvalue + ($sig, + $na //= 42, + @ture) + { + ...; + } +} +# -------- signature with init: end ------- diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl new file mode 100644 index 00000000000..775a113ac17 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-65834.pl @@ -0,0 +1,5 @@ +# -*- mode: cperl -*- +if ($t->[3]<<5) { + return 0; +} +# comment diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl new file mode 100644 index 00000000000..70f12346ded --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl @@ -0,0 +1,62 @@ +# The original code, from the bug report, with variables renamed + +sub foo { + # Here we do something like + # this: $array_comment [ num_things ]->{key_comment} +} + +# -------------------------------------------------- +# Comments containing hash and array sigils + +# This is an @array, and this is a %hash +# $array_comment[$index] = $hash_comment{key_comment} +# The last element has the index $#array_comment +# my @a_slice = @array_comment[1,2,3]; +# my @h_slice = @hash_comment{qw(a b c)}; +# my %a_set = %array_comment[1,2,3]; +# my %h_set = %hash_comment{qw(a b c)}; + +# -------------------------------------------------- +# in POD + +=head1 NAME + +cperl-bug-66145 - don't fontify arrays and hashes in POD + +=head1 SYNOPSIS + + $array_comment[$index] = $hash_comment{key_comment}; + @array_comment = qw(in pod); + %hash_comment = key_comment => q(pod); + @array_comment = @array_comment[1,2,3]; + @array_comment = @hash_comment{qw(a b c)}; + %hash_comment = %array_comment[1,2,3]; + %hash_comment = %hash_comment{qw(a b c)}; + +=cut + +# -------------------------------------------------- +# in strings + +my @strings = ( + q/$array_string[$index] = $hash_string{key_string};/, + q/my @array_string = qw(in unquoted string);/, + q/my %hash_string = (key_string => q(pod);)/, + q/@array_string = @array_string[1,2,3];/, + q/@array_string = @hash_string{qw(a b c)};/, + q/%hash_string = %array_string[1,2,3];/, + q/%hash_string = %hash_string{qw(a b c)};/, +); + +# -------------------------------------------------- +# in a HERE-document (perl-mode has an extra face for that) + +my $here = <<DONE; + $array_here[$index_here] = $hash_here{key_here}; + @array_here = qw(in a hrere-document); + %hash_here = key_here => q(pod); + @array_here = @array_here[1,2,3]; + @array_here = @hash_here{qw(a b c)}; + %hash_here = %array_here[1,2,3]; + %hash_here = %hash_here{qw(a b c)}; +DONE diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl new file mode 100644 index 00000000000..e39cfdd3b24 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +print("Hello World\n"); + +__END__ + +TODO: +What's happening? + +It's all messed up. diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts index 6b874ffaa1f..ba35b1d0690 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts @@ -24,3 +24,58 @@ Name: cperl-indents1 ""; } =-=-= + +Name: cperl-try-catch-finally + +=-= +{ + try { + call_a_function(); + } + catch ($e) { + warn "Unable to call; $e"; + } + finally { + print "Finished\n"; + } +} +=-=-= + +Name: cperl-defer + +=-= +use feature 'defer'; + +{ + say "This happens first"; + defer { + say "This happens last"; + } + + say "And this happens inbetween"; +} +=-=-= + +Name: cperl-feature-class + +=-= +use 5.038; +use feature "class"; +no warnings "experimental"; + +class A { +} + +class C + : isa(A) +{ + method with_sig_and_attr + : lvalue + ($top,$down) + { + return $top-$down; + } +} + +say "done!"; +=-=-= diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl index 96a86993082..9420c0d1fa8 100644 --- a/test/lisp/progmodes/cperl-mode-resources/grammar.pl +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -169,4 +169,29 @@ sub erdős_number { } } +=head1 And now, for something completely different + +Perl 5.38 supports classes with the same scope weirdness as packages. +As long as this is experimental, CPAN tools don't play well with this, +so some weird constructs are recommended to authors of CPAN modules. + +=cut + +package Class::Class; + +our $VERSION = 0.01; + +class Class::Class 0.01 { + method init ($with,$signature) { + ...; + } + + class Class::Inner :isa(Class::Class); + # This class comes without a block, so takes over until the rest + # of the containing block. + method init_again (@with_parameters) { + ...; + } +} + 1; diff --git a/test/lisp/progmodes/cperl-mode-resources/perl-class.pl b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl new file mode 100644 index 00000000000..032690d20a5 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl @@ -0,0 +1,19 @@ +use 5.038; +use feature 'class'; +no warnings 'experimental'; + +class A { +} + +class C + : isa(A) +{ + method with_sig_and_attr + : lvalue + ($top,$down) + { + return $top-$down; + } +} + +say "done!"; diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl index 7138bf631df..1f898250252 100644 --- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -12,12 +12,10 @@ no warnings 'experimental::signatures'; # are somewhat frowned upon most of the times, but they are required # for some Perl magic -# FIXME: 2022-02-02 CPerl mode does not handle subroutine signatures. -# In simple cases it mistakes them as prototypes, when attributes are -# present, it doesn't handle them at all. Variables in signatures -# SHOULD be fontified like variable declarations. - # Part 1: Named subroutines +# A plain named subroutine without any optional stuff +sub sub_0 { ...; } + # A prototype and a trivial subroutine attribute { no feature 'signatures'; # that's a prototype, not a signature @@ -30,10 +28,24 @@ sub sub_2 :prototype($) { ...; } # A signature (these will soon-ish leave the experimental state) sub sub_3 ($foo,$bar) { ...; } -# Attribute plus signature FIXME: Not yet supported -sub bad_sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; } +# Attribute plus signature +sub sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; } + +# A signature with a trailing comma (weird, but legal) +sub sub_5 ($foo,$bar,) { ...; } + +# Perl 5.38-style initializer +sub sub_6 + ($foo, + $bar //= "baz") +{ +} + # Part 2: Same constructs for anonymous subs +# A plain named subroutine without any optional stuff +my $subref_0 = sub { ...; }; + # A prototype and a trivial subroutine attribute { no feature 'signatures'; # that's a prototype, not a signature diff --git a/test/lisp/progmodes/cperl-mode-resources/sub-names.pl b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl new file mode 100644 index 00000000000..46d05b4dbd2 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl @@ -0,0 +1,25 @@ +use 5.038; +use feature 'class'; +use warnings; +no warnings 'experimental'; + +class C { + # "method" is not yet understood by perl-mode, but it isn't + # relevant here: We can use "sub" because what matters is the + # name, which collides with a builtin. + sub m { + "m called" + } +} + +say C->new->m; + +# This comment has a method name in it, and we don't want "method" +# to be fontified as a keyword, nor "name" fontified as a name. + +__END__ + +=head1 Test using the keywords POD + +This piece of POD has a method name in it, and we don't want "method" +to be fontified as a keyword, nor "name" fontified as a name. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 9bd250a38b5..0af44c8e08d 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -25,6 +25,10 @@ ;;; Commentary: ;; This is a collection of tests for CPerl-mode. +;; The maintainer would like to use this test file with cperl-mode.el +;; also in older Emacs versions (currently: Emacs 26.1): Please don't +;; use Emacs features which are not available in that version (unless +;; they're already used in existing tests). ;;; Code: @@ -177,14 +181,19 @@ attributes, prototypes and signatures." (should (equal (get-text-property (1+ (match-beginning 0)) 'face) 'font-lock-string-face))) (goto-char start-of-sub) + ;; Attributes with their optional parameters (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t) (should (equal (get-text-property (match-beginning 1) 'face) 'font-lock-constant-face)) (when (match-beginning 2) (should (equal (get-text-property (match-beginning 2) 'face) 'font-lock-string-face)))) + ;; Subroutine signatures + (goto-char start-of-sub) + (when (search-forward "$bar" end-of-sub t) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face))) (goto-char end-of-sub))) - ;; Anonymous subroutines (while (search-forward-regexp "= sub" nil t) (let ((start-of-sub (match-beginning 0)) @@ -201,8 +210,40 @@ attributes, prototypes and signatures." (when (match-beginning 2) (should (equal (get-text-property (match-beginning 2) 'face) 'font-lock-string-face)))) + ;; Subroutine signatures + (goto-char start-of-sub) + (when (search-forward "$bar" end-of-sub t) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-variable-name-face))) (goto-char end-of-sub)))))) +(ert-deftest cperl-test-fontify-class () + "Test fontification of the various elements in a Perl class." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "perl-class.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + + ;; The class name + (while (search-forward-regexp "class " nil t) + (should (equal (get-text-property (point) 'face) + 'font-lock-function-name-face))) + ;; The attributes (class and method) + (while (search-forward-regexp " : " nil t) + (should (equal (get-text-property (point) 'face) + 'font-lock-constant-face))) + ;; The signature + (goto-char (point-min)) + (search-forward-regexp "\\(\\$top\\),\\(\\$down\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-variable-name-face)) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-variable-name-face)) +))) + (ert-deftest cperl-test-fontify-special-variables () "Test fontification of variables like $^T or ${^ENCODING}. These can occur as \"local\" aliases." @@ -219,6 +260,39 @@ These can occur as \"local\" aliases." (should (equal (get-text-property (point) 'face) 'font-lock-variable-name-face)))) +(ert-deftest cperl-test-fontify-sub-names () + "Test fontification of subroutines named like builtins. +On declaration, they should look like other used defined +functions. When called, they should not be fontified. In +comments and POD they should be fontified as POD." + (let ((file (ert-resource-file "sub-names.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + ;; The declaration + (search-forward-regexp "sub \\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-function-name-face)) + ;; calling as a method + (search-forward-regexp "C->new->\\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + (if (equal cperl-test-mode 'perl-mode) nil + 'cperl-method-call))) + ;; POD + (search-forward-regexp "\\(method\\) \\(name\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-comment-face)) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-comment-face)) + ;; comment + (search-forward-regexp "\\(method\\) \\(name\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-comment-face)) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-comment-face))))) + (ert-deftest cperl-test-identify-heredoc () "Test whether a construct containing \"<<\" followed by a bareword is properly identified for a here-document if @@ -306,6 +380,7 @@ issued by CPerl mode." (defvar perl-continued-statement-offset) (defvar perl-indent-level) +(defvar perl-indent-parens-as-block) (defconst cperl--tests-heredoc-face (if (equal cperl-test-mode 'perl-mode) 'perl-heredoc @@ -397,7 +472,7 @@ the whole string." valid invalid))) (ert-deftest cperl-test-package-regexp () - "Tests the regular expression of Perl package names with versions. + "Tests the regular expression of Perl package and class names with versions. Also includes valid cases with whitespace in strange places." (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid @@ -405,13 +480,13 @@ Also includes valid cases with whitespace in strange places." "package Foo::Bar" "package Foo::Bar v1.2.3" "package Foo::Bar::Baz 1.1" + "class O3D::Sphere" ; since Perl 5.38 "package \nFoo::Bar\n 1.00")) (invalid '("package Foo;" ; semicolon must not be included "package Foo 1.1 {" ; nor the opening brace "packageFoo" ; not a package declaration - "package Foo1.1" ; invalid package name - "class O3D::Sphere"))) ; class not yet supported + "package Foo1.1"))) ; invalid package name (cperl-test--validate-regexp (rx (eval cperl--package-rx)) valid invalid))) @@ -428,6 +503,66 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--basic-identifier-rx)) valid invalid))) +(ert-deftest cperl-test-attribute-rx () + "Test attributes and attribute lists" + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '("foo" "bar()" "baz(quux)")) + (invalid + '("+foo" ; not an identifier + "foo::bar" ; no package qualifiers allowed + "(no-identifier)" ; no attribute name + "baz (quux)"))) ; no space allowed before "(" + (cperl-test--validate-regexp (rx (eval cperl--single-attribute-rx)) + valid invalid))) + +(ert-deftest cperl-test-attribute-list-rx () + "Test attributes and attribute lists" + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '(":" ":foo" ": bar()" ":baz(quux):" + ":_" ":_foo" + ":isa(Foo) does(Bar)" ":isa(Foo):does(Bar)" + ":isa(Foo):does(Bar):" + ": isa(Foo::Bar) : does(Bar)")) + (invalid + '(":foo + bar" ; not an identifier + "::foo" ; not an attribute list + ": foo(bar : : baz" ; too many colons + ": foo(bar)baz" ; need a separator + ": baz (quux)"))) ; no space allowed before "(" + (cperl-test--validate-regexp (rx (eval cperl--attribute-list-rx)) + valid invalid))) + +(ert-deftest cperl-test-prototype-rx () + "Test subroutine prototypes" + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + ;; Examples from perldoc perlsub + '("($$)" "($$$)" "($$;$)" "($$$;$)" "(@)" "($@)" "(\\@)" "(\\@$$@)" + "(\\[%@])" "(*;$)" "(**)" "(&@)" "(;$)" "()")) + (invalid + '("$" ; missing paren + "($self)" ; a variable, -> subroutine signature + "(!$)" ; not all punctuation is permitted + "{$$}"))) ; wrong type of paren + (cperl-test--validate-regexp (rx (eval cperl--prototype-rx)) + valid invalid))) + +(ert-deftest cperl-test-signature-rx () + "Test subroutine signatures." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '("()" "( )" "($self, %params)" "(@params)")) + (invalid + '("$self" ; missing paren + "($)" ; a subroutine signature + "($!)" ; globals not permitted in a signature + "(@par,%options)" ; two slurpy parameters + "{$self}"))) ; wrong type of paren + (cperl-test--validate-regexp (rx (eval cperl--signature-rx)) + valid invalid))) + ;;; Test unicode identifier in various places (defun cperl--test-unicode-setup (code string) @@ -717,7 +852,9 @@ created by CPerl mode, so skip it for Perl mode." "lexical" "Versioned::Block::signatured" "Package::in_package_again" - "Erdős::Number::erdős_number"))) + "Erdős::Number::erdős_number" + "Class::Class::init" + "Class::Inner::init_again"))) (dolist (sub expected) (should (assoc-string sub index))))))) @@ -788,6 +925,17 @@ under timeout control." (should (string-match "poop ('foo', \n 'bar')" (buffer-string)))))) +(ert-deftest cperl-test-bug-11733 () + "Verify indentation of braces after newline and non-labels." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (cperl--run-test-cases + (ert-resource-file "cperl-bug-11733.pl") + (goto-char (point-min)) + (while (null (eobp)) + (cperl-indent-command) + (forward-line 1)))) + + (ert-deftest cperl-test-bug-11996 () "Verify that we give the right syntax property to a backslash operator." (with-temp-buffer @@ -995,6 +1143,20 @@ Perl is not Lisp: An open paren in column 0 does not start a function." (cperl-indent-command) (forward-line 1)))) +(ert-deftest cperl-test-bug-35925 () + "Check that indentation is correct after a terminating format declaration." + (cperl-set-style "PBP") ; Make cperl-mode use the same settings as perl-mode. + (cperl--run-test-cases + (ert-resource-file "cperl-bug-35925.pl") + (let ((tab-function + (if (equal cperl-test-mode 'perl-mode) + #'indent-for-tab-command + #'cperl-indent-command))) + (goto-char (point-max)) + (forward-line -2) + (funcall tab-function))) + (cperl-set-style-back)) + (ert-deftest cperl-test-bug-37127 () "Verify that closing a paren in a regex goes without a message. Also check that the message is issued if the regex terminator is @@ -1145,6 +1307,132 @@ as a regex." (funcall cperl-test-mode) (should-not (nth 3 (syntax-ppss 3))))) +(ert-deftest cperl-test-bug-64190 () + "Verify correct fontification of multiline declarations" + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "cperl-bug-64190.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (cperl-mode) + (font-lock-ensure) + ;; Example 1 + (while (search-forward "var" nil t) + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face))) + ;; Example 2 + (search-forward "package F") + (should (equal (get-text-property (point) 'face) + 'font-lock-function-name-face)) + + ;; Example 3 and 4 can't be directly tested because jit-lock and + ;; batch tests don't play together well. But we can approximate + ;; the behavior by calling the the fontification for the same + ;; region which would be used by jit-lock. + ;; Example 3 + (search-forward "sub do_stuff") + (let ((start-change (point))) + (insert "\n{") + (cperl-font-lock-fontify-region-function start-change + (point-max) + nil) ; silent + (font-lock-ensure start-change (point-max)) + (goto-char (1- start-change)) ; between the "ff" in "stuff" + (should (equal (get-text-property (point) 'face) + 'font-lock-function-name-face)) + (search-forward "{") + (insert "}")) ; make it legal again + + ;; Example 4 + (search-forward "$param2") + (beginning-of-line) + (let ((start-change (point))) + (insert " ") + (cperl-font-lock-fontify-region-function start-change + (point-max) + nil) ; silent + (font-lock-ensure start-change (point-max)) + (goto-char (1+ start-change)) + (should (equal (get-text-property (point) 'face) + 'font-lock-variable-name-face)) + (re-search-forward (rx (group "sub") " " (group "oops"))) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-keyword-face)) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-function-name-face)))))) + +(ert-deftest cperl-test-bug-64364 () + "Check that multi-line subroutine declarations indent correctly." + (cperl-set-style "PBP") ; make cperl-mode use the same settings as perl-mode + (cperl--run-test-cases + (ert-resource-file "cperl-bug-64364.pl") + (indent-region (point-min) (point-max))) + (cperl--run-test-cases + (ert-resource-file "cperl-bug-64364.pl") + (let ((tab-function + (if (equal cperl-test-mode 'perl-mode) + #'indent-for-tab-command + #'cperl-indent-command))) + (goto-char (point-min)) + (while (null (eobp)) + (funcall tab-function) + (forward-line 1)))) + (cperl-set-style-back)) + +(ert-deftest cperl-test-bug-65834 () + "Verify that CPerl mode identifies a left-shift operator. +Left-shift and here-documents both use the \"<<\" operator. +In the code provided by this bug report, it needs to be +detected as left-shift operator." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-65834.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward "retur") ; leaves point before the "n" + (should (equal (get-text-property (point) 'face) + font-lock-keyword-face)) + (search-forward "# comm") ; leaves point before "ent" + (should (equal (get-text-property (point) 'face) + font-lock-comment-face)))) + +(ert-deftest cperl-test-bug-66145 () + "Verify that hashes and arrays are only fontified in code. +In strings, comments and POD the syntaxified faces should +prevail. The tests exercise all combinations of sigils $@% and +parenthesess [{ for comments, POD, strings and HERE-documents. +Fontification in code for `cperl-mode' is done in the tests +beginning with `cperl-test-unicode`." + (let ((types '("array" "hash" "key")) + (faces `(("string" . font-lock-string-face) + ("comment" . font-lock-comment-face) + ("here" . ,(if (equal cperl-test-mode 'perl-mode) + 'perl-heredoc + font-lock-string-face))))) + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-66145.pl")) + (funcall cperl-test-mode) + (font-lock-ensure) + (dolist (type types) + (goto-char (point-min)) + (while (re-search-forward (concat type "_\\([a-z]+\\)") nil t) + (should (equal (get-text-property (match-beginning 1) 'face) + (cdr (assoc (match-string-no-properties 1) + faces))))))))) + +(ert-deftest cperl-test-bug-66161 () + "Verify that text after \"__END__\" is fontified as comment. +For `cperl-mode', this needs the custom variable +`cperl-fontify-trailer' to be set to `comment'. Per default, +cperl-mode fontifies text after the delimiter as Perl code." + (with-temp-buffer + (insert-file-contents (ert-resource-file "cperl-bug-66161.pl")) + (setq cperl-fontify-trailer 'comment) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward "TODO") ; leaves point before the colon + (should (equal (get-text-property (point) 'face) + font-lock-comment-face)))) + (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 7ce0116636d..f2da3295b49 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -31,23 +31,20 @@ ;; Some of these tests rely on the GNU ELPA package company.el and ;; yasnippet.el being available. -;; Some of the tests require access to a remote host files. Since -;; this could be problematic, a mock-up connection method "mock" is -;; used. Emulating a remote connection, it simply calls "sh -i". -;; Tramp's file name handlers still run, so this test is sufficient -;; except for connection establishing. - -;; If you want to test a real Tramp connection, set -;; $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to -;; overwrite the default value. If you want to skip tests accessing a -;; remote host, set this environment variable to "/dev/null" or -;; whatever is appropriate on your system. +;; Some of the tests require access to a remote host files, which is +;; mocked in the simplest case. If you want to test a real Tramp +;; connection, override $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable +;; value (FIXME: like what?) in order to overwrite the default value. +;; +;; IMPORTANT: Since Eglot is a :core ELPA package, these tests are +;; supposed to run on Emacsen down to 26.3. Do not use bleeding-edge +;; functionality not compatible with that Emacs version. ;;; Code: (require 'eglot) (require 'cl-lib) (require 'ert) -(require 'tramp) ; must be prior ert-x +(require 'tramp) (require 'ert-x) ; ert-simulate-command (require 'edebug) (require 'cc-mode) ; c-mode-hook @@ -58,73 +55,66 @@ ;;; Helpers +(defun eglot--test-message (format &rest args) + "Message out with FORMAT with ARGS." + (message "[eglot-tests] %s" + (apply #'format format args))) + (defmacro eglot--with-fixture (fixture &rest body) - "Setup FIXTURE, call BODY, teardown FIXTURE. + "Set up FIXTURE, call BODY, tear down FIXTURE. FIXTURE is a list. Its elements are of the form (FILE . CONTENT) to create a readable FILE with CONTENT. FILE may be a directory name and CONTENT another (FILE . CONTENT) list to specify a -directory hierarchy. FIXTURE's elements can also be (SYMBOL -VALUE) meaning SYMBOL should be bound to VALUE during BODY and -then restored." +directory hierarchy." (declare (indent 1) (debug t)) - `(eglot--call-with-fixture - ,fixture #'(lambda () ,@body))) + `(eglot--call-with-fixture ,fixture (lambda () ,@body))) (defun eglot--make-file-or-dir (ass) - (let ((file-or-dir-name (car ass)) + (let ((file-or-dir-name (expand-file-name (car ass))) (content (cdr ass))) (cond ((listp content) (make-directory file-or-dir-name 'parents) - (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (let ((default-directory (file-name-as-directory file-or-dir-name))) (mapcan #'eglot--make-file-or-dir content))) ((stringp content) - (with-temp-buffer - (insert content) - (write-region nil nil file-or-dir-name nil 'nomessage)) - (list (expand-file-name file-or-dir-name))) + (with-temp-file file-or-dir-name + (insert content)) + (list file-or-dir-name)) (t (eglot--error "Expected a string or a directory spec"))))) (defun eglot--call-with-fixture (fixture fn) "Helper for `eglot--with-fixture'. Run FN under FIXTURE." - (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t)) - (default-directory fixture-directory) - file-specs created-files - syms-to-restore + (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture-" t)) + (default-directory (file-name-as-directory fixture-directory)) + created-files new-servers test-body-successful-p) - (dolist (spec fixture) - (cond ((symbolp spec) - (push (cons spec (symbol-value spec)) syms-to-restore) - (set spec nil)) - ((symbolp (car spec)) - (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) - (set (car spec) (cadr spec))) - ((stringp (car spec)) (push spec file-specs)))) + (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) (unwind-protect - (let* ((process-environment - (append - `(;; Set XDF_CONFIG_HOME to /dev/null to prevent - ;; user-configuration to have an influence on - ;; language servers. (See github#441) - "XDG_CONFIG_HOME=/dev/null" - ;; ... on the flip-side, a similar technique by - ;; Emacs's test makefiles means that HOME is - ;; spoofed to /nonexistent, or sometimes /tmp. - ;; This breaks some common installations for LSP - ;; servers like pylsp, rust-analyzer making these - ;; tests mostly useless, so we hack around it here - ;; with a great big hack. - ,(format "HOME=%s" - (expand-file-name (format "~%s" (user-login-name))))) - process-environment)) - (eglot-server-initialized-hook - (lambda (server) (push server new-servers)))) - (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) + (let ((process-environment + `(;; Set XDG_CONFIG_HOME to /dev/null to prevent + ;; user-configuration influencing language servers + ;; (see github#441). + ,(format "XDG_CONFIG_HOME=%s" null-device) + ;; ... on the flip-side, a similar technique in + ;; Emacs's `test/Makefile' spoofs HOME as + ;; /nonexistent (and as `temporary-file-directory' in + ;; `ert-remote-temporary-file-directory'). + ;; This breaks some common installations for LSP + ;; servers like rust-analyzer, making these tests + ;; mostly useless, so we hack around it here with a + ;; great big hack. + ,(format "HOME=%s" + (expand-file-name (format "~%s" (user-login-name)))) + ,@process-environment)) + (eglot-server-initialized-hook + (lambda (server) (push server new-servers)))) + (setq created-files (mapcan #'eglot--make-file-or-dir fixture)) (prog1 (funcall fn) (setq test-body-successful-p t))) - (eglot--message - "Test body was %s" (if test-body-successful-p "OK" "A FAILURE")) + (eglot--test-message "[%s]: %s" (ert-test-name (ert-running-test)) + (if test-body-successful-p "OK" "FAILED")) (unwind-protect (let ((eglot-autoreconnect nil)) (dolist (server new-servers) @@ -133,8 +123,7 @@ then restored." (eglot-shutdown server nil 3 (not test-body-successful-p)) (error - (eglot--message "Non-critical shutdown error after test: %S" - oops)))) + (eglot--test-message "Non-critical cleanup error: %S" oops)))) (when (not test-body-successful-p) ;; We want to do this after the sockets have ;; shut down such that any pending data has been @@ -147,24 +136,21 @@ then restored." (jsonrpc-events-buffer server))))) (cond (noninteractive (dolist (buffer buffers) - (eglot--message "%s:" (buffer-name buffer)) + (eglot--test-message "contents of `%s':" (buffer-name buffer)) (princ (with-current-buffer buffer (buffer-string)) 'external-debugging-output))) (t - (eglot--message "Preserved for inspection: %s" - (mapconcat #'buffer-name buffers ", ")))))))) - (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) + (eglot--test-message "Preserved for inspection: %s" + (mapconcat #'buffer-name buffers ", ")))))))) + (eglot--cleanup-after-test fixture-directory created-files))))) -(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) +(defun eglot--cleanup-after-test (fixture-directory created-files) (let ((buffers-to-delete - (delete nil (mapcar #'find-buffer-visiting created-files)))) - (eglot--message "Killing %s, wiping %s, restoring %s" - buffers-to-delete - fixture-directory - (mapcar #'car syms-to-restore)) - (cl-loop for (sym . val) in syms-to-restore - do (set sym val)) - (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted + (delq nil (mapcar #'find-buffer-visiting created-files)))) + (eglot--test-message "Killing %s, wiping %s" + buffers-to-delete + fixture-directory) + (dolist (buf buffers-to-delete) ;; Have to save otherwise will get prompted. (with-current-buffer buf (save-buffer) (kill-buffer))) (delete-directory fixture-directory 'recursive) ;; Delete Tramp buffers if needed. @@ -213,48 +199,48 @@ then restored." &rest body) "Run BODY saving LSP JSON messages in variables, most recent first." (declare (indent 1) (debug (sexp &rest form))) - (let ((log-event-ad-sym (make-symbol "eglot--event-sniff"))) - `(unwind-protect - (let ,(delq nil (list server-requests - server-notifications - server-replies - client-requests - client-notifications - client-replies)) - (advice-add - #'jsonrpc--log-event :before - (lambda (_proc message &optional type) - (cl-destructuring-bind (&key method id _error &allow-other-keys) - message - (let ((req-p (and method id)) - (notif-p method) - (reply-p id)) - (cond - ((eq type 'server) - (cond (req-p ,(when server-requests - `(push message ,server-requests))) - (notif-p ,(when server-notifications - `(push message ,server-notifications))) - (reply-p ,(when server-replies - `(push message ,server-replies))))) - ((eq type 'client) - (cond (req-p ,(when client-requests - `(push message ,client-requests))) - (notif-p ,(when client-notifications - `(push message ,client-notifications))) - (reply-p ,(when client-replies - `(push message ,client-replies))))))))) - '((name . ,log-event-ad-sym))) - ,@body) - (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) + (let ((log-event-hook-sym (make-symbol "eglot--event-sniff"))) + `(let* (,@(delq nil (list server-requests + server-notifications + server-replies + client-requests + client-notifications + client-replies))) + (cl-flet ((,log-event-hook-sym (_connection + origin + &key _json kind message _foreign-message + &allow-other-keys) + (let ((req-p (eq kind 'request)) + (notif-p (eq kind 'notification)) + (reply-p (eql kind 'reply))) + (cond + ((eq origin 'server) + (cond (req-p ,(when server-requests + `(push message ,server-requests))) + (notif-p ,(when server-notifications + `(push message ,server-notifications))) + (reply-p ,(when server-replies + `(push message ,server-replies))))) + ((eq origin 'client) + (cond (req-p ,(when client-requests + `(push message ,client-requests))) + (notif-p ,(when client-notifications + `(push message ,client-notifications))) + (reply-p ,(when client-replies + `(push message ,client-replies))))))))) + (unwind-protect + (progn + (add-hook 'jsonrpc-event-hook #',log-event-hook-sym) + ,@body) + (remove-hook 'jsonrpc-event-hook #',log-event-hook-sym)))))) (cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) - "Spin until FN match in EVENTS-SYM, flush events after it. -Pass TIMEOUT to `eglot--with-timeout'." (declare (indent 2) (debug (sexp sexp sexp &rest form))) `(eglot--with-timeout '(,timeout ,(or message (format "waiting for:\n%s" (pp-to-string body)))) - (let ((event + (eglot--test-message "waiting for `%s'" (with-output-to-string + (mapc #'princ ',body))) + (let ((events (cl-loop thereis (cl-loop for json in ,events-sym for method = (plist-get json :method) when (keywordp method) @@ -268,16 +254,21 @@ Pass TIMEOUT to `eglot--with-timeout'." collect json into before) for i from 0 when (zerop (mod i 5)) - ;; do (eglot--message "still struggling to find in %s" - ;; ,events-sym) + ;; do (eglot--test-message "still struggling to find in %s" + ;; ,events-sym) do ;; `read-event' is essential to have the file ;; watchers come through. - (read-event "[eglot] Waiting a bit..." nil 0.1) + (cond ((fboundp 'flush-standard-output) + (read-event nil nil 0.1) (princ ".") + (flush-standard-output)) + (t + (read-event "." nil 0.1))) (accept-process-output nil 0.1)))) - (setq ,events-sym (cdr event)) - (eglot--message "Event detected:\n%s" - (pp-to-string (car event)))))) + (setq ,events-sym (cdr events)) + (cl-destructuring-bind (&key method id &allow-other-keys) (car events) + (eglot--test-message "detected: %s" + (or method (and id (format "id=%s" id)))))))) ;; `rust-mode' is not a part of Emacs, so we define these two shims ;; which should be more than enough for testing. @@ -304,6 +295,13 @@ Pass TIMEOUT to `eglot--with-timeout'." (setq last-command-event char) (call-interactively (key-binding (vector char)))) +(defun eglot--clangd-version () + "Report on the clangd version used in various tests." + (let ((version (shell-command-to-string "clangd --version"))) + (when (string-match "version[[:space:]]+\\([0-9.]*\\)" + version) + (match-string 1 version)))) + ;;; Unit tests @@ -311,8 +309,7 @@ Pass TIMEOUT to `eglot--with-timeout'." "Connect to eclipse.jdt.ls server." (skip-unless (executable-find "jdtls")) (eglot--with-fixture - '(("project/src/main/java/foo" . (("Main.java" . ""))) - ("project/.git/" . nil)) + '(("project/src/main/java/foo" . (("Main.java" . "")))) (with-current-buffer (eglot--find-file-noselect "project/src/main/java/foo/Main.java") (eglot--sniffing (:server-notifications s-notifs) @@ -418,7 +415,7 @@ Pass TIMEOUT to `eglot--with-timeout'." (and (string= method "workspace/didChangeWatchedFiles") (cl-destructuring-bind (&key uri type) (elt (plist-get params :changes) 0) - (and (string= (eglot--path-to-uri "Cargo.toml") uri) + (and (string= (eglot-path-to-uri "Cargo.toml") uri) (= type 3)))))))))) (ert-deftest eglot-test-basic-diagnostics () @@ -431,7 +428,7 @@ Pass TIMEOUT to `eglot--with-timeout'." (eglot--find-file-noselect "diag-project/main.c") (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) - (eglot--wait-for (s-notifs 2) + (eglot--wait-for (s-notifs 10) (&key _id method &allow-other-keys) (string= method "textDocument/publishDiagnostics")) (flymake-start) @@ -441,16 +438,20 @@ Pass TIMEOUT to `eglot--with-timeout'." (ert-deftest eglot-test-diagnostic-tags-unnecessary-code () "Test rendering of diagnostics tagged \"unnecessary\"." - (skip-unless (executable-find "rust-analyzer")) - (skip-unless (executable-find "cargo")) + (skip-unless (executable-find "clangd")) + (skip-unless (version<= "14" (eglot--clangd-version))) (eglot--with-fixture - '(("diagnostic-tag-project" . - (("main.rs" . - "fn main() -> () { let test=3; }")))) + `(("diag-project" . + (("main.cpp" . "int main(){float a = 42.2; return 0;}")))) (with-current-buffer - (eglot--find-file-noselect "diagnostic-tag-project/main.rs") - (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) - (should (zerop (shell-command "cargo init"))) + (eglot--find-file-noselect "diag-project/main.cpp") + (eglot--make-file-or-dir '(".git")) + (eglot--make-file-or-dir + `("compile_commands.json" . + ,(jsonrpc--json-encode + `[(:directory ,default-directory :command "/usr/bin/c++ -Wall -c main.cpp" + :file ,(expand-file-name "main.cpp"))]))) + (let ((eglot-server-programs '((c++-mode . ("clangd"))))) (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) (eglot--wait-for (s-notifs 10) @@ -462,11 +463,11 @@ Pass TIMEOUT to `eglot--with-timeout'." (should (eq 'eglot-diagnostic-tag-unnecessary-face (face-at-point)))))))) (defun eglot--eldoc-on-demand () - ;; Trick Eldoc 1.1.0 into accepting on-demand calls. + ;; Trick ElDoc 1.1.0 into accepting on-demand calls. (eldoc t)) (defun eglot--tests-force-full-eldoc () - ;; FIXME: This uses some Eldoc implementation defatils. + ;; FIXME: This uses some ElDoc implementation details. (when (buffer-live-p eldoc--doc-buffer) (with-current-buffer eldoc--doc-buffer (let ((inhibit-read-only t)) @@ -543,10 +544,7 @@ Pass TIMEOUT to `eglot--with-timeout'." `(("project" . (("coiso.c" . "#include <stdio.h>\nint main () {fprin")))) (with-current-buffer (eglot--find-file-noselect "project/coiso.c") - (eglot--sniffing (:server-notifications s-notifs) - (eglot--wait-for-clangd) - (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) - (string= method "textDocument/publishDiagnostics"))) + (eglot--wait-for-clangd) (goto-char (point-max)) (completion-at-point) (message (buffer-string)) @@ -652,7 +650,7 @@ int main() { (should (string-match "^fprintf" (eglot--tests-force-full-eldoc)))))) (ert-deftest eglot-test-multiline-eldoc () - "Test Eldoc documentation from multiple osurces." + "Test ElDoc documentation from multiple osurces." (skip-unless (executable-find "clangd")) (eglot--with-fixture `(("project" . (("coiso.c" . @@ -704,8 +702,8 @@ int main() { (should (zerop (shell-command "cargo init"))) (eglot--sniffing (:server-notifications s-notifs) (should (eglot--tests-connect)) - (eglot--wait-for (s-notifs 10) (&key method &allow-other-keys) - (string= method "textDocument/publishDiagnostics"))) + (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics"))) (goto-char (point-max)) (eglot--simulate-key-event ?.) (should (looking-back "^ \\.")))))) @@ -770,33 +768,35 @@ int main() { (should (= 4 (length (flymake--project-diagnostics)))))))))) (ert-deftest eglot-test-project-wide-diagnostics-rust-analyzer () - "Test diagnostics through multiple files in a TypeScript LSP." + "Test diagnostics through multiple files in rust-analyzer." (skip-unless (executable-find "rust-analyzer")) (skip-unless (executable-find "cargo")) + (skip-unless (executable-find "git")) (eglot--with-fixture '(("project" . (("main.rs" . - "fn main() -> () { let test=3; }") + "fn main() -> i32 { return 42.2;}") ("other-file.rs" . "fn foo() -> () { let hi=3; }")))) - (eglot--make-file-or-dir '(".git")) (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) - ;; Open other-file, and see diagnostics arrive for main.rs + ;; Open other-file.rs, and see diagnostics arrive for main.rs, + ;; which we didn't open. (with-current-buffer (eglot--find-file-noselect "project/other-file.rs") + (should (zerop (shell-command "git init"))) (should (zerop (shell-command "cargo init"))) (eglot--sniffing (:server-notifications s-notifs) (eglot--tests-connect) (flymake-start) - (eglot--wait-for (s-notifs 10) - (&key _id method &allow-other-keys) - (string= method "textDocument/publishDiagnostics")) - (let ((diags (flymake--project-diagnostics))) - (should (= 2 (length diags))) - ;; Check that we really get a diagnostic from main.rs, and - ;; not from other-file.rs - (should (string-suffix-p - "main.rs" - (flymake-diagnostic-buffer (car diags)))))))))) + (eglot--wait-for (s-notifs 20) + (&key _id method params &allow-other-keys) + (and (string= method "textDocument/publishDiagnostics") + (string-suffix-p "main.rs" (plist-get params :uri)))) + (let* ((diags (flymake--project-diagnostics))) + (should (cl-some (lambda (diag) + (let ((locus (flymake-diagnostic-buffer diag))) + (and (stringp (flymake-diagnostic-buffer diag)) + (string-suffix-p "main.rs" locus)))) + diags)))))))) (ert-deftest eglot-test-json-basic () "Test basic autocompletion in vscode-json-languageserver." @@ -853,9 +853,9 @@ int main() { (skip-unless (executable-find "clangd")) (eglot--with-fixture `(("project" . (("foo.c" . "int foo() {return 42;}") - ("bar.c" . "int bar() {return 42;}"))) - (c-mode-hook (eglot-ensure))) - (let (server) + ("bar.c" . "int bar() {return 42;}")))) + (let ((c-mode-hook '(eglot-ensure)) + server) ;; need `ert-simulate-command' because `eglot-ensure' ;; relies on `post-command-hook'. (with-current-buffer @@ -924,7 +924,7 @@ int main() { (should-error (apply #'eglot--connect (eglot--guess-contact))))))) (ert-deftest eglot-test-capabilities () - "Unit test for `eglot--server-capable'." + "Unit test for `eglot-server-capable'." (cl-letf (((symbol-function 'eglot--capabilities) (lambda (_dummy) ;; test data lifted from Golangserver example at @@ -939,11 +939,11 @@ int main() { :xdefinitionProvider t :xworkspaceSymbolByProperties t))) ((symbol-function 'eglot--current-server-or-lose) (lambda () nil))) - (should (eql 2 (eglot--server-capable :textDocumentSync))) - (should (eglot--server-capable :completionProvider :triggerCharacters)) - (should (equal '(:triggerCharacters ["."]) (eglot--server-capable :completionProvider))) - (should-not (eglot--server-capable :foobarbaz)) - (should-not (eglot--server-capable :textDocumentSync :foobarbaz)))) + (should (eql 2 (eglot-server-capable :textDocumentSync))) + (should (eglot-server-capable :completionProvider :triggerCharacters)) + (should (equal '(:triggerCharacters ["."]) (eglot-server-capable :completionProvider))) + (should-not (eglot-server-capable :foobarbaz)) + (should-not (eglot-server-capable :textDocumentSync :foobarbaz)))) (defmacro eglot--without-interface-warnings (&rest body) (let ((eglot-strict-mode nil)) @@ -1039,7 +1039,8 @@ int main() { (cl-defmacro eglot--guessing-contact ((interactive-sym prompt-args-sym guessed-class-sym guessed-contact-sym - &optional guessed-lang-id-sym) + &optional guessed-major-modes-sym + guessed-lang-ids-sym) &body body) "Guess LSP contact with `eglot--guessing-contact', evaluate BODY. @@ -1049,10 +1050,10 @@ BODY is evaluated twice, with INTERACTIVE bound to the boolean passed to If the user would have been prompted, PROMPT-ARGS-SYM is bound to the list of arguments that would have been passed to `read-shell-command', else nil. GUESSED-CLASS-SYM, -GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the -useful return values of `eglot--guess-contact'. Unless the -server program evaluates to \"a-missing-executable.exe\", this -macro will assume it exists." +GUESSED-CONTACT-SYM, GUESSED-LANG-IDS-SYM and +GUESSED-MAJOR-MODES-SYM are bound to the useful return values of +`eglot--guess-contact'. Unless the server program evaluates to +\"a-missing-executable.exe\", this macro will assume it exists." (declare (indent 1) (debug t)) (let ((i-sym (cl-gensym))) `(dolist (,i-sym '(nil t)) @@ -1068,8 +1069,9 @@ macro will assume it exists." `(lambda (&rest args) (setq ,prompt-args-sym args) "") `(lambda (&rest _dummy) "")))) (cl-destructuring-bind - (_ _ ,guessed-class-sym ,guessed-contact-sym - ,(or guessed-lang-id-sym '_)) + (,(or guessed-major-modes-sym '_) + _ ,guessed-class-sym ,guessed-contact-sym + ,(or guessed-lang-ids-sym '_)) (eglot--guess-contact ,i-sym) ,@body)))))) @@ -1164,16 +1166,17 @@ macro will assume it exists." (ert-deftest eglot-test-server-programs-guess-lang () (let ((major-mode 'foo-mode)) (let ((eglot-server-programs '((foo-mode . ("prog-executable"))))) - (eglot--guessing-contact (_ nil _ _ guessed-lang) - (should (equal guessed-lang "foo")))) + (eglot--guessing-contact (_ nil _ _ _ guessed-langs) + (should (equal guessed-langs '("foo"))))) (let ((eglot-server-programs '(((foo-mode :language-id "bar") . ("prog-executable"))))) - (eglot--guessing-contact (_ nil _ _ guessed-lang) - (should (equal guessed-lang "bar")))) + (eglot--guessing-contact (_ nil _ _ _ guessed-langs) + (should (equal guessed-langs '("bar"))))) (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar")) . ("prog-executable"))))) - (eglot--guessing-contact (_ nil _ _ guessed-lang) - (should (equal guessed-lang "bar")))))) + (eglot--guessing-contact (_ nil _ _ modes guessed-langs) + (should (equal guessed-langs '("bar" "baz"))) + (should (equal modes '(foo-mode baz-mode))))))) (defun eglot--glob-match (glob str) (funcall (eglot--glob-compile glob t t) str)) @@ -1233,14 +1236,27 @@ macro will assume it exists." (defun eglot--call-with-tramp-test (fn) ;; Set up a Tramp method that’s just a shell so the remote host is ;; really just the local host. - (let* ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path)) + (let* ((tramp-remote-path (cons 'tramp-own-remote-path + tramp-remote-path)) (tramp-histfile-override t) (tramp-allow-unsafe-temporary-files t) (tramp-verbose 1) - (temporary-file-directory ert-remote-temporary-file-directory) + (temporary-file-directory + (or (bound-and-true-p ert-remote-temporary-file-directory) + (prog1 (format "/mock::%s" temporary-file-directory) + (add-to-list + 'tramp-methods + '("mock" + (tramp-login-program "sh") (tramp-login-args (("-i"))) + (tramp-direct-async ("-c")) (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) + (add-to-list 'tramp-default-host-alist + `("\\`mock\\'" nil ,(system-name))) + (when (and noninteractive (not (file-directory-p "~/"))) + (setenv "HOME" temporary-file-directory))))) (default-directory temporary-file-directory)) ;; We must check the remote LSP server. So far, just "clangd" is used. - (unless (executable-find "clangd" 'remote) + (unless (ignore-errors (executable-find "clangd" 'remote)) (ert-skip "Remote clangd not found")) (funcall fn))) @@ -1257,9 +1273,9 @@ macro will assume it exists." (ert-deftest eglot-test-path-to-uri-windows () (skip-unless (eq system-type 'windows-nt)) (should (string-prefix-p "file:///" - (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))) + (eglot-path-to-uri "c:/Users/Foo/bar.lisp"))) (should (string-suffix-p "c%3A/Users/Foo/bar.lisp" - (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))) + (eglot-path-to-uri "c:/Users/Foo/bar.lisp")))) (ert-deftest eglot-test-same-server-multi-mode () "Check single LSP instance manages multiple modes in same project." @@ -1287,8 +1303,9 @@ macro will assume it exists." (should (eq (eglot-current-server) server)))))) (provide 'eglot-tests) -;;; eglot-tests.el ends here ;; Local Variables: ;; checkdoc-force-docstrings-flag: nil ;; End: + +;;; eglot-tests.el ends here diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 57b39a49801..4fa869c773f 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -128,7 +128,7 @@ (ert-deftest eval-last-sexp-print-format-sym-echo () ;; We can only check the echo area when running interactive. - (skip-unless (not noninteractive)) + (skip-when noninteractive) (with-temp-buffer (let ((current-prefix-arg nil)) (erase-buffer) (insert "t") (message nil) @@ -147,7 +147,7 @@ (should (equal (buffer-string) "?A65 (#o101, #x41, ?A)"))))) (ert-deftest eval-last-sexp-print-format-small-int-echo () - (skip-unless (not noninteractive)) + (skip-when noninteractive) (with-temp-buffer (let ((current-prefix-arg nil)) (erase-buffer) (insert "?A") (message nil) @@ -171,7 +171,7 @@ (should (equal (buffer-string) "?B66 (#o102, #x42, ?B)")))))) (ert-deftest eval-last-sexp-print-format-large-int-echo () - (skip-unless (not noninteractive)) + (skip-when noninteractive) (with-temp-buffer (let ((eval-expression-print-maximum-character ?A)) (let ((current-prefix-arg nil)) @@ -186,7 +186,7 @@ ;;; eval-defun (ert-deftest eval-defun-prints-edebug-when-instrumented () - (skip-unless (not noninteractive)) + (skip-when noninteractive) (with-temp-buffer (let ((current-prefix-arg '(4))) (erase-buffer) (insert "(defun foo ())") (message nil) @@ -1004,6 +1004,11 @@ evaluation of BODY." (should (equal (elisp--xref-infer-namespace p6) 'function))) (elisp-mode-test--with-buffer + (concat "(defclass child-class ({p1}parent-1 {p2}parent-2))\n") + (should (equal (elisp--xref-infer-namespace p1) 'function)) + (should (equal (elisp--xref-infer-namespace p2) 'function))) + + (elisp-mode-test--with-buffer (concat "(require '{p1}alpha)\n" "(fboundp '{p2}beta)\n" "(boundp '{p3}gamma)\n" diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..fe09a37a32b --- /dev/null +++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts @@ -0,0 +1,390 @@ +Code: + (lambda () + (elixir-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: $ + +Name: Basic modules + +=-= + defmodule Foobar do +def bar() do +"one" + end + end +=-= +defmodule Foobar do + def bar() do + "one" + end +end +=-=-= + +Name: Map + +=-= +map = %{ + "a" => 1, + "b" => 2 +} +=-=-= + +Name: Map in function def + +=-= +def foobar() do + %{ + one: "one", + two: "two", + three: "three", + four: "four" + } +end +=-=-= + +Name: Map in tuple + +=-= +def foo() do + {:ok, + %{ + state + | extra_arguments: extra_arguments, + max_children: max_children, + max_restarts: max_restarts, + max_seconds: max_seconds, + strategy: strategy + }} +end +=-=-= + +Name: Nested maps + +=-= +%{ + foo: "bar", + bar: %{ + foo: "bar" + } +} + +def foo() do + %{ + foo: "bar", + bar: %{ + foo: "bar" + } + } +end +=-=-= + +Name: Bitstring mulitline + +=-= +<<12, 22, +22, 32 + >> +=-= +<<12, 22, + 22, 32 +>> +=-=-= + +Name: Block assignments + +=-= +foo = + if true do + "yes" + else + "no" + end +=-=-= + +Name: Function rescue + +=-= +def foo do + "bar" +rescue + e -> + "bar" +end +=-=-= + +Name: With statement +=-= +with one <- one(), + two <- two(), + {:ok, value} <- get_value(one, two) do + {:ok, value} +else + {:error, %{"Message" => message}} -> + {:error, message} +end +=-=-= + +Name: Pipe statements with fn + +=-= +[1, 2] +|> Enum.map(fn num -> + num + 1 +end) +=-=-= + +Name: Pipe statements stab clases + +=-= +[1, 2] +|> Enum.map(fn + x when x < 10 -> x * 2 + x -> x * 3 +end) +=-=-= + +Name: Pipe statements params + +=-= +[1, 2] +|> foobar( + :one, + :two, + :three, + :four +) +=-=-= + +Name: Parameter maps + +=-= +def something(%{ + one: :one, + two: :two + }) do + {:ok, "done"} +end +=-=-= + +Name: Binary operator in else block + +=-= +defp foobar() do + if false do + :foo + else + :bar |> foo + end +end +=-=-= + +Name: Tuple indentation + +=-= +tuple = { + :one, + :two +} + +{ + :one, + :two +} +=-=-= + +Name: Call with keywords + +=-= +def foo() do + bar(:one, + :two, + one: 1, + two: 2 + ) +end +=-=-= + +Name: Call with @spec + +=-= +@spec foobar( + t, + acc, + (one, something -> :bar | far), + (two -> :bar | far) + ) :: any() + when chunk: any +def foobar(enumerable, acc, chunk_fun, after_fun) do + {_, {res, acc}} = + case after_fun.(acc) do + {:one, "one"} -> + "one" + + {:two, "two"} -> + "two" + end +end +=-=-= + +Name: Spec with multi-line result + +=-= +@type result :: + {:done, term} + | {:two} + | {:one} + +@type result :: + { + :done, + term + } + | {:two} + | {:one} + +@type boo_bar :: + (foo :: pos_integer, bar :: pos_integer -> any()) + +@spec foo_bar( + t, + (foo -> any), + (() -> any) | (foo, foo -> boolean) | module() + ) :: any + when foo: any +def foo(one, fun, other) +=-=-= + +Name: String concatenation in call + +=-= +IO.warn( + "one" <> + "two" <> + "bar" +) + +IO.warn( + "foo" <> + "bar" +) +=-=-= + +Name: Incomplete tuple + +=-= +map = { +:foo + +=-= +map = { + :foo + +=-=-= + +Name: Incomplete map + +=-= +map = %{ + "a" => "a", +=-=-= + +Name: Incomplete list + +=-= +map = [ +:foo + +=-= +map = [ + :foo + +=-=-= + +Name: String concatenation + +=-= +"one" <> + "two" <> + "three" <> + "four" +=-=-= + +Name: Tuple with same line first node + +=-= +{:one, + :two} + +{:ok, + fn one -> + one + |> String.upcase(one) + end} +=-=-= + +Name: Long tuple + +=-= +{"January", "February", "March", "April", "May", "June", "July", "August", "September", + "October", "November", "December"} +=-=-= + +Name: Doc + +=-= +defmodule Foo do +""" + bar + """ +end +=-= +defmodule Foo do + """ + bar + """ +end +=-=-= + +Name: Embedded HEEx + +=-= + defmodule Foo do + def foo(assigns) do +~H""" +<span> +text +</span> +""" + end + end +=-= +defmodule Foo do + def foo(assigns) do + ~H""" + <span> + text + </span> + """ + end +end +=-=-= + +Code: + (lambda () + (elixir-ts-mode) + (newline) + (indent-for-tab-command)) + +Name: New list item + +=-= +[ + :foo,$ +] +=-= +[ + :foo, + $ +] +=-=-= diff --git a/test/lisp/progmodes/elixir-ts-mode-tests.el b/test/lisp/progmodes/elixir-ts-mode-tests.el new file mode 100644 index 00000000000..488fc1b646f --- /dev/null +++ b/test/lisp/progmodes/elixir-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; elixir-ts-mode-tests.el --- Tests for elixir-ts-mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest elixir-ts-mode-test-indentation () + (skip-unless (and (treesit-ready-p 'elixir) (treesit-ready-p 'heex))) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'elixir-ts-mode-tests) +;;; elixir-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index f6608dffca2..c3ef4827ef2 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -213,6 +213,7 @@ SEVERITY-PREDICATE is used to setup (ert-deftest dummy-backends () "Test many different kinds of backends." + (let ((debug-on-error nil)) (with-temp-buffer (cl-letf (((symbol-function 'error-backend) @@ -291,7 +292,7 @@ SEVERITY-PREDICATE is used to setup (should (eq 'flymake-warning (face-at-point))) ; dolor (flymake-goto-next-error) (should (eq 'flymake-error (face-at-point))) ; prognata - (should-error (flymake-goto-next-error nil nil t)))))) + (should-error (flymake-goto-next-error nil nil t))))))) (ert-deftest recurrent-backend () "Test a backend that calls REPORT-FN multiple times." diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el index 39307999d6d..9b7f83086bf 100644 --- a/test/lisp/progmodes/grep-tests.el +++ b/test/lisp/progmodes/grep-tests.el @@ -66,4 +66,18 @@ (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore)) (grep-tests--check-rgrep-abbreviation)))) +(ert-deftest grep-tests--grep-heading-regexp-without-null () + (dolist (sep '(?: ?- ?=)) + (let ((string (format "filename%c123%ctext" sep sep))) + (should (string-match grep-heading-regexp string)) + (should (equal (match-string 1 string) "filename")) + (should (equal (match-string 2 string) (format "filename%c" sep)))))) + +(ert-deftest grep-tests--grep-heading-regexp-with-null () + (dolist (sep '(?: ?- ?=)) + (let ((string (format "funny:0:filename%c123%ctext" 0 sep))) + (should (string-match grep-heading-regexp string)) + (should (equal (match-string 1 string) "funny:0:filename")) + (should (equal (match-string 2 string) "funny:0:filename\0"))))) + ;;; grep-tests.el ends here diff --git a/test/lisp/progmodes/heex-ts-mode-resources/indent.erts b/test/lisp/progmodes/heex-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..500ddb2b536 --- /dev/null +++ b/test/lisp/progmodes/heex-ts-mode-resources/indent.erts @@ -0,0 +1,47 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (heex-ts-mode) + (indent-region (point-min) (point-max))) + +Point-Char: $ + +Name: Tag + +=-= + <div> + div + </div> +=-= +<div> + div +</div> +=-=-= + +Name: Component + +=-= + <Foo> + foobar + </Foo> +=-= +<Foo> + foobar +</Foo> +=-=-= + +Name: Slots + +=-= + <Foo> + <:bar> + foobar + </:bar> + </Foo> +=-= +<Foo> + <:bar> + foobar + </:bar> +</Foo> +=-=-= diff --git a/test/lisp/progmodes/heex-ts-mode-tests.el b/test/lisp/progmodes/heex-ts-mode-tests.el new file mode 100644 index 00000000000..def6d845de9 --- /dev/null +++ b/test/lisp/progmodes/heex-ts-mode-tests.el @@ -0,0 +1,31 @@ +;;; heex-ts-mode-tests.el --- Tests for heex-ts-mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'treesit) + +(ert-deftest heex-ts-mode-test-indentation () + (skip-unless (treesit-ready-p 'heex)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(provide 'heex-ts-mode-tests) +;;; heex-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/java-ts-mode-tests.el b/test/lisp/progmodes/java-ts-mode-tests.el index 03c13b9700d..4fd8fc3019f 100644 --- a/test/lisp/progmodes/java-ts-mode-tests.el +++ b/test/lisp/progmodes/java-ts-mode-tests.el @@ -28,8 +28,6 @@ (ert-test-erts-file (ert-resource-file "indent.erts"))) (ert-deftest java-ts-mode-test-movement () - :expected-result :failed ;in emacs-29 no sexp - ;navigation (skip-unless (treesit-ready-p 'java)) (ert-test-erts-file (ert-resource-file "movement.erts"))) diff --git a/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua new file mode 100644 index 00000000000..93d589e3825 --- /dev/null +++ b/test/lisp/progmodes/lua-ts-mode-resources/font-lock.lua @@ -0,0 +1,339 @@ +#!/usr/bin/env lua +-- ^ font-lock-comment-face +-- Comment +-- <- font-lock-comment-delimiter-face +-- ^ font-lock-comment-face +--[[ +-- ^ font-lock-comment-face +Multi-line comment +-- ^ font-lock-comment-face +]] +-- <- font-lock-comment-face +local line_comment = "comment" -- comment +-- ^ font-lock-comment-face + +-- Definition +local function f1() end +-- ^ font-lock-function-name-face +local f2 = function() end +-- ^ font-lock-function-name-face +local tb = { f1 = function() end } +-- ^ font-lock-function-name-face +function tb.f2() end +-- ^ font-lock-function-name-face +function tb:f3() end +-- ^ font-lock-function-name-face +tbl.f4 = function() end +-- ^ font-lock-function-name-face +function x.y:z() end +-- ^ font-lock-function-name-face + +-- Keyword +if true then +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +elseif true then +-- <- font-lock-keyword-face +else end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +local p = {} +-- ^ font-lock-keyword-face +for k,v in pairs({}) do end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +repeat if true then break end until false +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +while true do end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +function fn() return true end +-- <- font-lock-keyword-face +-- ^ font-lock-keyword-face +goto label1 +-- ^ font-lock-keyword-face +::label1:: +if true and not false or nil then +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +-- ^ font-lock-keyword-face +end + +-- String +local _ +_ = "x" +-- ^ font-lock-string-face +_ = 'x' +-- ^ font-lock-string-face +_ = "x\ty" +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = "x\"y" +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = 'x\'y' +-- ^ font-lock-string-face +-- ^ font-lock-string-face +_ = "x\z + y" +-- ^ font-lock-string-face +_ = "x\0900y" +-- ^ font-lock-string-face +_ = "x\09y" +-- ^ font-lock-string-face +_ = "x\0y" +-- ^ font-lock-string-face +_ = "x\u{1f602}y" +-- ^ font-lock-string-face +_ = [[x]] +-- ^ font-lock-string-face +_ = [=[x]=] +-- ^ font-lock-string-face + +-- Assignment +local n = 0 +-- ^ font-lock-variable-name-face +o, p, q = 1, 2, 3 +-- <- font-lock-variable-name-face +-- ^ font-lock-variable-name-face +-- ^ font-lock-variable-name-face +tbl[k] = "A" +-- ^ font-lock-variable-name-face +tbl.x = 1 +-- ^ font-lock-variable-name-face +for i=0,9 do end +-- ^ font-lock-variable-name-face + +-- Constant +local x <const> = 1 +-- ^ font-lock-constant-face +local f <close> = io.open('/file') +-- ^ font-lock-constant-face +local a, b, c = true, false, nil +-- ^ font-lock-constant-face +-- ^ font-lock-constant-face +-- ^ font-lock-constant-face +::label2:: +-- ^ font-lock-constant-face +goto label2 +-- ^ font-lock-constant-face + +-- Number +n = 123 +-- ^ font-lock-number-face +print(99) +-- ^ font-lock-number-face +print(tbl[1]) +-- ^ font-lock-number-face + +-- Bracket +local t = {} +-- ^ font-lock-bracket-face +-- ^ font-lock-bracket-face +print(t[1]) +-- ^ font-lock-bracket-face +-- ^ font-lock-bracket-face +-- ^ font-lock-bracket-face +-- ^ font-lock-bracket-face + +-- Builtin +assert() +-- <- font-lock-builtin-face +bit32() +-- <- font-lock-builtin-face +collectgarbage() +-- <- font-lock-builtin-face +coroutine() +-- <- font-lock-builtin-face +debug() +-- <- font-lock-builtin-face +dofile() +-- <- font-lock-builtin-face +error() +-- <- font-lock-builtin-face +getmetatable() +-- <- font-lock-builtin-face +io() +-- <- font-lock-builtin-face +ipairs() +-- <- font-lock-builtin-face +load() +-- <- font-lock-builtin-face +loadfile() +-- <- font-lock-builtin-face +math() +-- <- font-lock-builtin-face +next() +-- <- font-lock-builtin-face +os() +-- <- font-lock-builtin-face +package() +-- <- font-lock-builtin-face +pairs() +-- <- font-lock-builtin-face +pcall() +-- <- font-lock-builtin-face +print() +-- <- font-lock-builtin-face +rawequal() +-- <- font-lock-builtin-face +rawget() +-- <- font-lock-builtin-face +rawlen() +-- <- font-lock-builtin-face +rawset() +-- <- font-lock-builtin-face +require() +-- <- font-lock-builtin-face +select() +-- <- font-lock-builtin-face +setmetatable() +-- <- font-lock-builtin-face +string() +-- <- font-lock-builtin-face +table() +-- <- font-lock-builtin-face +tonumber() +-- <- font-lock-builtin-face +tostring() +-- <- font-lock-builtin-face +type() +-- <- font-lock-builtin-face +utf8() +-- <- font-lock-builtin-face +warn() +-- <- font-lock-builtin-face +xpcall() +-- <- font-lock-builtin-face +print(_G) +-- ^ font-lock-builtin-face +print(_VERSION) +-- ^ font-lock-builtin-face +f.close() +-- ^ font-lock-builtin-face +f.flush() +-- ^ font-lock-builtin-face +f.lines() +-- ^ font-lock-builtin-face +f.read() +-- ^ font-lock-builtin-face +f.seek() +-- ^ font-lock-builtin-face +f.setvbuf() +-- ^ font-lock-builtin-face +f.write() +-- ^ font-lock-builtin-face + +-- Delimiter +t = { 1, 2 }; +-- ^ font-lock-delimiter-face +-- ^ font-lock-delimiter-face + +-- Escape +_ = "x\ty" +-- ^ font-lock-escape-face +-- ^ font-lock-escape-face +_ = "x\"y" +-- ^ font-lock-escape-face +-- ^ font-lock-escape-face +_ = 'x\'y' +-- ^ font-lock-escape-face +-- ^ font-lock-escape-face +_ = "x\z + y" +-- <- font-lock-escape-face +_ = "x\x5Ay" +-- ^ font-lock-escape-face +-- ^ font-lock-escape-face +_ = "x\0900y" +-- ^ font-lock-escape-face +_ = "x\09y" +-- ^ font-lock-escape-face +_ = "x\0y" +-- ^ font-lock-escape-face +_ = "x\u{1f602}y" +-- ^ font-lock-escape-face +-- ^ font-lock-escape-face + +-- Function +func_one() +-- ^ font-lock-function-call-face +tbl.func_two() +-- ^ font-lock-function-call-face +tbl:func_three() +-- ^ font-lock-function-call-face +tbl.f = f4() +-- ^ font-lock-function-call-face + +-- Operator +local a, b = 1, 2 +-- ^ font-lock-operator-face +print(a & b) +-- ^ font-lock-operator-face +print(a | b) +-- ^ font-lock-operator-face +print(a ~ b) +-- ^ font-lock-operator-face +print(a << 1) +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +print(a >> 1) +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +print(a+b-a*b/a%b^a//b) +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +-- ^ font-lock-operator-face +print(#t) +-- ^ font-lock-operator-face +print("h".."at") +-- ^ font-lock-operator-face +print(a==b) +-- ^ font-lock-operator-face +print(a~=b) +-- ^ font-lock-operator-face +print(a<=b) +-- ^ font-lock-operator-face +print(a>=b) +-- ^ font-lock-operator-face +print(a<b) +-- ^ font-lock-operator-face +print(a>b) +-- ^ font-lock-operator-face +function ff(...) end +-- ^ font-lock-operator-face + +-- Property +t = { a=1 } +-- ^ font-lock-property-name-face +print(t.a) +-- ^ font-lock-property-use-face + +-- Punctuation +tbl.f2() +-- ^ font-lock-punctuation-face +tbl:f3() +-- ^ font-lock-punctuation-face + +-- Variable +function fn(x, y) end +-- ^ font-lock-variable-name-face +-- ^ font-lock-variable-name-face +fn(a, b) +-- ^ font-lock-variable-use-face +-- ^ font-lock-variable-use-face +print(a + b) +-- ^ font-lock-variable-use-face +-- ^ font-lock-variable-use-face +print(t[a]) +-- ^ font-lock-variable-use-face +tbl.f1(p) +-- ^ font-lock-variable-use-face +tbl:f2(q) +-- ^ font-lock-variable-use-face diff --git a/test/lisp/progmodes/lua-ts-mode-resources/indent.erts b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts new file mode 100644 index 00000000000..9797467bbe5 --- /dev/null +++ b/test/lisp/progmodes/lua-ts-mode-resources/indent.erts @@ -0,0 +1,679 @@ +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-offset 2) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: Chunk Indent + +=-= + print(1) + print(2) +=-= +print(1) +print(2) +=-=-= + +Name: Function Indent + +=-= +function f1(n) +print(n) +return n + 1 +end + +local function f2(n) +print(n) +return n * 2 +end + +local f3 = function(n) +print(n) +return n / 3 +end + +function f4(...) +local f = function (...) +if ok +then print(1) +else print(0) +end +end +return f +end + +function f5(...) +local f = function (...) +if ok +then +print(1) +else +print(0) +end +end +return f +end + +function f6(...) +local f = function (...) +if ok then +print(1) +else +print(0) +end +end +return f +end + +;(function () + return true + end)() +=-= +function f1(n) + print(n) + return n + 1 +end + +local function f2(n) + print(n) + return n * 2 +end + +local f3 = function(n) + print(n) + return n / 3 +end + +function f4(...) + local f = function (...) + if ok + then print(1) + else print(0) + end + end + return f +end + +function f5(...) + local f = function (...) + if ok + then + print(1) + else + print(0) + end + end + return f +end + +function f6(...) + local f = function (...) + if ok then + print(1) + else + print(0) + end + end + return f +end + +;(function () + return true +end)() +=-=-= + +Name: Conditional Indent + +=-= +if true then +print(true) +return 1 +elseif false then +print(false) +return -1 +else +print(nil) +return 0 +end + +if true + then + print(true) + return 1 + elseif false + then + print(false) + return -1 + else + print(nil) + return 0 +end + +if true + then return 1 + elseif false + then return -1 + else return 0 +end +=-= +if true then + print(true) + return 1 +elseif false then + print(false) + return -1 +else + print(nil) + return 0 +end + +if true +then + print(true) + return 1 +elseif false +then + print(false) + return -1 +else + print(nil) + return 0 +end + +if true +then return 1 +elseif false +then return -1 +else return 0 +end +=-=-= + +Name: Loop Indent + +=-= +for k,v in pairs({}) do + print(k) + print(v) +end + +for i=1,10 + do print(i) +end + +while n < 10 do + n = n + 1 + print(n) +end + +while n < 10 + do + n = n + 1 + print(n) +end + +for i=0,9 do +repeat n = n+1 + until n > 99 +end + +repeat +z = z * 2 +print(z) +until z > 12 + + for i,x in ipairs(t) do + while i < 9 + do + local n = t[x] + repeat n = n + 1 + until n > #t + while n < 99 + do + print(n) + end + end + print(t[i]) + end + +do +local a = b +print(a + 1) +end +=-= +for k,v in pairs({}) do + print(k) + print(v) +end + +for i=1,10 +do print(i) +end + +while n < 10 do + n = n + 1 + print(n) +end + +while n < 10 +do + n = n + 1 + print(n) +end + +for i=0,9 do + repeat n = n+1 + until n > 99 +end + +repeat + z = z * 2 + print(z) +until z > 12 + +for i,x in ipairs(t) do + while i < 9 + do + local n = t[x] + repeat n = n + 1 + until n > #t + while n < 99 + do + print(n) + end + end + print(t[i]) +end + +do + local a = b + print(a + 1) +end +=-=-= + +Name: Bracket Indent + +=-= +fn( + ) + +tb={ + } +=-= +fn( +) + +tb={ +} +=-=-= + +Name: Multi-line String Indent + +=-= +local s = [[ + Multi-line + string content + ]] + +function f() + local str = [[ + multi-line + string + ]] +return true +end +=-= +local s = [[ + Multi-line + string content + ]] + +function f() + local str = [[ + multi-line + string + ]] + return true +end +=-=-= + +Name: Multi-line Comment Indent + +=-= +--[[ + Multi-line + comment content + ]] + +function f() +--[[ +multi-line + comment + ]] + return true +end +=-= +--[[ + Multi-line + comment content + ]] + +function f() +--[[ +multi-line + comment + ]] + return true +end +=-=-= + +Name: Argument Indent + +=-= + h( + "string", + 1000 + ) + +local p = h( +"string", + 1000 +) + +fn(1, +2, + 3) + +fn( 1, 2, +3, 4 ) + +f({ +x = 1, +y = 2, +z = 3, +}) + +f({ x = 1, +y = 2, +z = 3, }) + +Test({ +a=1 +}) + +Test({ +a = 1, +b = 2, +}, +nil) +=-= +h( + "string", + 1000 +) + +local p = h( + "string", + 1000 +) + +fn(1, + 2, + 3) + +fn( 1, 2, + 3, 4 ) + +f({ + x = 1, + y = 2, + z = 3, +}) + +f({ x = 1, + y = 2, + z = 3, }) + +Test({ + a=1 +}) + +Test({ + a = 1, + b = 2, + }, + nil) +=-=-= + +Name: Parameter Indent + +=-= +function f1( +a, +b +) +print(a,b) +end + +local function f2(a, + b) +print(a,b) +end + +local f3 = function( a, b, + c, d ) +print(a,b,c,d) +end +=-= +function f1( + a, + b +) + print(a,b) +end + +local function f2(a, + b) + print(a,b) +end + +local f3 = function( a, b, + c, d ) + print(a,b,c,d) +end +=-=-= + +Name: Table Indent + +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} + +local Other = { +a = 1, + b = 2, + c = 3, +} +=-= +local Other = { + First={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Second={up={Step=true,Jump=true}, + down={Step=true,Jump=true}, + left={Step=true,Jump=true}, + right={Step=true,Jump=true}}, + Third={up={Goto=true}, + down={Goto=true}, + left={Goto=true}, + right={Goto=true}} +} + +local Other = { + a = 1, + b = 2, + c = 3, +} +=-=-= + +Code: + (lambda () + (setq indent-tabs-mode nil) + (setq lua-ts-indent-offset 4) + (lua-ts-mode) + (indent-region (point-min) (point-max))) + +Name: End Indent + +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} + end + +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end + end end end +=-= +function f(x) + for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end end end end + return {x,y} or {math.random(),math.random()} +end + +for y=1,x.y do + for x=1,x.z do + if x.y and x.z then + if y <= x then + y = y + 1 + end +end end end +=-=-= + +Name: Nested Function Indent + +=-= +function a(...) + return (function (x) + return x + end)(foo(...)) +end + +function b(n) + local x = 1 + return function (i) + return function (...) + return (function (n, ...) + return function (f, ...) + return (function (...) + if ... and x < 9 then + x = x + 1 + return ... + end end)(n(f, ...)) + end, ... + end)(i(...)) +end end end + +function c(f) + local f1 = function (...) + if nil ~= ... then + return f(...) + end + end + return function (i) + return function (...) + local fn = function (n, ...) + local x = function (f, ...) + return f1(n(f, ...)) + end + return x + end + return fn(i(...)) + end + end +end + +function d(f) + local f1 = function (c, f, ...) + if ... then + if f(...) then + return ... + else + return c(f, ...) + end end end + return function (i) + return function (...) + return (function (n, ...) + local function j (f, ...) + return f1(j, f, n(f, ...)) + end + return j, ... + end)(i(...)) +end end end + +function e (n, t) + return function (i) + return function (...) + return ( + function (n, ...) + local x, y, z = 0, {} + return (function (f, ...) + return (function (i, ...) return i(i, ...) end)( + function (i, ...) + return f(function (x, ...) + return i(i, ...)(x, ...) + end, ...) + end) + end)(function (j) + return function(f, ...) + return (function (c, f, ...) + if ... then + if n+1 == x then + local y1, x1 = y, x + y, x = {}, 0 + return (function (...) + z = ... + return ... + end)(t(y1-1, x1-1, ...)) + else + x = x - 1 + return c(f, + (function (...) + z = ... + return ... + end)(t(y, x, ...))) + end + elseif x ~= 0 then + x = 0 + return z, y + end end)(j, f, n(f, ...)) + end end), ... + end)(i(...)) +end end end +=-=-= diff --git a/test/lisp/progmodes/lua-ts-mode-resources/movement.erts b/test/lisp/progmodes/lua-ts-mode-resources/movement.erts new file mode 100644 index 00000000000..11e86f12926 --- /dev/null +++ b/test/lisp/progmodes/lua-ts-mode-resources/movement.erts @@ -0,0 +1,603 @@ +Code: + (lambda () + (lua-ts-mode) + (beginning-of-defun 1)) + +Point-Char: | + +Name: beginning-of-defun moves to start of function declaration + +=-= +local function Test() + if true then + print(1) + else + print(0) + end| +end +=-= +|local function Test() + if true then + print(1) + else + print(0) + end +end +=-=-= + +Name: beginning-of-defun moves to start of function definition + +=-= +local t = { + f = function() + return true + end, +}| +=-= +local t = { +| f = function() + return true + end, +} +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (end-of-defun 1)) + +Point-Char: | + +Name: end-of-defun moves to end of function declaration + +=-= +local function Test() + if true then + pr|int(1) + else + print(0) + end +end + +local t = Test() +=-= +local function Test() + if true then + print(1) + else + print(0) + end +end +| +local t = Test() +=-=-= + +Name: end-of-defun moves to end of function definition + +=-= +local t = { + f = function() + re|turn true + end, +} +=-= +local t = { + f = function() + return true + end|, +} +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (forward-sentence 1)) + +Point-Char: | + +Name: forward-sentence moves over if statements + +=-= +function f() + |if true then + print(1) + elseif false then + print(0) + else + print(2) + end +end +=-= +function f() + if true then + print(1) + elseif false then + print(0) + else + print(2) + end| +end +=-=-= + +Name: forward-sentence moves over variable declaration + +=-= +|local n = 1 + +print(n) +=-= +local n = 1| + +print(n) +=-=-= + +Name: forward-sentence moves over for statements + +=-= +|for k, v in pairs({}) do + print(k, v) +end + +print(1) +=-= +for k, v in pairs({}) do + print(k, v) +end| + +print(1) +=-=-= + +Name: forward-sentence moves over do statements + +=-= +|do + local x = 1 + local y = 2 + + print(x, y) +end + +print(1) +=-= +do + local x = 1 + local y = 2 + + print(x, y) +end| + +print(1) +=-=-= + +Name: forward-sentence moves over while statements + +=-= +local i = 0 +|while i < 9 do + print(i) + i = i + 1 +end + +print(1) +=-= +local i = 0 +while i < 9 do + print(i) + i = i + 1 +end| + +print(1) +=-=-= + +Name: forward-sentence moves over repeat statements + +=-= +local i = 0 +|repeat + print(i) + i = i + 1 +until i > 9 + +print(1) +=-= +local i = 0 +repeat + print(i) + i = i + 1 +until i > 9| + +print(1) +=-=-= + +Name: forward-sentence moves over function calls + +=-= +|print(1) +=-= +print(1)| +=-=-= + +Name: forward-sentence moves over return statements + +=-= +function f() + |return math.random() +end +=-= +function f() + return math.random()| +end +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (forward-sentence 2)) + +Name: forward-sentence moves over table fields + +=-= +local t = { + |a = 1, + b = 2, +} +=-= +local t = { + a = 1, + b = 2|, +} +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (backward-sentence 1)) + +Point-Char: | + +Name: backward-sentence moves over if statements + +=-= +function f() + if true then + print(1) + elseif false then + print(0) + else + print(2) + end| +end +=-= +function f() + |if true then + print(1) + elseif false then + print(0) + else + print(2) + end +end +=-=-= + +Name: backward-sentence moves over variable declaration + +=-= +local n = 1| + +print(n) +=-= +|local n = 1 + +print(n) +=-=-= + +Name: backward-sentence moves over for statements + +=-= +for k, v in pairs({}) do + print(k, v) +end| + +print(1) +=-= +|for k, v in pairs({}) do + print(k, v) +end + +print(1) +=-=-= + +Name: backward-sentence moves over for statements + +=-= +do + local x = 1 + local y = 2 + + print(x, y) +end| + +print(1) +=-= +|do + local x = 1 + local y = 2 + + print(x, y) +end + +print(1) +=-=-= + +Name: backward-sentence moves over while statements + +=-= +local i = 0 +while i < 9 do + print(i) + i = i + 1 +end| + +print(1) +=-= +local i = 0 +|while i < 9 do + print(i) + i = i + 1 +end + +print(1) +=-=-= + +Name: backward-sentence moves over repeat statements + +=-= +local i = 0 +repeat + print(i) + i = i + 1 +until i > 9| + +print(1) +=-= +local i = 0 +|repeat + print(i) + i = i + 1 +until i > 9 + +print(1) +=-=-= + +Name: backward-sentence moves over function calls + +=-= +print(1)| +=-= +|print(1) +=-=-= + +Name: backward-sentence moves over return statements + +=-= +function f() + return math.random()| +end +=-= +function f() + |return math.random() +end +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (backward-sentence 2)) + +Point-Char: | + +Name: backward-sentence moves over table fields + +=-= +local t = { + a = 1, + b = 2|, +} +=-= +local t = { + |a = 1, + b = 2, +} +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (forward-sexp 1)) + +Point-Char: | + +Name: forward-sexp moves over arguments + +=-= +print|(1, 2, 3) +=-= +print(1, 2, 3)| +=-=-= + +Name: forward-sexp moves over parameters + +=-= +function f|(a, b) end +=-= +function f(a, b)| end +=-=-= + +Name: forward-sexp moves over strings + +=-= +print("|1, 2, 3") +=-= +print("1, 2, 3|") +=-=-= + +Name: forward-sexp moves over tables + +=-= +local t = |{ 1, + 2, + 3 } +=-= +local t = { 1, + 2, + 3 }| +=-=-= + +Name: forward-sexp moves over parenthesized expressions + +=-= +|(function (x) return x + 1 end)(41) +=-= +(function (x) return x + 1 end)|(41) +=-=-= + +Name: forward-sexp moves over function declarations + +=-= +|function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end| +=-=-= + +Name: forward-sexp moves over do statements + +=-= +|do + print(a + 1) +end +=-= +do + print(a + 1) +end| +=-=-= + +Name: forward-sexp moves over for statements + +=-= +|for k,v in pairs({}) do + print(k, v) +end +=-= +for k,v in pairs({}) do + print(k, v) +end| +=-=-= + +Name: forward-sexp moves over repeat statements + +=-= +|repeat + n = n + 1 +until n > 10 +=-= +repeat + n = n + 1 +until n > 10| +=-=-= + +Name: forward-sexp moves over while statements + +=-= +|while n < 99 +do + n = n+1 +end +=-= +while n < 99 +do + n = n+1 +end| +=-=-= + +Code: + (lambda () + (lua-ts-mode) + (backward-sexp 1)) + +Point-Char: | + +Name: backward-sexp moves over arguments + +=-= +print(1, 2, 3)| +=-= +print|(1, 2, 3) +=-=-= + +Name: backward-sexp moves over parameters + +=-= +function f(a, b)| end +=-= +function f|(a, b) end +=-=-= + +Name: backward-sexp moves over strings + +=-= +print("1, 2, 3|") +=-= +print("|1, 2, 3") +=-=-= + +Name: backward-sexp moves over tables + +=-= +local t = { 1, + 2, + 3 }| +=-= +local t = |{ 1, + 2, + 3 } +=-=-= + +Name: backward-sexp moves over parenthesized expressions + +=-= +(function (x) return x + 1 end)|(41) +=-= +|(function (x) return x + 1 end)(41) +=-=-= + +Name: backward-sexp moves over function declarations + +=-= +function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end| +=-= +|function foo (x) + if false then + print "foo" + elseif true then + print "bar" + end +end +=-=-= diff --git a/test/lisp/progmodes/lua-ts-mode-tests.el b/test/lisp/progmodes/lua-ts-mode-tests.el new file mode 100644 index 00000000000..8a566d777e3 --- /dev/null +++ b/test/lisp/progmodes/lua-ts-mode-tests.el @@ -0,0 +1,42 @@ +;;; lua-ts-mode-tests.el --- Tests for lua-ts-mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'ert-font-lock) +(require 'ert-x) +(require 'treesit) + +(ert-deftest lua-ts-test-indentation () + (skip-unless (treesit-ready-p 'lua)) + (ert-test-erts-file (ert-resource-file "indent.erts"))) + +(ert-deftest lua-ts-test-movement () + (skip-unless (treesit-ready-p 'lua)) + (ert-test-erts-file (ert-resource-file "movement.erts"))) + +(ert-deftest lua-ts-test-font-lock () + (skip-unless (treesit-ready-p 'lua)) + (let ((treesit-font-lock-level 4)) + (ert-font-lock-test-file (ert-resource-file "font-lock.lua") 'lua-ts-mode))) + +(provide 'lua-ts-mode-tests) + +;;; lua-ts-mode-tests.el ends here diff --git a/test/lisp/progmodes/perl-mode-tests.el b/test/lisp/progmodes/perl-mode-tests.el index 3b22c5d8750..e72bdf30711 100644 --- a/test/lisp/progmodes/perl-mode-tests.el +++ b/test/lisp/progmodes/perl-mode-tests.el @@ -28,6 +28,23 @@ (font-lock-ensure (point-min) (point-max)) (should (equal (get-text-property 4 'face) 'font-lock-variable-name-face)))) +(ert-deftest perl-test-bug-34245 () + "Test correct indentation after a hanging paren, with and without comments." + (with-temp-buffer + (perl-mode) + (insert "my @foo = (\n\"bar\",\n\"baz\",\n);") + (insert "\n\n") + (insert "my @ofoo = (\t\t# A comment.\n\"obar\",\n\"obaz\",\n);") + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + (forward-line) + (skip-chars-forward " \t") + (should (equal (current-column) perl-indent-level)) + (search-forward "# A comment.") + (forward-line) + (skip-chars-forward " \t") + (should (equal (current-column) perl-indent-level)))) + ;;;; Reuse cperl-mode tests (defvar cperl-test-mode) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 5a206b67db1..d335864ca2e 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -137,6 +137,7 @@ When `project-ignores' includes a name matching project dir." (project-vc-extra-root-markers '("files-x-tests.*")) (project (project-current nil dir))) (should-not (null project)) + (should (nth 1 project)) (should (string-match-p "/test/lisp/\\'" (project-root project))))) (ert-deftest project-vc-supports-project-in-different-dir () diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 59287970ca0..3ba720061ab 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -683,7 +683,7 @@ def long_function_name( (should (= (python-indent-calculate-indentation) 8)) (python-tests-look-at "var_four):") (should (eq (car (python-indent-context)) - :inside-paren-newline-start-from-block)) + :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 8)) (python-tests-look-at "print (var_one)") (should (eq (car (python-indent-context)) @@ -707,8 +707,8 @@ foo = long_function_name( (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 4)) (python-tests-look-at "var_three, var_four)") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) - (should (= (python-indent-calculate-indentation) 4)))) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) + (should (= (python-indent-calculate-indentation) 2)))) (ert-deftest python-indent-hanging-close-paren () "Like first pep8 case, but with hanging close paren." ;; See Bug#20742. @@ -864,7 +864,7 @@ data = { (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 4)) (python-tests-look-at "{") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 4)) (python-tests-look-at "'objlist': [") (should (eq (car (python-indent-context)) :inside-paren-newline-start)) @@ -876,20 +876,20 @@ data = { (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 16)) (python-tests-look-at "'name': 'first',") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 16)) (python-tests-look-at "},") (should (eq (car (python-indent-context)) :inside-paren-at-closing-nested-paren)) (should (= (python-indent-calculate-indentation) 12)) (python-tests-look-at "{") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 12)) (python-tests-look-at "'pk': 2,") (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 16)) (python-tests-look-at "'name': 'second',") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 16)) (python-tests-look-at "}") (should (eq (car (python-indent-context)) @@ -933,7 +933,7 @@ data = {'key': { (should (eq (car (python-indent-context)) :inside-paren)) (should (= (python-indent-calculate-indentation) 9)) (python-tests-look-at "{'pk': 2,") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 8)) (python-tests-look-at "'name': 'second'}") (should (eq (car (python-indent-context)) :inside-paren)) @@ -966,10 +966,10 @@ data = ('these', (should (eq (car (python-indent-context)) :inside-paren)) (should (= (python-indent-calculate-indentation) 8)) (forward-line 1) - (should (eq (car (python-indent-context)) :inside-paren)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 8)) (forward-line 1) - (should (eq (car (python-indent-context)) :inside-paren)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 8)))) (ert-deftest python-indent-inside-paren-4 () @@ -999,7 +999,7 @@ while ((not some_condition) and (should (eq (car (python-indent-context)) :no-indent)) (should (= (python-indent-calculate-indentation) 0)) (forward-line 1) - (should (eq (car (python-indent-context)) :inside-paren)) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) (should (= (python-indent-calculate-indentation) 7)) (forward-line 1) (should (eq (car (python-indent-context)) :after-block-start)) @@ -1023,7 +1023,7 @@ CHOICES = (('some', 'choice'), (should (eq (car (python-indent-context)) :inside-paren)) (should (= (python-indent-calculate-indentation) 11)) (forward-line 1) - (should (eq (car (python-indent-context)) :inside-paren)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 11)))) (ert-deftest python-indent-inside-paren-7 () @@ -1034,6 +1034,183 @@ CHOICES = (('some', 'choice'), ;; This signals an error if the test fails (should (eq (car (python-indent-context)) :inside-paren-newline-start)))) +(ert-deftest python-indent-inside-paren-8 () + "Test for Bug#63959." + (python-tests-with-temp-buffer + " +for a in [ # comment + 'some', # Manually indented. + 'thing']: # Respect indentation of the previous line. +" + (python-tests-look-at "for a in [ # comment") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) + :inside-paren-newline-start-from-block)) + (should (= (python-indent-calculate-indentation) 8)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) + (should (= (python-indent-calculate-indentation) 10)))) + +(ert-deftest python-indent-inside-paren-9 () + "Test `:inside-paren-continuation-line'." + (python-tests-with-temp-buffer + " +a = ((( + 1, 2), + 3), # Do not respect the indentation of the previous line + 4) # Do not respect the indentation of the previous line +b = (( + 1, 2), # Manually indented + 3, # Do not respect the indentation of the previous line + 4, # Respect the indentation of the previous line + 5, # Manually indented + 6) # Respect the indentation of the previous line +" + (python-tests-look-at "a = (((") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren)) + (should (= (python-indent-calculate-indentation) 6)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren)) + (should (= (python-indent-calculate-indentation) 5)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-line)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren)) + (should (= (python-indent-calculate-indentation) 5)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) + (should (= (python-indent-calculate-indentation) 5)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) + (should (= (python-indent-calculate-indentation) 5)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) + (should (= (python-indent-calculate-indentation) 8)))) + +(ert-deftest python-indent-inside-paren-block-1 () + "`python-indent-block-paren-deeper' set to nil (default). +See Bug#62696." + (python-tests-with-temp-buffer + " +if ('VALUE' in my_unnecessarily_long_dictionary and + some_other_long_condition_case): + do_something() +elif (some_case or + another_case): + do_another() +" + (python-tests-look-at "if") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :at-dedenter-block-start)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 6)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)))) + +(ert-deftest python-indent-inside-paren-block-2 () + "`python-indent-block-paren-deeper' set to t. +See Bug#62696." + (python-tests-with-temp-buffer + " +if ('VALUE' in my_unnecessarily_long_dictionary and + some_other_long_condition_case): + do_something() +elif (some_case or + another_case): + do_another() +" + (let ((python-indent-block-paren-deeper t)) + (python-tests-look-at "if") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 8)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :at-dedenter-block-start)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 6)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4))))) + +(ert-deftest python-indent-inside-paren-block-3 () + "With backslash. `python-indent-block-paren-deeper' set to nil (default). +See Bug#62696." + (python-tests-with-temp-buffer + " +if 'VALUE' in my_uncessarily_long_dictionary and\\ + (some_other_long_condition_case or + another_case): + do_something() +" + (python-tests-look-at "if") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) + :after-backslash-block-continuation)) + (should (= (python-indent-calculate-indentation) 3)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 4)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4)))) + +(ert-deftest python-indent-inside-paren-block-4 () + "With backslash. `python-indent-block-paren-deeper' set to t. +See Bug#62696." + (python-tests-with-temp-buffer + " +if 'VALUE' in my_uncessarily_long_dictionary and\\ + (some_other_long_condition_case or + another_case): + do_something() +" + (let ((python-indent-block-paren-deeper t)) + (python-tests-look-at "if") + (should (eq (car (python-indent-context)) :no-indent)) + (should (= (python-indent-calculate-indentation) 0)) + (forward-line 1) + (should (eq (car (python-indent-context)) + :after-backslash-block-continuation)) + (should (= (python-indent-calculate-indentation) 3)) + (forward-line 1) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) + (should (= (python-indent-calculate-indentation) 8)) + (forward-line 1) + (should (eq (car (python-indent-context)) :after-block-start)) + (should (= (python-indent-calculate-indentation) 4))))) + (ert-deftest python-indent-after-block-1 () "The most simple after-block case that shouldn't fail." (python-tests-with-temp-buffer @@ -1159,7 +1336,7 @@ objects = Thing.objects.all() \\ (should (eq (car (python-indent-context)) :inside-paren-newline-start)) (should (= (python-indent-calculate-indentation) 27)) (python-tests-look-at "status='bought'") - (should (eq (car (python-indent-context)) :inside-paren-newline-start)) + (should (eq (car (python-indent-context)) :inside-paren-continuation-line)) (should (= (python-indent-calculate-indentation) 27)) (python-tests-look-at ") \\") (should (eq (car (python-indent-context)) :inside-paren-at-closing-paren)) @@ -1530,7 +1707,7 @@ a == 4): (should (= (python-indent-calculate-indentation) 0)) (should (= (python-indent-calculate-indentation t) 0)) (python-tests-look-at "a == 4):\n") - (should (eq (car (python-indent-context)) :inside-paren)) + (should (eq (car (python-indent-context)) :inside-paren-from-block)) (should (= (python-indent-calculate-indentation) 6)) (python-indent-line) (should (= (python-indent-calculate-indentation t) 4)) @@ -4741,7 +4918,7 @@ import abc ;; Skip the test on macOS, since the standard Python installation uses ;; libedit rather than readline which confuses the running of an inferior ;; interpreter in this case (see bug#59477 and bug#25753). - (skip-unless (not (eq system-type 'darwin))) + (skip-when (eq system-type 'darwin)) (trace-function 'python-shell-output-filter) (python-tests-with-temp-buffer-with-shell " @@ -5796,9 +5973,9 @@ def func(): else " (python-tests-look-at "else\n") - (should - (equal (list (python-tests-look-at "if (" -1 t)) - (python-info-dedenter-opening-block-positions))))) + (should + (equal (list (python-tests-look-at "if (" -1 t)) + (python-info-dedenter-opening-block-positions))))) (ert-deftest python-info-dedenter-opening-block-positions-7 () "Test case blocks." @@ -5816,9 +5993,9 @@ match a: (python-tests-look-at "case 2:") (should-not (python-info-dedenter-opening-block-positions)) (python-tests-look-at "case 3:") - (equal (list (python-tests-look-at "case 2:" -1) - (python-tests-look-at "case 1:" -1 t)) - (python-info-dedenter-opening-block-positions)))) + (should (equal (list (python-tests-look-at "case 2:" -1 t) + (python-tests-look-at "case 1:" -1 t)) + (python-info-dedenter-opening-block-positions))))) (ert-deftest python-info-dedenter-opening-block-message-1 () "Test dedenters inside strings are ignored." diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index 81d0dfd75c9..a411b39a8fc 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -34,11 +34,11 @@ x = # "tot %q/to"; = # Regexp after whitelisted method. "abc".sub /b/, 'd' -# Don't mismatch "sub" at the end of words. -a = asub / aslb + bsub / bslb; +# Don't mistake division for regexp. +a = sub / aslb + bsub / bslb; # Highlight the regexp after "if". -x = toto / foo if /do bar/ =~ "dobar" +x = toto / foo if / do bar/ =~ "dobar" # Regexp options are highlighted. diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index a931541ba35..fea5f58b92e 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -164,7 +164,7 @@ VALUES-PLIST is a list with alternating index and value elements." (ruby-assert-state "x = index/3" 3 nil)) (ert-deftest ruby-regexp-not-division-when-only-space-before () - (ruby-assert-state "x = index /3" 3 ?/)) + (ruby-assert-state "x = foo_index /3" 3 ?/)) (ert-deftest ruby-slash-not-regexp-when-only-space-after () (ruby-assert-state "x = index/ 3" 3 nil)) diff --git a/test/lisp/progmodes/sh-script-resources/sh-indents.erts b/test/lisp/progmodes/sh-script-resources/sh-indents.erts index 1f92610b3aa..36f4e4c22ab 100644 --- a/test/lisp/progmodes/sh-script-resources/sh-indents.erts +++ b/test/lisp/progmodes/sh-script-resources/sh-indents.erts @@ -38,3 +38,10 @@ if test ;then fi other =-=-= + +Name: sh-indents5 + +=-= +for i do echo 1; done +for i; do echo 1; done +=-=-= diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el index c850a5d8af7..135d7afe3fe 100644 --- a/test/lisp/progmodes/sh-script-tests.el +++ b/test/lisp/progmodes/sh-script-tests.el @@ -52,6 +52,24 @@ (ert-deftest test-indentation () (ert-test-erts-file (ert-resource-file "sh-indents.erts"))) +(ert-deftest test-indent-after-continuation () + (with-temp-buffer + (insert "for f \\\nin a; do \\\ntoto; \\\ndone\n") + (shell-script-mode) + (let ((sh-indent-for-continuation '++)) + (let ((sh-indent-after-continuation t)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "for f \\\n\tin a; do \\\n toto; \\\n done\n"))) + (let ((sh-indent-after-continuation 'always)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "for f \\\n\tin a; do \\\n\ttoto; \\\n\tdone\n"))) + (let ((sh-indent-after-continuation nil)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) + "for f \\\nin a; do \\\n toto; \\\ndone\n")))))) + (defun test-sh-back (string &optional pos) (with-temp-buffer (shell-script-mode) @@ -69,4 +87,15 @@ (should-not (test-sh-back "foo;bar")) (should (test-sh-back "foo#zot"))) +(ert-deftest sh-script-test-do-fontification () + "Test that \"do\" gets fontified correctly, even with no \";\"." + (with-temp-buffer + (shell-script-mode) + (insert "for i do echo 1; done") + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "do") + (forward-char -1) + (should (equal (get-text-property (point) 'face) 'font-lock-keyword-face)))) + ;;; sh-script-tests.el ends here diff --git a/test/lisp/progmodes/which-func-tests.el b/test/lisp/progmodes/which-func-tests.el new file mode 100644 index 00000000000..73709f1c5e5 --- /dev/null +++ b/test/lisp/progmodes/which-func-tests.el @@ -0,0 +1,58 @@ +;;; which-func-tests.el --- tests for which-func -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Spencer Baugh <sbaugh@catern.com> + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: +(require 'ert) +(require 'which-func) + +(ert-deftest which-func-tests-toggle () + (let ((which-func-display 'mode-and-header) buf-code buf-not) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should-not which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode 1) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (which-function-mode -1) + ;; which-func-mode stays set even when which-function-mode is off. + (with-current-buffer buf-code + (should which-func-mode) (should-not header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)) + (kill-buffer buf-code) + (kill-buffer buf-not) + (which-function-mode 1) + (setq buf-code (find-file-noselect "which-func-tests.el")) + (setq buf-not (get-buffer-create "fundamental")) + (with-current-buffer buf-code + (should which-func-mode) (should header-line-format)) + (with-current-buffer buf-not + (should-not which-func-mode) (should-not header-line-format)))) + +(provide 'which-func-tests) +;;; which-func-tests.el ends here |