1 # Created with: ./make_t.pl
25 # To locate test #13 you can search for its name or the string '#13'
37 ###########################################
38 # BEGIN SECTION 1: Parameter combinations #
39 ###########################################
44 'rt125012' => <<'----------',
49 'rt18318' => <<'----------',
52 'rt50702' => <<'----------',
57 ############################
58 # BEGIN SECTION 2: Sources #
59 ############################
62 'rt123749' => <<'----------',
63 get('http://mojolicious.org')->then(
67 return get('http://metacpan.org');
77 warn "Something went wrong: $err";
82 'rt123774' => <<'----------',
83 # retain any space between backslash and quote to avoid fooling html formatters
91 'rt124114' => <<'----------',
95 bbbb => sub { my $y = "1" },
96 c => sub { my $z = "2" },
101 'rt124354' => <<'----------',
106 has a => ( is => 'ro', isa => 'Int' );
107 has b => ( is => 'ro', isa => 'Int' );
108 has c => ( is => 'ro', isa => 'Int' );
110 __PACKAGE__->meta->make_immutable;
113 'rt125012' => <<'----------',
115 #one space before eol:
118 #one space before eol:
122 'rt125506' => <<'----------',
130 'rt126965' => <<'----------',
131 my $restrict_customer = shift ? 1 : 0;
134 'rt15735' => <<'----------',
135 my $user_prefs = $ref_type eq 'SCALAR' ? _load_from_string( $profile ) : $ref_type eq 'ARRAY' ? _load_from_array( $profile ) : $ref_type eq 'HASH' ? _load_from_hash( $profile ) : _load_from_file( $profile );
138 'rt18318' => <<'----------',
139 # Class::Std attribute list
140 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
142 my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
145 'rt27000' => <<'----------',
146 print add( 3, 4 ), "\n";
147 print add( 4, 3 ), "\n";
150 my ( $term1, $term2 ) = @_;
152 die "$term1 > $term2" if $term1 > $term2;
153 return $term1 + $term2;
157 'rt31741' => <<'----------',
161 'rt49289' => <<'----------',
162 use constant qw{ DEBUG 0 };
165 'rt50702' => <<'----------',
166 if (1) { my $uid = $ENV{ 'ORIG_LOGNAME' } || $ENV{ 'LOGNAME' } || $ENV{ 'REMOTE_USER' } || 'foobar'; } if (2) { my $uid = ($ENV{ 'ORIG_LOGNAME' } || $ENV{ 'LOGNAME' } || $ENV{ 'REMOTE_USER' } || 'foobar'); }
169 'rt68870' => <<'----------',
173 'rt70747' => <<'----------',
174 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
177 $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ]; $g;
184 ####################################
185 # BEGIN SECTION 3: Expected output #
186 ####################################
189 'rt123749.rt123749' => {
190 source => "rt123749",
191 params => "rt123749",
192 expect => <<'#1...........',
193 get('http://mojolicious.org')->then( sub {
195 say $mojo->res->code;
196 return get('http://metacpan.org');
199 say $cpan->res->code;
202 warn "Something went wrong: $err";
208 source => "rt123774",
210 expect => <<'#2...........',
211 # retain any space between backslash and quote to avoid fooling html formatters
212 my $var1 = \ "bubba";
214 my $var3 = \ 'bubba';
216 my $var5 = \ "bubba";
221 source => "rt124114",
223 expect => <<'#3...........',
227 bbbb => sub { my $y = "1" },
228 c => sub { my $z = "2" },
235 source => "rt124354",
237 expect => <<'#4...........',
242 has a => ( is => 'ro', isa => 'Int' );
243 has b => ( is => 'ro', isa => 'Int' );
244 has c => ( is => 'ro', isa => 'Int' );
246 __PACKAGE__->meta->make_immutable;
250 'rt124354.rt124354' => {
251 source => "rt124354",
252 params => "rt124354",
253 expect => <<'#5...........',
258 has a => ( is => 'ro', isa => 'Int' );
259 has b => ( is => 'ro', isa => 'Int' );
260 has c => ( is => 'ro', isa => 'Int' );
262 __PACKAGE__->meta->make_immutable;
267 source => "rt125012",
269 expect => <<'#6...........',
272 #one space before eol:
276 #one space before eol:
281 'rt125012.rt125012' => {
282 source => "rt125012",
283 params => "rt125012",
284 expect => <<'#7...........',
291 source => "rt125506",
293 expect => <<'#8...........',
302 'rt125506.rt125506' => {
303 source => "rt125506",
304 params => "rt125506",
305 expect => <<'#9...........',
315 source => "rt126965",
317 expect => <<'#10...........',
318 my $restrict_customer = shift ? 1 : 0;
325 expect => <<'#11...........',
327 $ref_type eq 'SCALAR' ? _load_from_string($profile)
328 : $ref_type eq 'ARRAY' ? _load_from_array($profile)
329 : $ref_type eq 'HASH' ? _load_from_hash($profile)
330 : _load_from_file($profile);
337 expect => <<'#12...........',
338 # Class::Std attribute list
339 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
341 my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
345 'rt18318.rt18318' => {
348 expect => <<'#13...........',
349 # Class::Std attribute list
350 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
352 my %rank_of :ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
359 expect => <<'#14...........',
360 print add( 3, 4 ), "\n";
361 print add( 4, 3 ), "\n";
364 my ( $term1, $term2 ) = @_;
366 die "$term1 > $term2" if $term1 > $term2;
367 return $term1 + $term2;
375 expect => <<'#15...........',
383 expect => <<'#16...........',
384 use constant qw{ DEBUG 0 };
391 expect => <<'#17...........',
396 || $ENV{'REMOTE_USER'}
401 ( $ENV{'ORIG_LOGNAME'}
403 || $ENV{'REMOTE_USER'}
409 'rt50702.rt50702' => {
412 expect => <<'#18...........',
415 = $ENV{'ORIG_LOGNAME'}
417 || $ENV{'REMOTE_USER'}
422 = ( $ENV{'ORIG_LOGNAME'}
424 || $ENV{'REMOTE_USER'}
433 expect => <<'#19...........',
441 expect => <<'#20...........',
442 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
446 $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ];
455 my $ntests = 0 + keys %{$rtests};
456 plan tests => $ntests;
463 foreach my $key ( sort keys %{$rtests} ) {
465 my $sname = $rtests->{$key}->{source};
466 my $expect = $rtests->{$key}->{expect};
467 my $pname = $rtests->{$key}->{params};
468 my $source = $rsources->{$sname};
469 my $params = defined($pname) ? $rparams->{$pname} : "";
471 my $errorfile_string;
472 my $err = Perl::Tidy::perltidy(
474 destination => \$output,
475 perltidyrc => \$params,
476 argv => '', # for safety; hide any ARGV from perltidy
477 stderr => \$stderr_string,
478 errorfile => \$errorfile_string, # not used when -se flag is set
480 if ( $err || $stderr_string || $errorfile_string ) {
483 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
486 if ($stderr_string) {
487 print STDERR "---------------------\n";
488 print STDERR "<<STDERR>>\n$stderr_string\n";
489 print STDERR "---------------------\n";
491 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
492 ok( !$stderr_string );
494 if ($errorfile_string) {
495 print STDERR "---------------------\n";
496 print STDERR "<<.ERR file>>\n$errorfile_string\n";
497 print STDERR "---------------------\n";
499 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
500 ok( !$errorfile_string );
504 ok( $output, $expect );