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' => <<'----------',
59 ############################
60 # BEGIN SECTION 2: Sources #
61 ############################
64 'rt102451' => <<'----------',
65 # RT#102451 bug test; unwanted spaces added before =head1 on each pass
72 my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array
82 'rt104427' => <<'----------',
84 use v5.020; #includes strict
86 use experimental 'signatures';
89 sub setidentifier ( $href = {} ) { say 'hi'; }
92 'rt106492' => <<'----------',
93 my $ct = Courriel::Header::ContentType->new( mime_type => 'multipart/alternative', attributes => { boundary => unique_boundary }, );
96 'rt107832' => <<'----------',
106 'rt111519' => <<'----------',
109 my $x = 1; # comment not removed
110 # comment will be removed
111 my $y = 2; # comment also not removed
114 'rt112534' => <<'----------',
115 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; } );
118 'rt113689' => <<'----------',
120 if ( !defined( $_[0] ) ) {
121 print("Hello, World\n");
123 else { print( $_[0], "\n" ); }
127 'rt113792' => <<'----------',
128 print "hello world\n";
133 'rt114359' => <<'----------',
134 my $x = 2; print $x ** 0.5;
137 'rt114909' => <<'----------',
142 use experimental 'signatures';
144 sub reader ( $line_sep, $chomp ) {
145 return sub ( $fh, $out ) : prototype(*$) {
146 local $/ = $line_sep;
148 return undef unless defined $content;
149 chomp $content if $chomp;
156 *get_line = reader( "\n", 1 );
159 while ( get_line( STDIN, \my $buf ) ) {
164 'rt116344' => <<'----------',
166 # Attempting to tidy the following code failed:
168 return ref {} ? 1 : 0;
173 'rt119140' => <<'----------',
177 'rt119588' => <<'----------',
180 my $longname = shift // "xyz";
184 'rt119970' => <<'----------',
193 'rt123492' => <<'----------',
201 'rt123749' => <<'----------',
202 get('http://mojolicious.org')->then(
205 say $mojo->res->code;
206 return get('http://metacpan.org');
211 say $cpan->res->code;
216 warn "Something went wrong: $err";
222 ####################################
223 # BEGIN SECTION 3: Expected output #
224 ####################################
228 source => "rt102451",
230 expect => <<'#1...........',
231 # RT#102451 bug test; unwanted spaces added before =head1 on each pass
238 my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array
250 source => "rt104427",
252 expect => <<'#2...........',
254 use v5.020; #includes strict
256 use experimental 'signatures';
259 sub setidentifier ( $href = {} ) { say 'hi'; }
264 source => "rt106492",
266 expect => <<'#3...........',
267 my $ct = Courriel::Header::ContentType->new(
268 mime_type => 'multipart/alternative',
269 attributes => { boundary => unique_boundary },
275 source => "rt107832",
277 expect => <<'#4...........',
288 'rt107832.rt107832' => {
289 source => "rt107832",
290 params => "rt107832",
291 expect => <<'#5...........',
303 source => "rt111519",
305 expect => <<'#6...........',
308 my $x = 1; # comment not removed
310 # comment will be removed
311 my $y = 2; # comment also not removed
315 'rt111519.rt111519' => {
316 source => "rt111519",
317 params => "rt111519",
318 expect => <<'#7...........',
327 source => "rt112534",
329 expect => <<'#8...........',
331 on_ready => sub ($worker) { $on_ready->end; return; },
332 on_exit => sub ( $worker, $status ) {
335 on_data => sub ($data) { $self->_on_data(@_) if $self; return; }
341 source => "rt113689",
343 expect => <<'#9...........',
345 if ( !defined( $_[0] ) ) {
346 print("Hello, World\n");
348 else { print( $_[0], "\n" ); }
353 'rt113689.rt113689' => {
354 source => "rt113689",
355 params => "rt113689",
356 expect => <<'#10...........',
360 if ( !defined( $_[0] ) ) {
363 print("Hello, World\n");
366 else { print( $_[0], "\n" ); }
373 source => "rt113792",
375 expect => <<'#11...........',
376 print "hello world\n";
383 source => "rt114359",
385 expect => <<'#12...........',
392 source => "rt114909",
394 expect => <<'#13...........',
399 use experimental 'signatures';
401 sub reader ( $line_sep, $chomp ) {
402 return sub ( $fh, $out ) : prototype(*$) {
403 local $/ = $line_sep;
405 return undef unless defined $content;
406 chomp $content if $chomp;
413 *get_line = reader( "\n", 1 );
416 while ( get_line( STDIN, \my $buf ) ) {
423 source => "rt116344",
425 expect => <<'#14...........',
427 # Attempting to tidy the following code failed:
429 return ref {} ? 1 : 0;
436 source => "rt119140",
438 expect => <<'#15...........',
444 source => "rt119588",
446 expect => <<'#16...........',
449 my $longname = shift // "xyz";
455 source => "rt119970",
457 expect => <<'#17...........',
467 'rt119970.rt119970' => {
468 source => "rt119970",
469 params => "rt119970",
470 expect => <<'#18...........',
479 source => "rt123492",
481 expect => <<'#19...........',
491 source => "rt123749",
493 expect => <<'#20...........',
494 get('http://mojolicious.org')->then(
497 say $mojo->res->code;
498 return get('http://metacpan.org');
503 say $cpan->res->code;
508 warn "Something went wrong: $err";
515 my $ntests = 0 + keys %{$rtests};
516 plan tests => $ntests;
523 foreach my $key ( sort keys %{$rtests} ) {
525 my $sname = $rtests->{$key}->{source};
526 my $expect = $rtests->{$key}->{expect};
527 my $pname = $rtests->{$key}->{params};
528 my $source = $rsources->{$sname};
529 my $params = defined($pname) ? $rparams->{$pname} : "";
531 my $errorfile_string;
532 my $err = Perl::Tidy::perltidy(
534 destination => \$output,
535 perltidyrc => \$params,
536 argv => '', # for safety; hide any ARGV from perltidy
537 stderr => \$stderr_string,
538 errorfile => \$errorfile_string, # not used when -se flag is set
540 if ( $err || $stderr_string || $errorfile_string ) {
543 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
546 if ($stderr_string) {
547 print STDERR "---------------------\n";
548 print STDERR "<<STDERR>>\n$stderr_string\n";
549 print STDERR "---------------------\n";
551 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
552 ok( !$stderr_string );
554 if ($errorfile_string) {
555 print STDERR "---------------------\n";
556 print STDERR "<<.ERR file>>\n$errorfile_string\n";
557 print STDERR "---------------------\n";
559 "This error received calling Perl::Tidy with '$sname' + '$pname'\n";
560 ok( !$errorfile_string );
564 ok( $output, $expect );