[PATCH 6/7] userdiff/perl: catch sub with brace on second line

From: Jonathan Nieder <jrnieder@gmail.com>
Date: May 21, 2011, 19:38 UTC
Message-ID: <20110521193826.GG10530@elie>
In-Reply-To: <20110521185314.GA10530@elie>

Accept

	sub foo
	{
	}

as an alternative to a more common style that introduces perl functions with a brace on the first line (and likewise for BEGIN/END blocks). The new regex is a little hairy to avoid matching

	# forward declaration
	sub foo;

while continuing to match "sub foo($;@) {" and

	sub foo { # This routine is interesting;
		# in fact, the lines below explain how...

While at it, pay attention to Perl 5.14's "package foo {" syntax as an alternative to the traditional "package foo;".

Requested-by: Ævar Arnfjörð Bjarmason <avarab@gmail.com>
Signed-off-by: Jonathan Nieder <jrnieder@gmail.com>
---
 t/t4018-diff-funcname.sh |   25 +++++++++++++++++++++++--
 userdiff.c               |   20 +++++++++++++++++---
 2 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/t/t4018-diff-funcname.sh b/t/t4018-diff-funcname.sh
index 8a57149..b2fd1a9 100755
--- a/t/t4018-diff-funcname.sh
+++ b/t/t4018-diff-funcname.sh
@@ -35,7 +35,11 @@ package Beer;
 use strict;
 use warnings;
 use parent qw(Exporter);
-our @EXPORT_OK = qw(round);
+our @EXPORT_OK = qw(round finalround);
+
+sub other; # forward declaration
+
+# hello
 
 sub round {
 	my ($n) = @_;
@@ -46,6 +50,12 @@ sub round {
 	print "$n bottles of beer on the wall.\n";
 }
 
+sub finalround
+{
+	print "Go to the store, buy some more\n";
+	print "99 bottles of beer on the wall.\n");
+}
+
 __END__
 
 =head1 NAME
@@ -54,12 +64,13 @@ Beer - subroutine to output fragment of a drinking song
 
 =head1 SYNOPSIS
 
-	use Beer qw(round);
+	use Beer qw(round finalround);
 
 	sub song {
 		for (my $i = 99; $i > 0; $i--) {
 			round $i;
 		}
+		finalround;
 	}
 
 	song;
@@ -67,7 +78,9 @@ Beer - subroutine to output fragment of a drinking song
 =cut
 EOF
 sed -e '
+	s/hello/goodbye/
 	s/beer\\/beer,\\/
+	s/more\\/more,\\/
 	s/song;/song();/
 ' <Beer.perl >Beer-correct.perl
 
@@ -121,6 +134,10 @@ test_expect_success 'preset perl pattern' '
 	test_expect_funcname "sub round {\$" perl
 '
 
+test_expect_success 'perl pattern accepts K&R style brace placement, too' '
+	test_expect_funcname "sub finalround\$" perl
+'
+
 test_expect_success 'perl pattern is not distracted by sub within POD' '
 	test_expect_funcname "=head" perl
 '
@@ -129,6 +146,10 @@ test_expect_success 'perl pattern gets full line of POD header' '
 	test_expect_funcname "=head1 SYNOPSIS\$" perl
 '
 
+test_expect_success 'perl pattern is not distracted by forward declaration' '
+	test_expect_funcname "package Beer;\$" perl
+'
+
 test_expect_success 'custom pattern' '
 	test_config diff.java.funcname "!static
 !String
diff --git a/userdiff.c b/userdiff.c
index 32ead96..42b86ac 100644
--- a/userdiff.c
+++ b/userdiff.c
@@ -60,9 +60,23 @@ PATTERNS("pascal",
 	 "|[-+0-9.e]+|0[xXbB]?[0-9a-fA-F]+"
 	 "|<>|<=|>=|:=|\\.\\."),
 PATTERNS("perl",
-	 "^package .*;\n"
-	 "^sub .* \\{\n"
-	 "^[A-Z]+ \\{\n"	/* BEGIN, END, ... */
+	 "^package .*\n"
+	 "^sub [[:alnum:]_':]+[ \t]*"
+		"(\\([^)]*\\)[ \t]*)?" /* prototype */
+		/*
+		 * Attributes.  A regex can't count nested parentheses,
+		 * so just slurp up whatever we see, taking care not
+		 * to accept lines like "sub foo; # defined elsewhere".
+		 *
+		 * An attribute could contain a semicolon, but at that
+		 * point it seems reasonable enough to give up.
+		 */
+		"(:[^;#]*)?"
+		"(\\{[ \t]*)?" /* brace can come here or on the next line */
+		"(#.*)?$\n" /* comment */
+	 "^[A-Z]+[ \t]*"	/* BEGIN, END, ... */
+		"(\\{[ \t]*)?" /* brace can come here or on the next line */
+		"(#.*)?$\n"
 	 "^=head[0-9] .*",	/* POD */
 	 /* -- */
 	 "[[:alpha:]_'][[:alnum:]_']*"

-- 
1.7.5.1