--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 rt70747.rt70747
+#2 rt74856.def
+#3 rt78156.def
+#4 rt78764.def
+#5 rt79813.def
+#6 rt79947.def
+#7 rt80645.def
+#8 rt81852.def
+#9 rt81852.rt81852
+#10 rt81854.def
+#11 rt87502.def
+#12 rt93197.def
+#13 rt94338.def
+#14 rt95419.def
+#15 rt95708.def
+#16 rt96021.def
+#17 rt96101.def
+#18 rt98902.def
+#19 rt98902.rt98902
+#20 rt99961.def
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'def' => "",
+ 'rt70747' => "-i=2",
+ 'rt81852' => <<'----------',
+-wn
+-act=2
+----------
+ 'rt98902' => "-boc",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'rt70747' => <<'----------',
+coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
+ [ map {
+ my $g = $_->as_hash;
+ $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; $g;
+ } @$_;
+ ]
+};
+----------
+
+ 'rt74856' => <<'----------',
+{
+my $foo = '1';
+#<<<
+my $bar = (test())
+ ? 'some value'
+ : undef;
+#>>>
+my $baz = 'something else';
+}
+----------
+
+ 'rt78156' => <<'----------',
+package Some::Class 2.012;
+----------
+
+ 'rt78764' => <<'----------',
+qr/3/ ~~ ['1234'] ? 1 : 0;
+map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a;
+----------
+
+ 'rt79813' => <<'----------',
+my %hash = ( a => { bbbbbbbbb => {
+ cccccccccc => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx',
+ }, },);
+----------
+
+ 'rt79947' => <<'----------',
+try { croak "An Error!"; }
+catch ($error) {
+ print STDERR $error . "\n";
+}
+----------
+
+ 'rt80645' => <<'----------',
+BEGIN { $^W = 1; }
+use warnings;
+use strict;
+@$ = 'test';
+print $#{$};
+----------
+
+ 'rt81852' => <<'----------',
+do {
+ {
+ next if ( $n % 2 );
+ print $n, "\n";
+ }
+} while ( $n++ < 10 );
+----------
+
+ 'rt81854' => <<'----------',
+return "this is a descriptive error message"
+ if $res->is_error or not length $data;
+----------
+
+ 'rt87502' => <<'----------',
+if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) {
+ # CODE
+}
+----------
+
+ 'rt93197' => <<'----------',
+$to = $to->{$_} ||= {} for @key; if (1) {2;} else {3;}
+----------
+
+ 'rt94338' => <<'----------',
+# for-loop in a parenthesized block-map triggered an error message
+map( { foreach my $item ( '0', '1' ) { print $item} } qw(a b c) );
+----------
+
+ 'rt95419' => <<'----------',
+case "blah" => sub {
+ { a => 1 }
+};
+----------
+
+ 'rt95708' => <<'----------',
+use strict;
+use JSON;
+my $ref = {
+when => time(), message => 'abc' };
+my $json = encode_json {
+when => time(), message => 'abc' };
+my $json2 = encode_json + {
+when => time(), message => 'abc' };
+----------
+
+ 'rt96021' => <<'----------',
+$a->@*;
+$a->**;
+$a->$*;
+$a->&*;
+$a->%*;
+$a->$#*
+----------
+
+ 'rt96101' => <<'----------',
+# Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine
+# references inside subroutine execution.
+
+# closing brace of second sub should get outdented here
+sub startup {
+ my $self = shift;
+ $self->plugin(
+ 'authentication' => {
+ 'autoload_user' => 1,
+ 'session_key' => rand(),
+ 'load_user' => sub {
+ return HaloVP::Users->load(@_);
+ },
+ 'validate_user' => sub {
+ return HaloVP::Users->login(@_);
+ }
+ }
+ );
+}
+
+----------
+
+ 'rt98902' => <<'----------',
+my %foo = (
+ alpha => 1,
+beta => 2, gamma => 3,
+);
+
+my @bar = map { {
+number => $_,
+character => chr $_,
+padding => ( ' ' x $_ ),
+} } ( 0 .. 32 );
+----------
+
+ 'rt99961' => <<'----------',
+%thing = %{ print qq[blah1\n]; $b; };
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'rt70747.rt70747' => {
+ source => "rt70747",
+ params => "rt70747",
+ expect => <<'#1...........',
+coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
+ [
+ map {
+ my $g = $_->as_hash;
+ $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ];
+ $g;
+ } @$_;
+ ]
+};
+#1...........
+ },
+
+ 'rt74856.def' => {
+ source => "rt74856",
+ params => "def",
+ expect => <<'#2...........',
+{
+ my $foo = '1';
+#<<<
+my $bar = (test())
+ ? 'some value'
+ : undef;
+#>>>
+ my $baz = 'something else';
+}
+#2...........
+ },
+
+ 'rt78156.def' => {
+ source => "rt78156",
+ params => "def",
+ expect => <<'#3...........',
+package Some::Class 2.012;
+#3...........
+ },
+
+ 'rt78764.def' => {
+ source => "rt78764",
+ params => "def",
+ expect => <<'#4...........',
+qr/3/ ~~ ['1234'] ? 1 : 0;
+map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a;
+#4...........
+ },
+
+ 'rt79813.def' => {
+ source => "rt79813",
+ params => "def",
+ expect => <<'#5...........',
+my %hash = (
+ a => {
+ bbbbbbbbb => {
+ cccccccccc => 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx',
+ },
+ },
+);
+#5...........
+ },
+
+ 'rt79947.def' => {
+ source => "rt79947",
+ params => "def",
+ expect => <<'#6...........',
+try { croak "An Error!"; }
+catch ($error) {
+ print STDERR $error . "\n";
+}
+#6...........
+ },
+
+ 'rt80645.def' => {
+ source => "rt80645",
+ params => "def",
+ expect => <<'#7...........',
+BEGIN { $^W = 1; }
+use warnings;
+use strict;
+@$ = 'test';
+print $#{$};
+#7...........
+ },
+
+ 'rt81852.def' => {
+ source => "rt81852",
+ params => "def",
+ expect => <<'#8...........',
+do {
+ {
+ next if ( $n % 2 );
+ print $n, "\n";
+ }
+} while ( $n++ < 10 );
+#8...........
+ },
+
+ 'rt81852.rt81852' => {
+ source => "rt81852",
+ params => "rt81852",
+ expect => <<'#9...........',
+do {{
+ next if ($n % 2);
+ print $n, "\n";
+}} while ($n++ < 10);
+#9...........
+ },
+
+ 'rt81854.def' => {
+ source => "rt81854",
+ params => "def",
+ expect => <<'#10...........',
+return "this is a descriptive error message"
+ if $res->is_error or not length $data;
+#10...........
+ },
+
+ 'rt87502.def' => {
+ source => "rt87502",
+ params => "def",
+ expect => <<'#11...........',
+if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) {
+
+ # CODE
+}
+#11...........
+ },
+
+ 'rt93197.def' => {
+ source => "rt93197",
+ params => "def",
+ expect => <<'#12...........',
+$to = $to->{$_} ||= {} for @key;
+if (1) { 2; }
+else { 3; }
+#12...........
+ },
+
+ 'rt94338.def' => {
+ source => "rt94338",
+ params => "def",
+ expect => <<'#13...........',
+# for-loop in a parenthesized block-map triggered an error message
+map( {
+ foreach my $item ( '0', '1' ) {
+ print $item;
+ }
+} qw(a b c) );
+#13...........
+ },
+
+ 'rt95419.def' => {
+ source => "rt95419",
+ params => "def",
+ expect => <<'#14...........',
+case "blah" => sub {
+ { a => 1 }
+};
+#14...........
+ },
+
+ 'rt95708.def' => {
+ source => "rt95708",
+ params => "def",
+ expect => <<'#15...........',
+use strict;
+use JSON;
+my $ref = {
+ when => time(),
+ message => 'abc'
+};
+my $json = encode_json {
+ when => time(),
+ message => 'abc'
+};
+my $json2 = encode_json + {
+ when => time(),
+ message => 'abc'
+};
+#15...........
+ },
+
+ 'rt96021.def' => {
+ source => "rt96021",
+ params => "def",
+ expect => <<'#16...........',
+$a->@*;
+$a->**;
+$a->$*;
+$a->&*;
+$a->%*;
+$a->$#*
+#16...........
+ },
+
+ 'rt96101.def' => {
+ source => "rt96101",
+ params => "def",
+ expect => <<'#17...........',
+# Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine
+# references inside subroutine execution.
+
+# closing brace of second sub should get outdented here
+sub startup {
+ my $self = shift;
+ $self->plugin(
+ 'authentication' => {
+ 'autoload_user' => 1,
+ 'session_key' => rand(),
+ 'load_user' => sub {
+ return HaloVP::Users->load(@_);
+ },
+ 'validate_user' => sub {
+ return HaloVP::Users->login(@_);
+ }
+ }
+ );
+}
+
+#17...........
+ },
+
+ 'rt98902.def' => {
+ source => "rt98902",
+ params => "def",
+ expect => <<'#18...........',
+my %foo = (
+ alpha => 1,
+ beta => 2,
+ gamma => 3,
+);
+
+my @bar =
+ map { { number => $_, character => chr $_, padding => ( ' ' x $_ ), } }
+ ( 0 .. 32 );
+#18...........
+ },
+
+ 'rt98902.rt98902' => {
+ source => "rt98902",
+ params => "rt98902",
+ expect => <<'#19...........',
+my %foo = (
+ alpha => 1,
+ beta => 2, gamma => 3,
+);
+
+my @bar = map {
+ {
+ number => $_,
+ character => chr $_,
+ padding => ( ' ' x $_ ),
+ }
+} ( 0 .. 32 );
+#19...........
+ },
+
+ 'rt99961.def' => {
+ source => "rt99961",
+ params => "def",
+ expect => <<'#20...........',
+%thing = %{
+ print qq[blah1\n];
+ $b;
+};
+#20...........
+ },
+ };
+
+ 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 ) {
+ if ($err) {
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ ok( $output, $expect );
+ }
+}
projects / perltidy.git / blobdiff