--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 here_long.here_long
+#2 bbhb.bbhb2
+#3 bbhb.bbhb3
+#4 bbhb.def
+#5 bbhb.bbhb4
+#6 bbhb.bbhb5
+#7 braces.braces7
+#8 xci.def
+#9 xci.xci1
+#10 xci.xci2
+#11 mangle4.def
+#12 mangle4.mangle
+#13 extrude5.def
+#14 extrude5.extrude
+#15 kba1.def
+#16 kba1.kba1
+#17 git45.def
+#18 git45.git45
+#19 boa.boa
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test::More;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'bbhb2' => "-bbhb=2 -bbp=2",
+ 'bbhb3' => "-bbhb=3 -bbp=3",
+ 'bbhb4' => "-bbhb=3 -bbp=3 -bbhbi=2 -bbpi=2",
+ 'bbhb5' => "-bbhb=3 -bbp=3 -bbhbi=1 -bbpi=1",
+ 'boa' => <<'----------',
+# -boa is default so we test nboa
+-nboa
+----------
+ 'braces7' => <<'----------',
+-bli -blil='*'
+----------
+ 'def' => "",
+ 'extrude' => "--extrude",
+ 'git45' => "-vtc=1 -wn",
+ 'here_long' => "-l=33",
+ 'kba1' => <<'----------',
+-kbb='=> ,' -kba='=>'
+----------
+ 'mangle' => "--mangle",
+ 'xci1' => "-xci",
+ 'xci2' => "-pbp -nst -nse -xci",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'bbhb' => <<'----------',
+my %temp =
+(
+supsup => 123,
+nested => {
+asdf => 456,
+yarg => 'yarp',
+}, );
+----------
+
+ 'boa' => <<'----------',
+my @field
+ : field
+ : Default(1)
+ : Get('Name' => 'foo')
+ : Set('Name');
+----------
+
+ 'braces' => <<'----------',
+sub message {
+ if ( !defined( $_[0] ) ) {
+ print("Hello, World\n");
+ }
+ else {
+ print( $_[0], "\n" );
+ }
+}
+
+$myfun = sub {
+ print("Hello, World\n");
+};
+
+eval {
+ my $app = App::perlbrew->new( "install-patchperl", "-q" );
+ $app->run();
+} or do {
+ $error = $@;
+ $produced_error = 1;
+};
+
+Mojo::IOLoop->next_tick(
+ sub {
+ $ua->get(
+ '/' => sub {
+ push @kept_alive, pop->kept_alive;
+ Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
+ }
+ );
+ }
+);
+
+$r = do {
+ sswitch( $words[ rand @words ] ) {
+ case $words[0]:
+ case $words[1]:
+ case $words[2]:
+ case $words[3]: { 'ok' }
+ default: { 'wtf' }
+ }
+};
+
+try {
+ die;
+}
+catch {
+ die;
+};
+----------
+
+ 'extrude5' => <<'----------',
+use perl6-alpha;
+$var{-y} = 1;
+----------
+
+ 'git45' => <<'----------',
+# git#45 -vtc=n and -wn were not working together
+if (
+ $self->_add_fqdn_host(
+ name => $name,
+ realm => $realm
+ )
+ )
+{
+ ...;
+}
+
+# do not stack )->pack(
+my $hlist = $control::control->Scrolled(
+ 'HList',
+ drawbranch => 1,
+ width => 20,
+ -scrollbars => 'w'
+)->pack(
+ -side => 'bottom',
+ -expand => 1
+);
+
+----------
+
+ 'here_long' => <<'----------',
+# must not break after here target regardless of maximum-line-length
+$sth= $dbh->prepare (<<"END_OF_SELECT") or die "Couldn't prepare SQL" ;
+ SELECT COUNT(duration),SUM(duration)
+ FROM logins WHERE username='$user'
+END_OF_SELECT
+
+----------
+
+ 'kba1' => <<'----------',
+$this_env = join("", $before, $closures
+ , $contents
+ , ($defenv ? '': &balance_tags())
+ , $reopens ); $_ = $after;
+
+method 'foo1'
+ => [ Int, Int ]
+ => sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+ };
+
+method 'foo2'=>
+ [ Int, Int ]=>
+ sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+ };
+
+----------
+
+ 'mangle4' => <<'----------',
+# a useful parsing test from 'signatures.t'
+use feature "signatures";
+no warnings "experimental::signatures";
+sub t086
+ ( #foo)))
+ $ #foo)))
+ a #foo)))
+ , #foo)))
+ , #foo)))
+ $ #foo)))
+ b #foo)))
+ = #foo)))
+ 333 #foo)))
+ , #foo)))
+ , #foo)))
+ ) #foo)))
+ { $a.$b }
+----------
+
+ 'xci' => <<'----------',
+$self->{_text} = (
+ !$section ? ''
+ : $type eq 'item' ? "the $section entry"
+ : "the section on $section"
+ )
+ . (
+ $page
+ ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
+ : ' elsewhere in this document'
+ );
+
+my $otherHashRef =
+ $condition
+ ? {
+ 'a' => 'a value',
+ 'b' => 'b value',
+ 'c' => {
+ 'd' => 'd value',
+ 'e' => 'e value'
+ }
+ }
+ : undef;
+
+my @globlist = ( grep { defined } @opt{qw( l q S t )} )
+ ? do {
+ local *DIR;
+ opendir DIR, './' or die "can't opendir './': $!";
+ my @a = grep { not /^\.+$/ } readdir DIR;
+ closedir DIR;
+ @a;
+ }
+ : ();
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'here_long.here_long' => {
+ source => "here_long",
+ params => "here_long",
+ expect => <<'#1...........',
+# must not break after here target regardless of maximum-line-length
+$sth = $dbh->prepare(
+ <<"END_OF_SELECT") or die "Couldn't prepare SQL";
+ SELECT COUNT(duration),SUM(duration)
+ FROM logins WHERE username='$user'
+END_OF_SELECT
+
+#1...........
+ },
+
+ 'bbhb.bbhb2' => {
+ source => "bbhb",
+ params => "bbhb2",
+ expect => <<'#2...........',
+my %temp =
+ (
+ supsup => 123,
+ nested =>
+ {
+ asdf => 456,
+ yarg => 'yarp',
+ },
+ );
+#2...........
+ },
+
+ 'bbhb.bbhb3' => {
+ source => "bbhb",
+ params => "bbhb3",
+ expect => <<'#3...........',
+my %temp =
+ (
+ supsup => 123,
+ nested =>
+ {
+ asdf => 456,
+ yarg => 'yarp',
+ },
+ );
+#3...........
+ },
+
+ 'bbhb.def' => {
+ source => "bbhb",
+ params => "def",
+ expect => <<'#4...........',
+my %temp = (
+ supsup => 123,
+ nested => {
+ asdf => 456,
+ yarg => 'yarp',
+ },
+);
+#4...........
+ },
+
+ 'bbhb.bbhb4' => {
+ source => "bbhb",
+ params => "bbhb4",
+ expect => <<'#5...........',
+my %temp =
+ (
+ supsup => 123,
+ nested =>
+ {
+ asdf => 456,
+ yarg => 'yarp',
+ },
+ );
+#5...........
+ },
+
+ 'bbhb.bbhb5' => {
+ source => "bbhb",
+ params => "bbhb5",
+ expect => <<'#6...........',
+my %temp =
+(
+ supsup => 123,
+ nested =>
+ {
+ asdf => 456,
+ yarg => 'yarp',
+ },
+);
+#6...........
+ },
+
+ 'braces.braces7' => {
+ source => "braces",
+ params => "braces7",
+ expect => <<'#7...........',
+sub message
+ {
+ if ( !defined( $_[0] ) )
+ {
+ print("Hello, World\n");
+ }
+ else
+ {
+ print( $_[0], "\n" );
+ }
+ }
+
+$myfun = sub
+ {
+ print("Hello, World\n");
+ };
+
+eval
+ {
+ my $app = App::perlbrew->new( "install-patchperl", "-q" );
+ $app->run();
+ } or do
+ {
+ $error = $@;
+ $produced_error = 1;
+ };
+
+Mojo::IOLoop->next_tick(
+ sub
+ {
+ $ua->get(
+ '/' => sub
+ {
+ push @kept_alive, pop->kept_alive;
+ Mojo::IOLoop->next_tick( sub { Mojo::IOLoop->stop } );
+ }
+ );
+ }
+);
+
+$r = do
+ {
+ sswitch( $words[ rand @words ] )
+ {
+ case $words[0]:
+ case $words[1]:
+ case $words[2]:
+ case $words[3]: { 'ok' }
+ default: { 'wtf' }
+ }
+ };
+
+try
+ {
+ die;
+ }
+catch
+ {
+ die;
+ };
+#7...........
+ },
+
+ 'xci.def' => {
+ source => "xci",
+ params => "def",
+ expect => <<'#8...........',
+$self->{_text} = (
+ !$section ? ''
+ : $type eq 'item' ? "the $section entry"
+ : "the section on $section"
+ )
+ . (
+ $page
+ ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
+ : ' elsewhere in this document'
+ );
+
+my $otherHashRef =
+ $condition
+ ? {
+ 'a' => 'a value',
+ 'b' => 'b value',
+ 'c' => {
+ 'd' => 'd value',
+ 'e' => 'e value'
+ }
+ }
+ : undef;
+
+my @globlist = ( grep { defined } @opt{qw( l q S t )} )
+ ? do {
+ local *DIR;
+ opendir DIR, './' or die "can't opendir './': $!";
+ my @a = grep { not /^\.+$/ } readdir DIR;
+ closedir DIR;
+ @a;
+ }
+ : ();
+#8...........
+ },
+
+ 'xci.xci1' => {
+ source => "xci",
+ params => "xci1",
+ expect => <<'#9...........',
+$self->{_text} = (
+ !$section ? ''
+ : $type eq 'item' ? "the $section entry"
+ : "the section on $section"
+ )
+ . (
+ $page
+ ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
+ : ' elsewhere in this document'
+ );
+
+my $otherHashRef =
+ $condition
+ ? {
+ 'a' => 'a value',
+ 'b' => 'b value',
+ 'c' => {
+ 'd' => 'd value',
+ 'e' => 'e value'
+ }
+ }
+ : undef;
+
+my @globlist = ( grep { defined } @opt{qw( l q S t )} )
+ ? do {
+ local *DIR;
+ opendir DIR, './' or die "can't opendir './': $!";
+ my @a = grep { not /^\.+$/ } readdir DIR;
+ closedir DIR;
+ @a;
+ }
+ : ();
+#9...........
+ },
+
+ 'xci.xci2' => {
+ source => "xci",
+ params => "xci2",
+ expect => <<'#10...........',
+$self->{_text} = (
+ !$section ? ''
+ : $type eq 'item' ? "the $section entry"
+ : "the section on $section"
+ )
+ . ( $page
+ ? ( $section ? ' in ' : '' ) . "the $page$page_ext manpage"
+ : ' elsewhere in this document'
+ );
+
+my $otherHashRef
+ = $condition
+ ? { 'a' => 'a value',
+ 'b' => 'b value',
+ 'c' => {
+ 'd' => 'd value',
+ 'e' => 'e value'
+ }
+ }
+ : undef;
+
+my @globlist = ( grep {defined} @opt{qw( l q S t )} )
+ ? do {
+ local *DIR;
+ opendir DIR, './' or die "can't opendir './': $!";
+ my @a = grep { not /^\.+$/ } readdir DIR;
+ closedir DIR;
+ @a;
+ }
+ : ();
+#10...........
+ },
+
+ 'mangle4.def' => {
+ source => "mangle4",
+ params => "def",
+ expect => <<'#11...........',
+# a useful parsing test from 'signatures.t'
+use feature "signatures";
+no warnings "experimental::signatures";
+
+sub t086 ( #foo)))
+ $ #foo)))
+ a #foo)))
+ , #foo)))
+ , #foo)))
+ $ #foo)))
+ b #foo)))
+ = #foo)))
+ 333 #foo)))
+ , #foo)))
+ , #foo)))
+ ) #foo)))
+{ $a . $b }
+#11...........
+ },
+
+ 'mangle4.mangle' => {
+ source => "mangle4",
+ params => "mangle",
+ expect => <<'#12...........',
+# a useful parsing test from 'signatures.t'
+use feature "signatures";
+no warnings "experimental::signatures";
+sub t086(#foo)))
+$ #foo)))
+ a#foo)))
+,#foo)))
+,#foo)))
+$ #foo)))
+ b#foo)))
+ =#foo)))
+ 333#foo)))
+,#foo)))
+,#foo)))
+ )#foo)))
+{$a.$b}
+#12...........
+ },
+
+ 'extrude5.def' => {
+ source => "extrude5",
+ params => "def",
+ expect => <<'#13...........',
+use perl6-alpha;
+$var{-y} = 1;
+#13...........
+ },
+
+ 'extrude5.extrude' => {
+ source => "extrude5",
+ params => "extrude",
+ expect => <<'#14...........',
+use
+perl6-alpha
+;
+$var{-y}
+=
+1
+;
+#14...........
+ },
+
+ 'kba1.def' => {
+ source => "kba1",
+ params => "def",
+ expect => <<'#15...........',
+$this_env = join( "",
+ $before, $closures, $contents, ( $defenv ? '' : &balance_tags() ),
+ $reopens );
+$_ = $after;
+
+method 'foo1' => [ Int, Int ] => sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+};
+
+method 'foo2' => [ Int, Int ] => sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+};
+
+#15...........
+ },
+
+ 'kba1.kba1' => {
+ source => "kba1",
+ params => "kba1",
+ expect => <<'#16...........',
+$this_env = join(
+ "", $before, $closures
+ , $contents
+ , ( $defenv ? '' : &balance_tags() )
+ , $reopens
+);
+$_ = $after;
+
+method 'foo1'
+ => [ Int, Int ]
+ => sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+ };
+
+method 'foo2' =>
+ [ Int, Int ] =>
+ sub {
+ my ( $self, $x, $y ) = ( shift, @_ );
+ ...;
+ };
+
+#16...........
+ },
+
+ 'git45.def' => {
+ source => "git45",
+ params => "def",
+ expect => <<'#17...........',
+# git#45 -vtc=n and -wn were not working together
+if (
+ $self->_add_fqdn_host(
+ name => $name,
+ realm => $realm
+ )
+ )
+{
+ ...;
+}
+
+# do not stack )->pack(
+my $hlist = $control::control->Scrolled(
+ 'HList',
+ drawbranch => 1,
+ width => 20,
+ -scrollbars => 'w'
+)->pack(
+ -side => 'bottom',
+ -expand => 1
+);
+
+#17...........
+ },
+
+ 'git45.git45' => {
+ source => "git45",
+ params => "git45",
+ expect => <<'#18...........',
+# git#45 -vtc=n and -wn were not working together
+if ( $self->_add_fqdn_host(
+ name => $name,
+ realm => $realm ) )
+{
+ ...;
+}
+
+# do not stack )->pack(
+my $hlist = $control::control->Scrolled(
+ 'HList',
+ drawbranch => 1,
+ width => 20,
+ -scrollbars => 'w'
+)->pack(
+ -side => 'bottom',
+ -expand => 1 );
+
+#18...........
+ },
+
+ 'boa.boa' => {
+ source => "boa",
+ params => "boa",
+ expect => <<'#19...........',
+my @field : field : Default(1) : Get('Name' => 'foo') : Set('Name');
+#19...........
+ },
+ };
+
+ my $ntests = 0 + keys %{$rtests};
+ plan tests => $ntests;
+}
+
+###############
+# EXECUTE TESTS
+###############
+
+foreach my $key ( sort keys %{$rtests} ) {
+ my $output;
+ my $sname = $rtests->{$key}->{source};
+ my $expect = $rtests->{$key}->{expect};
+ my $pname = $rtests->{$key}->{params};
+ my $source = $rsources->{$sname};
+ my $params = defined($pname) ? $rparams->{$pname} : "";
+ my $stderr_string;
+ my $errorfile_string;
+ my $err = Perl::Tidy::perltidy(
+ source => \$source,
+ destination => \$output,
+ perltidyrc => \$params,
+ argv => '', # for safety; hide any ARGV from perltidy
+ stderr => \$stderr_string,
+ errorfile => \$errorfile_string, # not used when -se flag is set
+ );
+ if ( $err || $stderr_string || $errorfile_string ) {
+ print STDERR "Error output received for test '$key'\n";
+ if ($err) {
+ print STDERR "An error flag '$err' was returned\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ if ( !is( $output, $expect, $key ) ) {
+ my $leno = length($output);
+ my $lene = length($expect);
+ if ( $leno == $lene ) {
+ print STDERR
+"#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
+ }
+ else {
+ print STDERR
+"#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";
+ }
+ }
+ }
+}
projects / perltidy.git / blobdiff