Merge branch 'jn/userdiff-perl-updates'

* jn/userdiff-perl-updates:
  userdiff/perl: tighten BEGIN/END block pattern to reject here-doc delimiters
  tests: make test_expect_code quieter on success
  userdiff/perl: catch sub with brace on second line
  userdiff/perl: match full line of POD headers
  userdiff/perl: anchor "sub" and "package" patterns on the left
  t4018 (funcname patterns): minor cleanups
  t4018 (funcname patterns): make configuration easier to track
  t4018 (funcname patterns): make .gitattributes state easier to track

3 files changed, 152 insertions, 38 deletions

diff --git a/t/t4018-diff-funcname.sh b/t/t4018-diff-funcname.sh
index 364693062..b68c56b68 100755
--- a/t/t4018-diff-funcname.sh
+++ b/t/t4018-diff-funcname.sh
@@ -9,8 +9,7 @@ test_description='Test custom diff function name patterns'
 
 LF='
 '
-
-cat > Beer.java << EOF
+cat >Beer.java <<\EOF
 public class Beer
 {
 	int special;
@@ -29,61 +28,163 @@ public class Beer
 	}
 }
 EOF
+sed 's/beer\\/beer,\\/' <Beer.java >Beer-correct.java
+cat >Beer.perl <<\EOT
+package Beer;
+
+use strict;
+use warnings;
+use parent qw(Exporter);
+our @EXPORT_OK = qw(round finalround);
+
+sub other; # forward declaration
+
+# hello
+
+sub round {
+	my ($n) = @_;
+	print "$n bottles of beer on the wall ";
+	print "$n bottles of beer\n";
+	print "Take one down, pass it around, ";
+	$n = $n - 1;
+	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");
+}
+
+sub withheredocument {
+	print <<"EOF"
+decoy here-doc
+EOF
+	# some lines of context
+	# to pad it out
+	print "hello\n";
+}
+
+__END__
+
+=head1 NAME
+
+Beer - subroutine to output fragment of a drinking song
+
+=head1 SYNOPSIS
+
+	use Beer qw(round finalround);
+
+	sub song {
+		for (my $i = 99; $i > 0; $i--) {
+			round $i;
+		}
+		finalround;
+	}
 
-sed 's/beer\\/beer,\\/' < Beer.java > Beer-correct.java
+	song;
 
-builtin_patterns="bibtex cpp csharp fortran html java objc pascal perl php python ruby tex"
-for p in $builtin_patterns
+=cut
+EOT
+sed -e '
+	s/hello/goodbye/
+	s/beer\\/beer,\\/
+	s/more\\/more,\\/
+	s/song;/song();/
+' <Beer.perl >Beer-correct.perl
+
+test_config () {
+	git config "$1" "$2" &&
+	test_when_finished "git config --unset $1"
+}
+
+test_expect_funcname () {
+	lang=${2-java}
+	test_expect_code 1 git diff --no-index -U1 \
+		"Beer.$lang" "Beer-correct.$lang" >diff &&
+	grep "^@@.*@@ $1" diff
+}
+
+for p in bibtex cpp csharp fortran html java objc pascal perl php python ruby tex
 do
 	test_expect_success "builtin $p pattern compiles" '
-		echo "*.java diff=$p" > .gitattributes &&
-		! { git diff --no-index Beer.java Beer-correct.java 2>&1 |
-			grep "fatal" > /dev/null; }
+		echo "*.java diff=$p" >.gitattributes &&
+		test_expect_code 1 git diff --no-index \
+			Beer.java Beer-correct.java 2>msg &&
+		! grep fatal msg &&
+		! grep error msg
 	'
 	test_expect_success "builtin $p wordRegex pattern compiles" '
-		! { git diff --no-index --word-diff \
-			Beer.java Beer-correct.java 2>&1 |
-			grep "fatal" > /dev/null; }
+		echo "*.java diff=$p" >.gitattributes &&
+		test_expect_code 1 git diff --no-index --word-diff \
+			Beer.java Beer-correct.java 2>msg &&
+		! grep fatal msg &&
+		! grep error msg
 	'
 done
 
 test_expect_success 'default behaviour' '
 	rm -f .gitattributes &&
