From 8c3c714e57e5d2cd7825043a7b03d423823ae872 Mon Sep 17 00:00:00 2001 From: Colomban Wendling Date: Mon, 29 Dec 2025 10:54:48 +0100 Subject: [PATCH 1/2] Tests: Perl: Update keywords with current SciTE's This will be useful for an upcoming test. --- test/examples/perl/SciTE.properties | 59 ++++++++++--------- .../perl/perl-test-5220delta.pl.styled | 10 ++-- .../perl/perl-test-sub-prototypes.pl.styled | 4 +- test/examples/perl/x.pl.styled | 2 +- 4 files changed, 39 insertions(+), 36 deletions(-) diff --git a/test/examples/perl/SciTE.properties b/test/examples/perl/SciTE.properties index da97ffaa1..769f1b0e2 100644 --- a/test/examples/perl/SciTE.properties +++ b/test/examples/perl/SciTE.properties @@ -1,33 +1,36 @@ lexer.*.pl=perl keywords.*.pl=\ -NULL __FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ AUTOLOAD \ -BEGIN CORE DESTROY END EQ GE GT INIT LE LT NE CHECK abs accept \ -alarm and atan2 bind binmode bless caller chdir chmod chomp chop \ -chown chr chroot close closedir cmp connect continue cos crypt \ -dbmclose dbmopen defined delete die do dump each else elsif endgrent \ -endhostent endnetent endprotoent endpwent endservent eof eq eval \ -exec exists exit exp fcntl fileno flock for foreach fork format \ -formline ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname \ -gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername \ -getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent \ -getpwent getpwnam getpwuid getservbyname getservbyport getservent \ -getsockname getsockopt glob gmtime goto grep gt hex if index \ -int ioctl join keys kill last lc lcfirst le length link listen \ -local localtime lock log lstat lt map mkdir msgctl msgget msgrcv \ -msgsnd my ne next no not oct open opendir or ord our pack package \ -pipe pop pos print printf prototype push quotemeta qu \ -rand read readdir readline readlink readpipe recv redo \ -ref rename require reset return reverse rewinddir rindex rmdir \ -scalar seek seekdir select semctl semget semop send setgrent \ -sethostent setnetent setpgrp setpriority setprotoent setpwent \ -setservent setsockopt shift shmctl shmget shmread shmwrite shutdown \ -sin sleep socket socketpair sort splice split sprintf sqrt srand \ -stat study sub substr symlink syscall sysopen sysread sysseek \ -system syswrite tell telldir tie tied time times truncate \ -uc ucfirst umask undef unless unlink unpack unshift untie until \ -use utime values vec wait waitpid wantarray warn while write \ -xor \ -given when default break say state UNITCHECK __SUB__ fc +ADJUST AUTOLOAD BEGIN CHECK CORE DESTROY END EQ GE GT INIT LE LT NE NULL \ +UNITCHECK __CLASS__ __DATA__ __END__ __FILE__ __LINE__ __PACKAGE__ \ +__SUB__ abs accept alarm all and any atan2 attributes autodie autouse \ +base bigfloat bigint bignum bigrat bind binmode bless blib break builtin \ +bytes caller catch charnames chdir chmod chomp chop chown chr chroot \ +class close closedir cmp connect constant continue cos crypt dbmclose \ +dbmopen default defer defined delete deprecate diagnostics die do dump \ +each else elseif elsif encoding endgrent endhostent endnetent \ +endprotoent endpwent endservent eof eq eval evalbytes exec exists exit \ +exp experimental fc fcntl feature field fields fileno filetest finally \ +flock for foreach fork format formline ge getc getgrent getgrgid \ +getgrnam gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr \ +getnetbyname getnetent getpeername getpgrp getppid getpriority \ +getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid \ +getservbyname getservbyport getservent getsockname getsockopt given glob \ +gmtime goto grep gt hex if import index int integer ioctl isa join keys \ +kill last lc lcfirst le length less lib link listen local locale \ +localtime lock log lstat lt map meta_notation method mkdir mro msgctl \ +msgget msgrcv msgsnd my ne next no not oct ok open opendir ops or ord \ +our overload overloading pack package parent perlfaq pipe pop pos print \ +printf prototype push qu quotemeta rand re read readdir readline \ +readlink readpipe recv redo ref rename require reset return reverse \ +rewinddir rindex rmdir say scalar seek seekdir select semctl semget \ +semop send setgrent sethostent setnetent setpgrp setpriority setprotoent \ +setpwent setservent setsockopt shift shmctl shmget shmread shmwrite \ +shutdown sigtrap sin size sleep socket socketpair sort splice split \ +sprintf sqrt srand stable stat state strict study sub subs substr \ +symlink syscall sysopen sysread sysseek system syswrite tell telldir \ +threads tie tied time times truncate try uc ucfirst umask undef unless \ +unlink unpack unshift untie until use utf8 utime values vars vec version \ +vmsish wait waitpid wantarray warn warnings when while write xor fold=1 fold.comment=1 \ No newline at end of file diff --git a/test/examples/perl/perl-test-5220delta.pl.styled b/test/examples/perl/perl-test-5220delta.pl.styled index 4a763a47a..9d7ac0d33 100644 --- a/test/examples/perl/perl-test-5220delta.pl.styled +++ b/test/examples/perl/perl-test-5220delta.pl.styled @@ -19,8 +19,8 @@ # New bitwise operators #-------------------------------------------------------------------------- {0} -{5}use{0} {11}feature{0} {7}'bitwise'{0} {2}# enable feature, warning enabled -{5}use{0} {11}experimental{0} {6}"bitwise"{10};{0} {2}# enable feature, warning disabled +{5}use{0} {5}feature{0} {7}'bitwise'{0} {2}# enable feature, warning enabled +{5}use{0} {5}experimental{0} {6}"bitwise"{10};{0} {2}# enable feature, warning disabled {0} {2}# numerical operands {4}10{10}&{4}20{0} {4}10{10}|{4}20{0} {4}10{10}^{4}20{0} {10}~{4}10{0} @@ -77,12 +77,12 @@ {2}# example snippet from brian d foy's blog post {0} -{5}use{0} {11}feature{0} {30}qw(refaliasing){10};{0} +{5}use{0} {5}feature{0} {30}qw(refaliasing){10};{0} {10}\{14}%other_hash{0} {10}={0} {10}\{14}%hash{10};{0} {5}use{0} {6}v5.22{10};{0} -{5}use{0} {11}feature{0} {30}qw(refaliasing){10};{0} +{5}use{0} {5}feature{0} {30}qw(refaliasing){10};{0} {5}foreach{0} {10}\{5}my{0} {14}%hash{0} {10}({0} {13}@array_of_hashes{0} {10}){0} {10}{{0} {2}# named hash control variable {0} {5}foreach{0} {5}my{0} {12}$key{0} {10}({0} {5}keys{0} {14}%hash{0} {10}){0} {10}{{0} {2}# named hash now! @@ -115,7 +115,7 @@ {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0} {2}# built-in attributes for subroutines: -{11}lvalue{0} {11}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} +{11}lvalue{0} {5}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} {2}#-------------------------------------------------------------------------- # Repetition in list assignment diff --git a/test/examples/perl/perl-test-sub-prototypes.pl.styled b/test/examples/perl/perl-test-sub-prototypes.pl.styled index e7290803b..726f5e2a0 100644 --- a/test/examples/perl/perl-test-sub-prototypes.pl.styled +++ b/test/examples/perl/perl-test-sub-prototypes.pl.styled @@ -130,7 +130,7 @@ # notation which are highlighted as operators (all other parameters are # highlighted as vars of some sort), a minor aesthetic issue {0} -{5}use{0} {11}feature{0} {7}'signatures'{10};{0} +{5}use{0} {5}feature{0} {7}'signatures'{10};{0} {5}sub{0} {11}foo{0} {10}({12}$left{10},{0} {12}$right{10}){0} {10}{{0} {2}# mandatory positional parameters {0} {5}return{0} {12}$left{0} {10}+{0} {12}$right{10};{0} @@ -232,7 +232,7 @@ {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0} {2}# built-in attributes for subroutines: -{11}lvalue{0} {11}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} +{11}lvalue{0} {5}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} {2}#-------------------------------------------------------------------------- # end of test file diff --git a/test/examples/perl/x.pl.styled b/test/examples/perl/x.pl.styled index 74da4e911..1d900c9be 100644 --- a/test/examples/perl/x.pl.styled +++ b/test/examples/perl/x.pl.styled @@ -1,4 +1,4 @@ -{5}use{0} {11}strict{10};{0} +{5}use{0} {5}strict{10};{0} {5}while{0} {10}({0} {12}$r{0} {10}){0} {10}{{0} {5}printf{0} {10}({0} {6}"Example text \n"{0} {10});{0} {5}sleep{0} {4}1{10};{0} From 4efd0b79c00315f3fee8650872190fe55e837b65 Mon Sep 17 00:00:00 2001 From: Colomban Wendling Date: Sat, 27 Dec 2025 13:04:35 +0100 Subject: [PATCH 2/2] Perl: Handle 'method' the same as 'sub' for special cases Fixes #342. --- lexers/LexPerl.cxx | 14 ++++++++------ test/examples/perl/class.pl | 9 +++++++++ test/examples/perl/class.pl.folded | 10 ++++++++++ test/examples/perl/class.pl.styled | 9 +++++++++ test/examples/perl/perl-test-5220delta.pl.styled | 2 +- .../perl/perl-test-sub-prototypes.pl.styled | 2 +- 6 files changed, 38 insertions(+), 8 deletions(-) create mode 100644 test/examples/perl/class.pl create mode 100644 test/examples/perl/class.pl.folded create mode 100644 test/examples/perl/class.pl.styled diff --git a/lexers/LexPerl.cxx b/lexers/LexPerl.cxx index dcc0342e6..fe22bf9b3 100644 --- a/lexers/LexPerl.cxx +++ b/lexers/LexPerl.cxx @@ -87,7 +87,7 @@ namespace { #define SUB_HAS_PROTO 1 // only 'prototype' attribute allows prototypes #define SUB_HAS_ATTRIB 2 // other attributes can exist leftward #define SUB_HAS_MODULE 3 // sub name can have a ::identifier part -#define SUB_HAS_SUB 4 // 'sub' keyword +#define SUB_HAS_SUB 4 // 'sub' (or 'method') keyword // all interpolated styles are different from their parent styles by a constant difference // we also assume SCE_PL_STRING_VAR is the interpolated style with the smallest value @@ -131,8 +131,9 @@ int disambiguateBareword(LexAccessor &styler, Sci_PositionU bk, Sci_PositionU fw // ->bareword: part of variable spec || styler.Match(bk - 1, "::") // ::bareword: part of module spec - || styler.Match(bk - 2, "sub")) { - // sub bareword: subroutine declaration + || styler.Match(bk - 2, "sub") + || styler.Match(bk - 5, "method")) { + // 'sub' or 'method' bareword: subroutine declaration // (implied BACK_KEYWORD, no keywords end in 'sub'!) result |= 1; } @@ -299,9 +300,10 @@ bool styleCheckSubPrototype(LexAccessor &styler, Sci_PositionU bk) { state = SUB_HAS_MODULE; } else break; - } else if (style1 == SCE_PL_WORD && len1 == 3 && - styler.Match(pos1, "sub")) { // 'sub' - if (style2 == SCE_PL_IDENTIFIER) { // 'sub' + } else if ((style1 == SCE_PL_WORD || style1 == SCE_PL_IDENTIFIER) && + ((len1 == 3 && styler.Match(pos1, "sub")) || // 'sub' + (len1 == 6 && styler.Match(pos1, "method")))) { // or 'method + if (style2 == SCE_PL_IDENTIFIER) { // ('sub' | 'method') state = SUB_HAS_SUB; } else break; diff --git a/test/examples/perl/class.pl b/test/examples/perl/class.pl new file mode 100644 index 000000000..cb2290c41 --- /dev/null +++ b/test/examples/perl/class.pl @@ -0,0 +1,9 @@ +#!/usr/bin/env perl +use v5.38; +use feature 'class'; + +class MyClass::SubClass { + method inClass { return 1 } + method inClassProto($) { return $_[0] } + method inClassAttrib :prototype($) { return $_[0] } +} diff --git a/test/examples/perl/class.pl.folded b/test/examples/perl/class.pl.folded new file mode 100644 index 000000000..4569d8168 --- /dev/null +++ b/test/examples/perl/class.pl.folded @@ -0,0 +1,10 @@ + 0 400 400 #!/usr/bin/env perl + 0 400 400 use v5.38; + 0 400 400 use feature 'class'; + 1 400 400 + 2 400 401 + class MyClass::SubClass { + 0 401 401 | method inClass { return 1 } + 0 401 401 | method inClassProto($) { return $_[0] } + 0 401 401 | method inClassAttrib :prototype($) { return $_[0] } + 0 401 400 | } + 0 400 0 \ No newline at end of file diff --git a/test/examples/perl/class.pl.styled b/test/examples/perl/class.pl.styled new file mode 100644 index 000000000..ff6e54398 --- /dev/null +++ b/test/examples/perl/class.pl.styled @@ -0,0 +1,9 @@ +{2}#!/usr/bin/env perl +{5}use{0} {6}v5.38{10};{0} +{5}use{0} {5}feature{0} {7}'class'{10};{0} + +{5}class{0} {11}MyClass{10}::{11}SubClass{0} {10}{{0} + {5}method{0} {11}inClass{0} {10}{{0} {5}return{0} {4}1{0} {10}}{0} + {5}method{0} {11}inClassProto{40}($){0} {10}{{0} {5}return{0} {12}$_{10}[{4}0{10}]{0} {10}}{0} + {5}method{0} {11}inClassAttrib{0} {10}:{5}prototype{40}($){0} {10}{{0} {5}return{0} {12}$_{10}[{4}0{10}]{0} {10}}{0} +{10}}{0} diff --git a/test/examples/perl/perl-test-5220delta.pl.styled b/test/examples/perl/perl-test-5220delta.pl.styled index 9d7ac0d33..002a9ec23 100644 --- a/test/examples/perl/perl-test-5220delta.pl.styled +++ b/test/examples/perl/perl-test-5220delta.pl.styled @@ -115,7 +115,7 @@ {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0} {2}# built-in attributes for subroutines: -{11}lvalue{0} {5}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} +{11}lvalue{0} {5}method{0} {11}prototype{10}(..){0} {11}locked{0} {11}const{0} {2}#-------------------------------------------------------------------------- # Repetition in list assignment diff --git a/test/examples/perl/perl-test-sub-prototypes.pl.styled b/test/examples/perl/perl-test-sub-prototypes.pl.styled index 726f5e2a0..226b67725 100644 --- a/test/examples/perl/perl-test-sub-prototypes.pl.styled +++ b/test/examples/perl/perl-test-sub-prototypes.pl.styled @@ -232,7 +232,7 @@ {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0} {2}# built-in attributes for subroutines: -{11}lvalue{0} {5}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0} +{11}lvalue{0} {5}method{0} {11}prototype{10}(..){0} {11}locked{0} {11}const{0} {2}#-------------------------------------------------------------------------- # end of test file