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...........',
293 source => "rt125506",
295 expect => <<'#8...........',
304 'rt125506.rt125506' => {
305 source => "rt125506",
306 params => "rt125506",
307 expect => <<'#9...........',
317 source => "rt126965",
319 expect => <<'#10...........',
320 my $restrict_customer = shift ? 1 : 0;
327 expect => <<'#11...........',
329 $ref_type eq 'SCALAR' ? _load_from_string($profile)
330 : $ref_type eq 'ARRAY' ? _load_from_array($profile)
331 : $ref_type eq 'HASH' ? _load_from_hash($profile)
332 : _load_from_file($profile);
339 expect => <<'#12...........',
340 # Class::Std attribute list
341 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
343 my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
347 'rt18318.rt18318' => {
350 expect => <<'#13...........',
351 # Class::Std attribute list
352 # The token type of the first colon is 'A' so use -nwrs='A' to avoid space
354 my %rank_of :ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
361 expect => <<'#14...........',
362 print add( 3, 4 ), "\n";
363 print add( 4, 3 ), "\n";
366 my ( $term1, $term2 ) = @_;
368 die "$term1 > $term2" if $term1 > $term2;
369 return $term1 + $term2;
377 expect => <<'#15...........',
385 expect => <<'#16...........',
386 use constant qw{ DEBUG 0 };
393 expect => <<'#17...........',
398 || $ENV{'REMOTE_USER'}
403 ( $ENV{'ORIG_LOGNAME'}
405 || $ENV{'REMOTE_USER'}
411 'rt50702.rt50702' => {
414 expect => <<'#18...........',
417 = $ENV{'ORIG_LOGNAME'}
419 || $ENV{'REMOTE_USER'}
424 = ( $ENV{'ORIG_LOGNAME'}
426 || $ENV{'REMOTE_USER'}
435 expect => <<'#19...........',
443 expect => <<'#20...........',
444 coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
448 $g->{stats} = [ map { scalar $_->as_array } @{ $g->{stats} } ];
457 my $ntests = 0 + keys %{$rtests};
458 plan tests => $ntests;
465 foreach my $key ( sort keys %{$rtests} ) {
467 my $sname = $rtests->{$key}->{source};
468 my $expect = $rtests->{$key}->{expect};
469 my $pname = $rtests->{$key}->{params};
470 my $source = $rsources->{$sname};
471 my $params = defined($pname) ? $rparams->{$pname} : "";
473 my $errorfile_string;
474 my $err = Perl::Tidy::perltidy(
476 destination => \$output,
477 perltidyrc => \$params,
478 argv => '', # for safety; hide any ARGV from perltidy
479 stderr => \$stderr_string,
480 errorfile => \$errorfile_string, # not used when -se flag is set
482 if ( $err || $stderr_string || $errorfile_string ) {
485 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
488 if ($stderr_string) {
489 print STDERR "---------------------\n";
490 print STDERR "<<STDERR>>\n$stderr_string\n";
491 print STDERR "---------------------\n";
493 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
494 ok( !$stderr_string );
496 if ($errorfile_string) {
497 print STDERR "---------------------\n";
498 print STDERR "<<.ERR file>>\n$errorfile_string\n";
499 print STDERR "---------------------\n";
501 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
502 ok( !$errorfile_string );
506 ok( $output, $expect );