-	git diff --no-index Beer.java Beer-correct.java |
-	grep "^@@.*@@ public class Beer"
+	test_expect_funcname "public class Beer\$"
+'
+
+test_expect_success 'set up .gitattributes declaring drivers to test' '
+	cat >.gitattributes <<-\EOF
+	*.java diff=java
+	*.perl diff=perl
+	EOF
 '
 
 test_expect_success 'preset java pattern' '
-	echo "*.java diff=java" >.gitattributes &&
-	git diff --no-index Beer.java Beer-correct.java |
-	grep "^@@.*@@ public static void main("
+	test_expect_funcname "public static void main("
 '
 
-git config diff.java.funcname '!static
-!String
-[^ 	].*s.*'
+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 'but is not distracted by end of <<here document' '
+	test_expect_funcname "sub withheredocument {\$" perl
+'
+
+test_expect_success 'perl pattern is not distracted by sub within POD' '
+	test_expect_funcname "=head" perl
+'
+
+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' '
-	git diff --no-index Beer.java Beer-correct.java |
-	grep "^@@.*@@ int special;$"
+	test_config diff.java.funcname "!static
+!String
+[^ 	].*s.*" &&
+	test_expect_funcname "int special;\$"
 '
 
 test_expect_success 'last regexp must not be negated' '
-	git config diff.java.funcname "!static" &&
-	git diff --no-index Beer.java Beer-correct.java 2>&1 |
-	grep "fatal: Last expression must not be negated:"
+	test_config diff.java.funcname "!static" &&
+	test_expect_code 128 git diff --no-index Beer.java Beer-correct.java 2>msg &&
+	grep ": Last expression must not be negated:" msg
 '
 
 test_expect_success 'pattern which matches to end of line' '
-	git config diff.java.funcname "Beer$" &&
-	git diff --no-index Beer.java Beer-correct.java |
-	grep "^@@.*@@ Beer"
+	test_config diff.java.funcname "Beer\$" &&
+	test_expect_funcname "Beer\$"
 '
 
 test_expect_success 'alternation in pattern' '
-	git config diff.java.xfuncname "^[ 	]*((public|static).*)$" &&
-	git diff --no-index Beer.java Beer-correct.java |
-	grep "^@@.*@@ public static void main("
+	test_config diff.java.funcname "Beer$" &&
+	test_config diff.java.xfuncname "^[ 	]*((public|static).*)$" &&
+	test_expect_funcname "public static void main("
 '
 
 test_done
diff --git a/t/test-lib.sh b/t/test-lib.sh
index b2ce2bc4b..b12b993e9 100644
--- a/t/test-lib.sh
+++ b/t/test-lib.sh
@@ -731,12 +731,11 @@ test_expect_code () {
 	exit_code=$?
 	if test $exit_code = $want_code
 	then
-		echo >&2 "test_expect_code: command exited with $exit_code: $*"
 		return 0
-	else
-		echo >&2 "test_expect_code: command exited with $exit_code, we wanted $want_code $*"
-		return 1
 	fi
+
+	echo >&2 "test_expect_code: command exited with $exit_code, we wanted $want_code $*"
+	return 1
 }
 
 # test_cmp is a helper function to compare actual and expected output.
diff --git a/userdiff.c b/userdiff.c
index 1ff47977d..e55310cd0 100644
--- a/userdiff.c
+++ b/userdiff.c
@@ -60,10 +60,24 @@ PATTERNS("pascal",
 	 "|[-+0-9.e]+|0[xXbB]?[0-9a-fA-F]+"
 	 "|<>|<=|>=|:=|\\.\\."),
 PATTERNS("perl",
-	 "^[ \t]*package .*;\n"
-	 "^[ \t]*sub .* \\{\n"
-	 "^[A-Z]+ \\{\n"	/* BEGIN, END, ... */
-	 "^=head[0-9] ",	/* POD */
+	 "^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 */
+	 "^(BEGIN|END|INIT|CHECK|UNITCHECK|AUTOLOAD|DESTROY)[ \t]*"
+		"(\\{[ \t]*)?" /* brace can come here or on the next line */
+		"(#.*)?$\n"
+	 "^=head[0-9] .*",	/* POD */
 	 /* -- */
 	 "[[:alpha:]_'][[:alnum:]_']*"
 	 "|0[xb]?[0-9a-fA-F_]*"