t4018: convert perl pattern tests to the new infrastructure
There is one subtlety: The old test case 'perl pattern gets full line of POD header' does not have its own new test case, but the feature is tested nevertheless by placing the RIGHT tag at the end of the expected hunk header in t4018/perl-skip-sub-in-pod. Signed-off-by: Johannes Sixt <j6t@kdbg.org> Signed-off-by: Junio C Hamano <gitster@pobox.com>
This commit is contained in:
		
				
					committed by
					
						
						Junio C Hamano
					
				
			
			
				
	
			
			
			
						parent
						
							bfa7d01413
						
					
				
				
					commit
					2d08413ba1
				
			@ -29,69 +29,6 @@ public class Beer
 | 
				
			|||||||
}
 | 
					}
 | 
				
			||||||
EOF
 | 
					EOF
 | 
				
			||||||
sed 's/beer\\/beer,\\/' <Beer.java >Beer-correct.java
 | 
					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;
 | 
					 | 
				
			||||||
	}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
	song;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
=cut
 | 
					 | 
				
			||||||
EOT
 | 
					 | 
				
			||||||
sed -e '
 | 
					 | 
				
			||||||
	s/hello/goodbye/
 | 
					 | 
				
			||||||
	s/beer\\/beer,\\/
 | 
					 | 
				
			||||||
	s/more\\/more,\\/
 | 
					 | 
				
			||||||
	s/song;/song();/
 | 
					 | 
				
			||||||
' <Beer.perl >Beer-correct.perl
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
test_expect_funcname () {
 | 
					test_expect_funcname () {
 | 
				
			||||||
	lang=${2-java}
 | 
						lang=${2-java}
 | 
				
			||||||
@ -139,7 +76,6 @@ done
 | 
				
			|||||||
test_expect_success 'set up .gitattributes declaring drivers to test' '
 | 
					test_expect_success 'set up .gitattributes declaring drivers to test' '
 | 
				
			||||||
	cat >.gitattributes <<-\EOF
 | 
						cat >.gitattributes <<-\EOF
 | 
				
			||||||
	*.java diff=java
 | 
						*.java diff=java
 | 
				
			||||||
	*.perl diff=perl
 | 
					 | 
				
			||||||
	EOF
 | 
						EOF
 | 
				
			||||||
'
 | 
					'
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -147,30 +83,6 @@ test_expect_success 'preset java pattern' '
 | 
				
			|||||||
	test_expect_funcname "public static void main("
 | 
						test_expect_funcname "public static void main("
 | 
				
			||||||
'
 | 
					'
 | 
				
			||||||
 | 
					
 | 
				
			||||||
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' '
 | 
					test_expect_success 'custom pattern' '
 | 
				
			||||||
	test_config diff.java.funcname "!static
 | 
						test_config diff.java.funcname "!static
 | 
				
			||||||
!String
 | 
					!String
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										8
									
								
								t/t4018/perl-skip-end-of-heredoc
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										8
									
								
								t/t4018/perl-skip-end-of-heredoc
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,8 @@
 | 
				
			|||||||
 | 
					sub RIGHTwithheredocument {
 | 
				
			||||||
 | 
						print <<"EOF"
 | 
				
			||||||
 | 
					decoy here-doc
 | 
				
			||||||
 | 
					EOF
 | 
				
			||||||
 | 
						# some lines of context
 | 
				
			||||||
 | 
						# to pad it out
 | 
				
			||||||
 | 
						print "ChangeMe\n";
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
							
								
								
									
										10
									
								
								t/t4018/perl-skip-forward-decl
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										10
									
								
								t/t4018/perl-skip-forward-decl
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,10 @@
 | 
				
			|||||||
 | 
					package RIGHT;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					use strict;
 | 
				
			||||||
 | 
					use warnings;
 | 
				
			||||||
 | 
					use parent qw(Exporter);
 | 
				
			||||||
 | 
					our @EXPORT_OK = qw(round finalround);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					sub other; # forward declaration
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					# ChangeMe
 | 
				
			||||||
							
								
								
									
										18
									
								
								t/t4018/perl-skip-sub-in-pod
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										18
									
								
								t/t4018/perl-skip-sub-in-pod
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,18 @@
 | 
				
			|||||||
 | 
					=head1 NAME
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					Beer - subroutine to output fragment of a drinking song
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					=head1 SYNOPSIS_RIGHT
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
						use Beer qw(round finalround);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
						sub song {
 | 
				
			||||||
 | 
							for (my $i = 99; $i > 0; $i--) {
 | 
				
			||||||
 | 
								round $i;
 | 
				
			||||||
 | 
							}
 | 
				
			||||||
 | 
							finalround;
 | 
				
			||||||
 | 
						}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
						ChangeMe;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					=cut
 | 
				
			||||||
							
								
								
									
										4
									
								
								t/t4018/perl-sub-definition
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4
									
								
								t/t4018/perl-sub-definition
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,4 @@
 | 
				
			|||||||
 | 
					sub RIGHT {
 | 
				
			||||||
 | 
						my ($n) = @_;
 | 
				
			||||||
 | 
						print "ChangeMe";
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
							
								
								
									
										4
									
								
								t/t4018/perl-sub-definition-kr-brace
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										4
									
								
								t/t4018/perl-sub-definition-kr-brace
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,4 @@
 | 
				
			|||||||
 | 
					sub RIGHT
 | 
				
			||||||
 | 
					{
 | 
				
			||||||
 | 
						print "ChangeMe\n";
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
		Reference in New Issue
	
	Block a user