Bug [#1797]. Highlight changed subroutine prototype syntax for Perl 5.20.

5 files changed, 567 insertions, 17 deletions

diff --git a/doc/ScintillaHistory.html b/doc/ScintillaHistory.html
index ee6e719a4..505f659d6 100644
--- a/doc/ScintillaHistory.html
+++ b/doc/ScintillaHistory.html
@@ -533,7 +533,9 @@
 	Double-diamond operator &lt;&lt;&gt;&gt;.<br />
 	Hexadecimal floating point literals.<br />
 	Repetition in list assignment.
-	<a href="http://sourceforge.net/p/scintilla/bugs/1793/">Bug #1793</a>.
+	<a href="http://sourceforge.net/p/scintilla/bugs/1793/">Bug #1793</a>.<br />
+	Highlight changed subroutine prototype syntax for Perl 5.20.
+	<a href="http://sourceforge.net/p/scintilla/bugs/1797/">Bug #1797</a>.
 	</li>
 	<li>
 	Send SCN_UPDATEUI with SC_UPDATE_SELECTION when the application changes multiple
diff --git a/lexers/LexPerl.cxx b/lexers/LexPerl.cxx
index 3a69bf8cc..dccad1542 100644
--- a/lexers/LexPerl.cxx
+++ b/lexers/LexPerl.cxx
@@ -65,6 +65,12 @@ using namespace Scintilla;
 #define BACK_OPERATOR	1	// whitespace/comments are insignificant
 #define BACK_KEYWORD	2	// operators/keywords are needed for disambiguation
 
+#define SUB_BEGIN		0	// states for subroutine prototype scan:
+#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
+
 // 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
 #define	INTERPOLATE_SHIFT	(SCE_PL_STRING_VAR - SCE_PL_STRING)
@@ -136,6 +142,22 @@ static void skipWhitespaceComment(LexAccessor &styler, Sci_PositionU &p) {
 		p--;
 }
 
+static int findPrevLexeme(LexAccessor &styler, Sci_PositionU &bk, int &style) {
+	// scan backward past whitespace and comments to find a lexeme
+	skipWhitespaceComment(styler, bk);
+	if (bk == 0)
+		return 0;
+	int sz = 1;
+	style = styler.StyleAt(bk);
+	while (bk > 0) {	// find extent of lexeme
+		if (styler.StyleAt(bk - 1) == style) {
+			bk--; sz++;
+		} else
+			break;
+	}
+	return sz;
+}
+
 static int styleBeforeBracePair(LexAccessor &styler, Sci_PositionU bk) {
 	// backtrack to find open '{' corresponding to a '}', balanced
 	// return significant style to be tested for '/' disambiguation
@@ -214,20 +236,59 @@ static int podLineScan(LexAccessor &styler, Sci_PositionU &pos, Sci_PositionU en
 
 static bool styleCheckSubPrototype(LexAccessor &styler, Sci_PositionU bk) {
 	// backtrack to identify if we're starting a subroutine prototype
-	// we also need to ignore whitespace/comments:
-	// 'sub' [whitespace|comment] <identifier> [whitespace|comment]
+	// we also need to ignore whitespace/comments, format is like:
+	//     sub abc::pqr :const :prototype(...)
+	// lexemes are tested in pairs, e.g. '::'+'pqr', ':'+'const', etc.
+	// and a state machine generates legal subroutine syntax matches
 	styler.Flush();
-	skipWhitespaceComment(styler, bk);
-	if (bk == 0 || styler.StyleAt(bk) != SCE_PL_IDENTIFIER)	// check identifier
-		return false;
-	while (bk > 0 && (styler.StyleAt(bk) == SCE_PL_IDENTIFIER)) {
-		bk--;
-	}
-	skipWhitespaceComment(styler, bk);
-	if (bk < 2 || styler.StyleAt(bk) != SCE_PL_WORD	// check "sub" keyword
-	        || !styler.Match(bk - 2, "sub"))	// assume suffix is unique!
-		return false;
-	return true;
+	int state = SUB_BEGIN;
+	do {
+		// find two lexemes, lexeme 2 follows lexeme 1
+		int style2 = SCE_PL_DEFAULT;
+		Sci_PositionU pos2 = bk;
+		int len2 = findPrevLexeme(styler, pos2, style2);
+		int style1 = SCE_PL_DEFAULT;
+		Sci_PositionU pos1 = pos2;
+		if (pos1 > 0) pos1--;
+		int len1 = findPrevLexeme(styler, pos1, style1);
+		if (len1 == 0 || len2 == 0)		// lexeme pair must exist
+			break;
+
+		// match parts of syntax, if invalid subroutine syntax, break off
+		if (style1 == SCE_PL_OPERATOR && len1 == 1 &&
+		    styler.SafeGetCharAt(pos1) == ':') {	// ':'
+			if (style2 == SCE_PL_IDENTIFIER || style2 == SCE_PL_WORD) {
+				if (len2 == 9 && styler.Match(pos2, "prototype")) {	// ':' 'prototype'
+					if (state == SUB_BEGIN) {
+						state = SUB_HAS_PROTO;
+					} else
+						break;
+				} else {	// ':' <attribute>
+					if (state == SUB_HAS_PROTO || state == SUB_HAS_ATTRIB) {
+						state = SUB_HAS_ATTRIB;
+					} else
+						break;
+				}
+			} else
+				break;
+		} else if (style1 == SCE_PL_OPERATOR && len1 == 2 &&
+		           styler.Match(pos1, "::")) {	// '::'
+			if (style2 == SCE_PL_IDENTIFIER) {	// '::' <identifier>
+				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>
+				state = SUB_HAS_SUB;
+			} else
+				break;
+		} else
+			break;
+		bk = pos1;			// set position for finding next lexeme pair
+		if (bk > 0) bk--;
+	} while (state != SUB_HAS_SUB);
+	return (state == SUB_HAS_SUB);
 }
 
 static int actualNumStyle(int numberStyle) {
@@ -537,7 +598,7 @@ void SCI_METHOD LexerPerl::Lex(Sci_PositionU startPos, Sci_Position length, int
 	CharacterSet &setPOD = setModifiers;
 	CharacterSet setNonHereDoc(CharacterSet::setDigits, "=$@");
 	CharacterSet setHereDocDelim(CharacterSet::setAlphaNum, "_");
-	CharacterSet setSubPrototype(CharacterSet::setNone, "\\[$@%&*+];_");
+	CharacterSet setSubPrototype(CharacterSet::setNone, "\\[$@%&*+];_ \t");
 	// for format identifiers
 	CharacterSet setFormatStart(CharacterSet::setAlpha, "_=");
 	CharacterSet &setFormat = setHereDocDelim;
diff --git a/test/examples/perl-test-sub-prototypes.pl b/test/examples/perl-test-sub-prototypes.pl
new file mode 100644
index 000000000..9cfb488ba
--- /dev/null
+++ b/test/examples/perl-test-sub-prototypes.pl
@@ -0,0 +1,239 @@
+# -*- coding: utf-8 -*-
+#--------------------------------------------------------------------------
+# perl-test-sub-prototypes.pl
+#--------------------------------------------------------------------------
+# compiled all relevant subroutine prototype test cases
+#
+#--------------------------------------------------------------------------
+# Kein-Hong Man <keinhong@gmail.com> Public Domain
+#--------------------------------------------------------------------------
+# 20151227	initial document
+#--------------------------------------------------------------------------
+
+#--------------------------------------------------------------------------
+# test cases for sub syntax scanner
+#--------------------------------------------------------------------------
+# sub syntax: simple and with added module notation
+#--------------------------------------------------------------------------
+
+sub fish($) { 123; }
+sub fish::chips($) { 123; }			# module syntax
+sub fish::chips::sauce($) { 123; }		# multiple module syntax
+
+sub fish :: chips  ::		sauce ($) { 123; }	# added whitespace
+
+sub fish :: # embedded comment
+chips 	# embedded comment
+ :: sauce ($) { 123; }
+
+sub fish :: ($) { 123; }	# incomplete or bad syntax examples
+sub fish :: 123 ($) { 123; }
+sub fish :: chips 123 ($) { 123; }
+sub 123 ($) { 123; }
+
+#--------------------------------------------------------------------------
+# sub syntax: prototype attributes
+#--------------------------------------------------------------------------
+
+sub fish:prototype($) { 123; }
+sub fish : prototype	($) { 123; }		# added whitespace
+
+sub fish:salted($) { 123; }	# wrong attribute example (must use 'prototype')
+sub fish :  123($) { 123; }	# illegal attribute
+sub fish:prototype:salted($) { 123; }	# wrong 'prototype' position
+sub fish:salted salt:prototype($) { 123; }	# wrong attribute syntax
+
+sub fish:const:prototype($) { 123; }		# extra attributes
+sub fish:const:lvalue:prototype($) { 123; }
+sub fish:const:prototype($):lvalue{ 123; }	# might be legal too
+sub fish  :const	:prototype($) { 123; }	# extra whitespace
+
+sub fish  :const	# embedded comment: a constant sub
+:prototype		# embedded comment
+($) { 123; }
+
+#--------------------------------------------------------------------------
+# sub syntax: mixed
+#--------------------------------------------------------------------------
+
+sub fish::chips:prototype($) { 123; }
+sub fish::chips::sauce:prototype($) { 123; }
+sub fish  ::chips  ::sauce	:prototype($) { 123; }	# +whitespace
+
+sub fish::chips::sauce:const:prototype($) { 123; }
+sub fish::chips::sauce	:const	:prototype($) { 123; }	# +whitespace
+
+sub fish		# embedded comment
+::chips	::sauce		# embedded comment
+  : const		# embedded comment
+	: prototype ($) { 123; }
+
+# wrong syntax examples, parentheses must follow ':prototype'
+sub fish :prototype :const ($) { 123;}
+sub fish :prototype ::chips ($) { 123;}
+
+#--------------------------------------------------------------------------
+# perl-test-5200delta.pl
+#--------------------------------------------------------------------------
+# More consistent prototype parsing
+#--------------------------------------------------------------------------
+# - whitespace now allowed, lexer now allows spaces or tabs
+
+sub foo ( $ $ ) {}
+sub foo ( 			 ) {}		# spaces/tabs empty
+sub foo (  *  ) {}
+sub foo (@	) {}
+sub foo (	%) {}
+
+# untested, should probably be \[ but scanner does not check this for now
+sub foo ( \ [ $ @ % & * ] ) {}
+
+#--------------------------------------------------------------------------
+# perl-test-5140delta.pl
+#--------------------------------------------------------------------------
+# new + prototype character, acts like (\[@%])
+#--------------------------------------------------------------------------
+
+# these samples work as before
+sub mylink ($$)          # mylink $old, $new
+sub myvec ($$$)          # myvec $var, $offset, 1
+sub myindex ($$;$)       # myindex &getstring, "substr"
+sub mysyswrite ($$$;$)   # mysyswrite $buf, 0, length($buf) - $off, $off
+sub myreverse (@)        # myreverse $a, $b, $c
+sub myjoin ($@)          # myjoin ":", $a, $b, $c
+sub myopen (*;$)         # myopen HANDLE, $name
+sub mypipe (**)          # mypipe READHANDLE, WRITEHANDLE
+sub mygrep (&@)          # mygrep { /foo/ } $a, $b, $c
+sub myrand (;$)          # myrand 42
+sub mytime ()            # mytime
+
+# backslash group notation to specify more than one allowed argument type
+sub myref (\[$@%&*]) {}
+
+sub mysub (_)            # underscore can be optionally used FIXED 20151211
+
+# these uses the new '+' prototype character
+sub mypop (+)            # mypop @array
+sub mysplice (+$$@)      # mysplice @array, 0, 2, @pushme
+sub mykeys (+)           # mykeys %{$hashref}
+
+#--------------------------------------------------------------------------
+# perl-test-5200delta.pl
+#--------------------------------------------------------------------------
+# Experimental Subroutine signatures (mostly works)
+#--------------------------------------------------------------------------
+# INCLUDED FOR COMPLETENESS ONLY
+# IMPORTANT NOTE the subroutine prototypes lexing implementation has
+# no effect on subroutine signature syntax highlighting
+
+# subroutine signatures mostly looks fine except for the @ and % slurpy
+# notation which are highlighted as operators (all other parameters are
+# highlighted as vars of some sort), a minor aesthetic issue
+
+use feature 'signatures';
+
+sub foo ($left, $right) {		# mandatory positional parameters
+    return $left + $right;
+}
+sub foo ($first, $, $third) {		# ignore second argument
+    return "first=$first, third=$third";
+}
+sub foo ($left, $right = 0) {		# optional parameter with default value
+    return $left + $right;
+}
+my $auto_id = 0;			# default value expression, evaluated if default used only
+sub foo ($thing, $id = $auto_id++) {
+    print "$thing has ID $id";
+}
+sub foo ($first_name, $surname, $nickname = $first_name) {	# 3rd parm may depend on 1st parm
+    print "$first_name $surname is known as \"$nickname\"";
+}
+sub foo ($thing, $ = 1) {		# nameless default parameter
+    print $thing;
+}
+sub foo ($thing, $=) {			# (this does something, I'm not sure what...)
+    print $thing;
+}
+sub foo ($filter, @inputs) {		# additional arguments (slurpy parameter)
+    print $filter->($_) foreach @inputs;
+}
+sub foo ($thing, @) {			# nameless slurpy parameter FAILS for now
+    print $thing;
+}
+sub foo ($filter, %inputs) {		# slurpy parameter, hash type
+    print $filter->($_, $inputs{$_}) foreach sort keys %inputs;
+}
+sub foo ($thing, %) {			# nameless slurpy parm, hash type FAILS for now
+    print $thing;
+}
+sub foo () {				# empty signature no arguments (styled as prototype)
+    return 123;
+}
+
+#--------------------------------------------------------------------------
+# perl-test-5200delta.pl
+#--------------------------------------------------------------------------
+# subs now take a prototype attribute
+#--------------------------------------------------------------------------
+
+sub foo :prototype($) { $_[0] }
+
+sub foo :prototype($$) ($left, $right) {
+    return $left + $right;
+}
+
+sub foo : prototype($$){}		# whitespace allowed
+
+# additional samples from perl-test-cases.pl with ':prototype' added:
+sub mylink :prototype($$) {}		sub myvec :prototype($$$) {}
+sub myindex :prototype($$;$) {}		sub mysyswrite :prototype($$$;$) {}
+sub myreverse :prototype(@) {}		sub myjoin :prototype($@) {}
+sub mypop :prototype(\@) {}		sub mysplice :prototype(\@$$@) {}
+sub mykeys :prototype(\%) {}		sub myopen :prototype(*;$) {}
+sub mypipe :prototype(**) {}		sub mygrep :prototype(&@) {}
+sub myrand :prototype($) {}		sub mytime :prototype() {}
+# backslash group notation to specify more than one allowed argument type
+sub myref :prototype(\[$@%&*]) {}
+
+# additional attributes may complicate scanning for prototype syntax,
+# for example (from https://metacpan.org/pod/perlsub):
+# Lvalue subroutines
+
+my $val;
+sub canmod : lvalue {
+    $val;  # or:  return $val;
+}
+canmod() = 5;   # assigns to $val
+
+#--------------------------------------------------------------------------
+# perl-test-5220delta.pl
+#--------------------------------------------------------------------------
+# New :const subroutine attribute
+#--------------------------------------------------------------------------
+
+my $x = 54321;
+*INLINED = sub : const { $x };
+$x++;
+
+# more examples of attributes
+# (not 5.22 stuff, but some general examples for study, useful for
+#  handling subroutine signature and subroutine prototype highlighting)
+
+sub foo : lvalue ;
+
+package X;
+sub Y::z : lvalue { 1 }
+
+package X;
+sub foo { 1 }
+package Y;
+BEGIN { *bar = \&X::foo; }
+package Z;
+sub Y::bar : lvalue ;
+
+# built-in attributes for subroutines:
+lvalue method prototype(..) locked const
+
+#--------------------------------------------------------------------------
+# end of test file
+#--------------------------------------------------------------------------
diff --git a/test/examples/perl-test-sub-prototypes.pl.styled b/test/examples/perl-test-sub-prototypes.pl.styled
new file mode 100644
index 000000000..96d578846
--- /dev/null
+++ b/test/examples/perl-test-sub-prototypes.pl.styled
@@ -0,0 +1,239 @@
+{2}# -*- coding: utf-8 -*-{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-sub-prototypes.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# compiled all relevant subroutine prototype test cases{0}
+{2}#{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# Kein-Hong Man <keinhong@gmail.com> Public Domain{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# 20151227	initial document{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# test cases for sub syntax scanner{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# sub syntax: simple and with added module notation{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{5}sub{0} {11}fish{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{10}::{11}chips{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}			{2}# module syntax{0}
+{5}sub{0} {11}fish{10}::{11}chips{10}::{11}sauce{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}		{2}# multiple module syntax{0}
+
+{5}sub{0} {11}fish{0} {10}::{0} {11}chips{0}  {10}::{0}		{11}sauce{0} {40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# added whitespace{0}
+
+{5}sub{0} {11}fish{0} {10}::{0} {2}# embedded comment{0}
+{11}chips{0} 	{2}# embedded comment{0}
+ {10}::{0} {11}sauce{0} {40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+
+{5}sub{0} {11}fish{0} {10}::{0} {10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# incomplete or bad syntax examples{0}
+{5}sub{0} {11}fish{0} {10}::{0} {4}123{0} {10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{0} {10}::{0} {11}chips{0} {4}123{0} {10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {4}123{0} {10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# sub syntax: prototype attributes{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{5}sub{0} {11}fish{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{0} {10}:{0} {5}prototype{0}	{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}		{2}# added whitespace{0}
+
+{5}sub{0} {11}fish{10}:{11}salted{10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# wrong attribute example (must use 'prototype'){0}
+{5}sub{0} {11}fish{0} {10}:{0}  {4}123{10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# illegal attribute{0}
+{5}sub{0} {11}fish{10}:{5}prototype{10}:{11}salted{10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# wrong 'prototype' position{0}
+{5}sub{0} {11}fish{10}:{11}salted{0} {11}salt{10}:{5}prototype{10}({12}$){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# wrong attribute syntax{0}
+
+{5}sub{0} {11}fish{10}:{11}const{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}		{2}# extra attributes{0}
+{5}sub{0} {11}fish{10}:{11}const{10}:{11}lvalue{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{10}:{11}const{10}:{5}prototype{40}($){10}:{11}lvalue{10}{{0} {4}123{10};{0} {10}}{0}	{2}# might be legal too{0}
+{5}sub{0} {11}fish{0}  {10}:{11}const{0}	{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# extra whitespace{0}
+
+{5}sub{0} {11}fish{0}  {10}:{11}const{0}	{2}# embedded comment: a constant sub{0}
+{10}:{5}prototype{0}		{2}# embedded comment{0}
+{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# sub syntax: mixed{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{5}sub{0} {11}fish{10}::{11}chips{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{10}::{11}chips{10}::{11}sauce{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{0}  {10}::{11}chips{0}  {10}::{11}sauce{0}	{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# +whitespace{0}
+
+{5}sub{0} {11}fish{10}::{11}chips{10}::{11}sauce{10}:{11}const{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+{5}sub{0} {11}fish{10}::{11}chips{10}::{11}sauce{0}	{10}:{11}const{0}	{10}:{5}prototype{40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}	{2}# +whitespace{0}
+
+{5}sub{0} {11}fish{0}		{2}# embedded comment{0}
+{10}::{11}chips{0}	{10}::{11}sauce{0}		{2}# embedded comment{0}
+  {10}:{0} {11}const{0}		{2}# embedded comment{0}
+	{10}:{0} {5}prototype{0} {40}($){0} {10}{{0} {4}123{10};{0} {10}}{0}
+
+{2}# wrong syntax examples, parentheses must follow ':prototype'{0}
+{5}sub{0} {11}fish{0} {10}:{5}prototype{0} {10}:{11}const{0} {10}({12}$){0} {10}{{0} {4}123{10};}{0}
+{5}sub{0} {11}fish{0} {10}:{5}prototype{0} {10}::{11}chips{0} {10}({12}$){0} {10}{{0} {4}123{10};}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-5200delta.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# More consistent prototype parsing{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# - whitespace now allowed, lexer now allows spaces or tabs{0}
+
+{5}sub{0} {11}foo{0} {40}( $ $ ){0} {10}{}{0}
+{5}sub{0} {11}foo{0} {40}( 			 ){0} {10}{}{0}		{2}# spaces/tabs empty{0}
+{5}sub{0} {11}foo{0} {40}(  *  ){0} {10}{}{0}
+{5}sub{0} {11}foo{0} {40}(@	){0} {10}{}{0}
+{5}sub{0} {11}foo{0} {40}(	%){0} {10}{}{0}
+
+{2}# untested, should probably be \[ but scanner does not check this for now{0}
+{5}sub{0} {11}foo{0} {40}( \ [ $ @ % & * ] ){0} {10}{}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-5140delta.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# new + prototype character, acts like (\[@%]){0}
+{2}#--------------------------------------------------------------------------{0}
+
+{2}# these samples work as before{0}
+{5}sub{0} {11}mylink{0} {40}($$){0}          {2}# mylink $old, $new{0}
+{5}sub{0} {11}myvec{0} {40}($$$){0}          {2}# myvec $var, $offset, 1{0}
+{5}sub{0} {11}myindex{0} {40}($$;$){0}       {2}# myindex &getstring, "substr"{0}
+{5}sub{0} {11}mysyswrite{0} {40}($$$;$){0}   {2}# mysyswrite $buf, 0, length($buf) - $off, $off{0}
+{5}sub{0} {11}myreverse{0} {40}(@){0}        {2}# myreverse $a, $b, $c{0}
+{5}sub{0} {11}myjoin{0} {40}($@){0}          {2}# myjoin ":", $a, $b, $c{0}
+{5}sub{0} {11}myopen{0} {40}(*;$){0}         {2}# myopen HANDLE, $name{0}
+{5}sub{0} {11}mypipe{0} {40}(**){0}          {2}# mypipe READHANDLE, WRITEHANDLE{0}
+{5}sub{0} {11}mygrep{0} {40}(&@){0}          {2}# mygrep { /foo/ } $a, $b, $c{0}
+{5}sub{0} {11}myrand{0} {40}(;$){0}          {2}# myrand 42{0}
+{5}sub{0} {11}mytime{0} {40}(){0}            {2}# mytime{0}
+
+{2}# backslash group notation to specify more than one allowed argument type{0}
+{5}sub{0} {11}myref{0} {40}(\[$@%&*]){0} {10}{}{0}
+
+{5}sub{0} {11}mysub{0} {40}(_){0}            {2}# underscore can be optionally used FIXED 20151211{0}
+
+{2}# these uses the new '+' prototype character{0}
+{5}sub{0} {11}mypop{0} {40}(+){0}            {2}# mypop @array{0}
+{5}sub{0} {11}mysplice{0} {40}(+$$@){0}      {2}# mysplice @array, 0, 2, @pushme{0}
+{5}sub{0} {11}mykeys{0} {40}(+){0}           {2}# mykeys %{$hashref}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-5200delta.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# Experimental Subroutine signatures (mostly works){0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# INCLUDED FOR COMPLETENESS ONLY{0}
+{2}# IMPORTANT NOTE the subroutine prototypes lexing implementation has{0}
+{2}# no effect on subroutine signature syntax highlighting{0}
+
+{2}# subroutine signatures mostly looks fine except for the @ and % slurpy{0}
+{2}# notation which are highlighted as operators (all other parameters are{0}
+{2}# highlighted as vars of some sort), a minor aesthetic issue{0}
+
+{5}use{0} {11}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}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$first{10},{0} {12}$,{0} {12}$third{10}){0} {10}{{0}		{2}# ignore second argument{0}
+    {5}return{0} {6}"first={43}$first{6}, third={43}$third{6}"{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$left{10},{0} {12}$right{0} {10}={0} {4}0{10}){0} {10}{{0}		{2}# optional parameter with default value{0}
+    {5}return{0} {12}$left{0} {10}+{0} {12}$right{10};{0}
+{10}}{0}
+{5}my{0} {12}$auto_id{0} {10}={0} {4}0{10};{0}			{2}# default value expression, evaluated if default used only{0}
+{5}sub{0} {11}foo{0} {10}({12}$thing{10},{0} {12}$id{0} {10}={0} {12}$auto_id{10}++){0} {10}{{0}
+    {5}print{0} {6}"{43}$thing{6} has ID {43}$id{6}"{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$first_name{10},{0} {12}$surname{10},{0} {12}$nickname{0} {10}={0} {12}$first_name{10}){0} {10}{{0}	{2}# 3rd parm may depend on 1st parm{0}
+    {5}print{0} {6}"{43}$first_name{6} {43}$surname{6} is known as \"{43}$nickname{6}\""{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$thing{10},{0} {12}${0} {10}={0} {4}1{10}){0} {10}{{0}		{2}# nameless default parameter{0}
+    {5}print{0} {12}$thing{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$thing{10},{0} {12}$={10}){0} {10}{{0}			{2}# (this does something, I'm not sure what...){0}
+    {5}print{0} {12}$thing{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$filter{10},{0} {13}@inputs{10}){0} {10}{{0}		{2}# additional arguments (slurpy parameter){0}
+    {5}print{0} {12}$filter{10}->({12}$_{10}){0} {5}foreach{0} {13}@inputs{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$thing{10},{0} {10}@){0} {10}{{0}			{2}# nameless slurpy parameter FAILS for now{0}
+    {5}print{0} {12}$thing{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$filter{10},{0} {14}%inputs{10}){0} {10}{{0}		{2}# slurpy parameter, hash type{0}
+    {5}print{0} {12}$filter{10}->({12}$_{10},{0} {12}$inputs{10}{{12}$_{10}}){0} {5}foreach{0} {5}sort{0} {5}keys{0} {14}%inputs{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {10}({12}$thing{10},{0} {10}%){0} {10}{{0}			{2}# nameless slurpy parm, hash type FAILS for now{0}
+    {5}print{0} {12}$thing{10};{0}
+{10}}{0}
+{5}sub{0} {11}foo{0} {40}(){0} {10}{{0}				{2}# empty signature no arguments (styled as prototype){0}
+    {5}return{0} {4}123{10};{0}
+{10}}{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-5200delta.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# subs now take a prototype attribute{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{5}sub{0} {11}foo{0} {10}:{5}prototype{40}($){0} {10}{{0} {12}$_{10}[{4}0{10}]{0} {10}}{0}
+
+{5}sub{0} {11}foo{0} {10}:{5}prototype{40}($$){0} {10}({12}$left{10},{0} {12}$right{10}){0} {10}{{0}
+    {5}return{0} {12}$left{0} {10}+{0} {12}$right{10};{0}
+{10}}{0}
+
+{5}sub{0} {11}foo{0} {10}:{0} {5}prototype{40}($$){10}{}{0}		{2}# whitespace allowed{0}
+
+{2}# additional samples from perl-test-cases.pl with ':prototype' added:{0}
+{5}sub{0} {11}mylink{0} {10}:{5}prototype{40}($$){0} {10}{}{0}		{5}sub{0} {11}myvec{0} {10}:{5}prototype{40}($$$){0} {10}{}{0}
+{5}sub{0} {11}myindex{0} {10}:{5}prototype{40}($$;$){0} {10}{}{0}		{5}sub{0} {11}mysyswrite{0} {10}:{5}prototype{40}($$$;$){0} {10}{}{0}
+{5}sub{0} {11}myreverse{0} {10}:{5}prototype{40}(@){0} {10}{}{0}		{5}sub{0} {11}myjoin{0} {10}:{5}prototype{40}($@){0} {10}{}{0}
+{5}sub{0} {11}mypop{0} {10}:{5}prototype{40}(\@){0} {10}{}{0}		{5}sub{0} {11}mysplice{0} {10}:{5}prototype{40}(\@$$@){0} {10}{}{0}
+{5}sub{0} {11}mykeys{0} {10}:{5}prototype{40}(\%){0} {10}{}{0}		{5}sub{0} {11}myopen{0} {10}:{5}prototype{40}(*;$){0} {10}{}{0}
+{5}sub{0} {11}mypipe{0} {10}:{5}prototype{40}(**){0} {10}{}{0}		{5}sub{0} {11}mygrep{0} {10}:{5}prototype{40}(&@){0} {10}{}{0}
+{5}sub{0} {11}myrand{0} {10}:{5}prototype{40}($){0} {10}{}{0}		{5}sub{0} {11}mytime{0} {10}:{5}prototype{40}(){0} {10}{}{0}
+{2}# backslash group notation to specify more than one allowed argument type{0}
+{5}sub{0} {11}myref{0} {10}:{5}prototype{40}(\[$@%&*]){0} {10}{}{0}
+
+{2}# additional attributes may complicate scanning for prototype syntax,{0}
+{2}# for example (from https://metacpan.org/pod/perlsub):{0}
+{2}# Lvalue subroutines{0}
+
+{5}my{0} {12}$val{10};{0}
+{5}sub{0} {11}canmod{0} {10}:{0} {11}lvalue{0} {10}{{0}
+    {12}$val{10};{0}  {2}# or:  return $val;{0}
+{10}}{0}
+{11}canmod{10}(){0} {10}={0} {4}5{10};{0}   {2}# assigns to $val{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# perl-test-5220delta.pl{0}
+{2}#--------------------------------------------------------------------------{0}
+{2}# New :const subroutine attribute{0}
+{2}#--------------------------------------------------------------------------{0}
+
+{5}my{0} {12}$x{0} {10}={0} {4}54321{10};{0}
+{15}*INLINED{0} {10}={0} {5}sub{0} {10}:{0} {11}const{0} {10}{{0} {12}$x{0} {10}};{0}
+{12}$x{10}++;{0}
+
+{2}# more examples of attributes{0}
+{2}# (not 5.22 stuff, but some general examples for study, useful for{0}
+{2}#  handling subroutine signature and subroutine prototype highlighting){0}
+
+{5}sub{0} {11}foo{0} {10}:{0} {11}lvalue{0} {10};{0}
+
+{5}package{0} {11}X{10};{0}
+{5}sub{0} {11}Y{10}::{11}z{0} {10}:{0} {11}lvalue{0} {10}{{0} {4}1{0} {10}}{0}
+
+{5}package{0} {11}X{10};{0}
+{5}sub{0} {11}foo{0} {10}{{0} {4}1{0} {10}}{0}
+{5}package{0} {11}Y{10};{0}
+{5}BEGIN{0} {10}{{0} {15}*bar{0} {10}={0} {10}\&{11}X{10}::{11}foo{10};{0} {10}}{0}
+{5}package{0} {11}Z{10};{0}
+{5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0}
+
+{2}# built-in attributes for subroutines:{0}
+{11}lvalue{0} {11}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0}
+
+{2}#--------------------------------------------------------------------------{0}
+{2}# end of test file{0}
+{2}#--------------------------------------------------------------------------{0}
diff --git a/test/lexTests.py b/test/lexTests.py
index 421c6393b..3cb80ef38 100644
--- a/test/lexTests.py
+++ b/test/lexTests.py
@@ -130,6 +130,12 @@ class TestLexers(unittest.TestCase):
 					# Give up after one failure
 					return
 
+	# Test lexing just once from beginning to end in text form.
+	# This is used for test cases that are too long to be exhasutively tested by lines and
+	# may be sensitive to line ends so are tested as if using Unix LF line ends.
+	def LexLongCase(self, name, lexerName, keywords, fileMode="b"):
+		self.LexExample(name, lexerName, keywords, "t")
+
 	def testCXX(self):
 		self.LexExample("x.cxx", b"cpp", [b"int"])
 
@@ -158,8 +164,11 @@ class TestLexers(unittest.TestCase):
 	def testPerl(self):
 		self.LexExample("x.pl", b"perl", keywordsPerl)
 
-	def testPerlCases(self):
-		self.LexExample("perl-test-5220delta.pl", b"perl", keywordsPerl, "t")
+	def testPerl52(self):
+		self.LexLongCase("perl-test-5220delta.pl", b"perl", keywordsPerl)
+
+	def testPerlPrototypes(self):
+		self.LexLongCase("perl-test-sub-prototypes.pl", b"perl", keywordsPerl)
 
 	def testD(self):
 		self.LexExample("x.d", b"d",