Perl: Handle 'method' the same as 'sub' for special cases

b4n · b4n · commit b3c7dfa45415 · 2025-12-27T14:54:01.000+01:00
Fixes #342.
diff --git 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' <identifier>
+		} 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') <identifier>
 				state = SUB_HAS_SUB;
 			} else
 				break;
diff --git a/test/examples/perl/class.pl 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
@@ -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   
diff --git a/test/examples/perl/class.pl.styled 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} {11}feature{0} {7}'class'{10};{0}
+
+{11}class{0} {11}MyClass{10}::{11}SubClass{0} {10}{{0}
+    {11}method{0} {11}inClass{0} {10}{{0} {5}return{0} {4}1{0} {10}}{0}
+    {11}method{0} {11}inClassProto{40}($){0} {10}{{0} {5}return{0} {12}$_{10}[{4}0{10}]{0} {10}}{0}
+    {11}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}
