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 ###########################################
42 'rt107832' => <<'----------',
46 'rt111519' => <<'----------',
50 'rt113689' => <<'----------',
60 ############################
61 # BEGIN SECTION 2: Sources #
62 ############################
65 'rt102451' => <<'----------',
66 # RT#102451 bug test; unwanted spaces added before =head1 on each pass
73 my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array
83 'rt104427' => <<'----------',
85 use v5.020; #includes strict
87 use experimental 'signatures';
90 sub setidentifier ( $href = {} ) { say 'hi'; }
93 'rt106492' => <<'----------',
94 my $ct = Courriel::Header::ContentType->new( mime_type => 'multipart/alternative', attributes => { boundary => unique_boundary }, );
97 'rt107832' => <<'----------',
107 'rt111519' => <<'----------',
110 my $x = 1; # comment not removed
111 # comment will be removed
112 my $y = 2; # comment also not removed
115 'rt112534' => <<'----------',
116 get( on_ready => sub ($worker) { $on_ready->end; return; }, on_exit => sub ( $worker, $status ) { return; }, on_data => sub ($data) { $self->_on_data(@_) if $self; return; } );
119 'rt113689' => <<'----------',
121 if ( !defined( $_[0] ) ) {
122 print("Hello, World\n");
124 else { print( $_[0], "\n" ); }
128 'rt113792' => <<'----------',
129 print "hello world\n";
134 'rt114359' => <<'----------',
135 my $x = 2; print $x ** 0.5;
138 'rt114909' => <<'----------',
143 use experimental 'signatures';
145 sub reader ( $line_sep, $chomp ) {
146 return sub ( $fh, $out ) : prototype(*$) {
147 local $/ = $line_sep;
149 return undef unless defined $content;
150 chomp $content if $chomp;
157 *get_line = reader( "\n", 1 );
160 while ( get_line( STDIN, \my $buf ) ) {
165 'rt116344' => <<'----------',
167 # Attempting to tidy the following code failed:
169 return ref {} ? 1 : 0;
174 'rt119140' => <<'----------',
178 'rt119588' => <<'----------',
181 my $longname = shift // "xyz";
185 'rt119970' => <<'----------',
194 'rt123492' => <<'----------',
202 'rt123749' => <<'----------',
203 get('http://mojolicious.org')->then(
206 say $mojo->res->code;
207 return get('http://metacpan.org');
212 say $cpan->res->code;
217 warn "Something went wrong: $err";
223 ####################################
224 # BEGIN SECTION 3: Expected output #
225 ####################################
229 source => "rt102451",
231 expect => <<'#1...........',
232 # RT#102451 bug test; unwanted spaces added before =head1 on each pass
239 my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array
251 source => "rt104427",
253 expect => <<'#2...........',
255 use v5.020; #includes strict
257 use experimental 'signatures';
260 sub setidentifier ( $href = {} ) { say 'hi'; }
265 source => "rt106492",
267 expect => <<'#3...........',
268 my $ct = Courriel::Header::ContentType->new(
269 mime_type => 'multipart/alternative',
270 attributes => { boundary => unique_boundary },
276 source => "rt107832",
278 expect => <<'#4...........',
289 'rt107832.rt107832' => {
290 source => "rt107832",
291 params => "rt107832",
292 expect => <<'#5...........',
304 source => "rt111519",
306 expect => <<'#6...........',
309 my $x = 1; # comment not removed
311 # comment will be removed
312 my $y = 2; # comment also not removed
316 'rt111519.rt111519' => {
317 source => "rt111519",
318 params => "rt111519",
319 expect => <<'#7...........',
328 source => "rt112534",
330 expect => <<'#8...........',
332 on_ready => sub ($worker) { $on_ready->end; return; },
333 on_exit => sub ( $worker, $status ) { return; },
334 on_data => sub ($data) { $self->_on_data(@_) if $self; return; }
340 source => "rt113689",
342 expect => <<'#9...........',
344 if ( !defined( $_[0] ) ) {
345 print("Hello, World\n");
347 else { print( $_[0], "\n" ); }
352 'rt113689.rt113689' => {
353 source => "rt113689",
354 params => "rt113689",
355 expect => <<'#10...........',
359 if ( !defined( $_[0] ) ) {
362 print("Hello, World\n");
365 else { print( $_[0], "\n" ); }
372 source => "rt113792",
374 expect => <<'#11...........',
375 print "hello world\n";
382 source => "rt114359",
384 expect => <<'#12...........',
391 source => "rt114909",
393 expect => <<'#13...........',
398 use experimental 'signatures';
400 sub reader ( $line_sep, $chomp ) {
401 return sub ( $fh, $out ) : prototype(*$) {
402 local $/ = $line_sep;
404 return undef unless defined $content;
405 chomp $content if $chomp;
412 *get_line = reader( "\n", 1 );
415 while ( get_line( STDIN, \my $buf ) ) {
422 source => "rt116344",
424 expect => <<'#14...........',
426 # Attempting to tidy the following code failed:
428 return ref {} ? 1 : 0;
435 source => "rt119140",
437 expect => <<'#15...........',
443 source => "rt119588",
445 expect => <<'#16...........',
448 my $longname = shift // "xyz";
454 source => "rt119970",
456 expect => <<'#17...........',
466 'rt119970.rt119970' => {
467 source => "rt119970",
468 params => "rt119970",
469 expect => <<'#18...........',
478 source => "rt123492",
480 expect => <<'#19...........',
490 source => "rt123749",
492 expect => <<'#20...........',
493 get('http://mojolicious.org')->then(
496 say $mojo->res->code;
497 return get('http://metacpan.org');
502 say $cpan->res->code;
507 warn "Something went wrong: $err";
514 my $ntests = 0 + keys %{$rtests};
515 plan tests => $ntests;
522 foreach my $key ( sort keys %{$rtests} ) {
524 my $sname = $rtests->{$key}->{source};
525 my $expect = $rtests->{$key}->{expect};
526 my $pname = $rtests->{$key}->{params};
527 my $source = $rsources->{$sname};
528 my $params = defined($pname) ? $rparams->{$pname} : "";
530 my $errorfile_string;
531 my $err = Perl::Tidy::perltidy(
533 destination => \$output,
534 perltidyrc => \$params,
535 argv => '', # for safety; hide any ARGV from perltidy
536 stderr => \$stderr_string,
537 errorfile => \$errorfile_string, # not used when -se flag is set
539 if ( $err || $stderr_string || $errorfile_string ) {
540 print STDERR "Error output received for test '$key'\n";
542 print STDERR "An error flag '$err' was returned\n";
545 if ($stderr_string) {
546 print STDERR "---------------------\n";
547 print STDERR "<<STDERR>>\n$stderr_string\n";
548 print STDERR "---------------------\n";
549 ok( !$stderr_string );
551 if ($errorfile_string) {
552 print STDERR "---------------------\n";
553 print STDERR "<<.ERR file>>\n$errorfile_string\n";
554 print STDERR "---------------------\n";
555 ok( !$errorfile_string );
559 if ( !is( $output, $expect, $key ) ) {
560 my $leno = length($output);
561 my $lene = length($expect);
562 if ( $leno == $lene ) {
564 "#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
568 "#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";