--- /dev/null
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
--- /dev/null
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of :ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
my $tname = $opath . $basename;
my $ename = $epath . $basename;
if ( !-e $ename ) {
- print "tmp/$basename is a new file\n";
+ my $new_file = "tmp/$basename";
+ push @new, $new_file;
+ print "$new_file is a new file\n";
push @mv, "cp $tname $ename";
}
elsif ( compare( $ename, $tname ) ) {
close RUN;
system("chmod 0755 $runme");
+
+ if (@new) {
+ if (
+ ifyes(
+"You need to review the new tidied files. Do you want to look at them now? [Y/N]"
+ )
+ )
+ {
+ my $str = join " ", @new;
+ system("vim -R $str");
+ }
+ }
+
+ if ( -e $diff_file ) {
+ if (
+ ifyes(
+"There are differences between the old and new tidied results.\nDo you want to look at them now? [Y/N]"
+ )
+ )
+ {
+ system("vim -R $diff_file");
+ }
+ }
+
+
my $diff_msg =
-e $diff_file
? "Look at differences in '$diff_file'"
: "no differences";
+
print <<EOM;
$diff_msg
-Look at any new results in tmp/ and then
-Enter ./$runme to move results from tmp/ to expect/ if results are acceptable
+If the differences and any new results look okay, then
+Enter ./$runme to move results from tmp/ to expect/ and make new .t files
EOM
}
+sub query {
+ my ($msg) = @_;
+ print $msg;
+ my $ans = <STDIN>;
+ chomp $ans;
+ #my $val=$ans;
+ return $ans;
+}
+sub ifyes {
+
+ # Updated to have default, which should be "Y" or "N"
+ my ($msg, $default)=@_;
+ my $count = 0;
+ ASK:
+ my $ans = query($msg);
+ if ( defined($default) ) {
+ $ans = $default unless ($ans);
+ }
+ if ( $ans =~ /^Y/i ) { return 1 }
+ elsif ( $ans =~ /^N/i ) { return 0 }
+ else {
+ $count++;
+ if ( $count > 6 ) { die "error count exceeded in ifyes\n" }
+ print STDERR "Please answer 'Y' or 'N'\n";
+ goto ASK;
+ }
+}
--- /dev/null
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:23 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
#####################################
$rparams = {
'def' => "",
+ 'scl' => "-scl=12",
'sil' => "-sil=0",
'style1' => <<'----------',
-b
######################
$rsources = {
+ 'scl' => <<'----------',
+ # try -scl=12 to see '$returns' joined with the previous line
+ $format = "format STDOUT =\n" . &format_line('Function: @') . '$name' . "\n" . &format_line('Arguments: @') . '$args' . "\n" . &format_line('Returns: @') . '$returns' . "\n" . &format_line(' ~~ ^') . '$desc' . "\n.\n";
+----------
+
+ 'semicolon2' => <<'----------',
+ # will not add semicolon for this block type
+ $highest = List::Util::reduce { Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b }
+----------
+
'side_comments1' => <<'----------',
# side comments at different indentation levels should not be aligned
{ { { { { ${msg} = "Hello World!"; print "My message: ${msg}\n"; } } #end level 4
sub doit{print"Hello sub\n";}package __END__;
sub doit{print"Hello __END__\n";}package __DATA__;
sub doit{print"Hello __DATA__\n";}
-----------
-
- 'sub2' => <<'----------',
-my $selector;
-
-# leading atrribute separator:
-$a =
- sub
- : locked {
- print "Hello, World!\n";
- };
-$a->();
-
-# colon as both ?/: and attribute separator
-$a = $selector
- ? sub : locked {
- print "Hello, World!\n";
- }
- : sub : locked {
- print "GOODBYE!\n";
- };
-$a->();
-----------
-
- 'switch1' => <<'----------',
-sub classify_digit($digit)
- { switch($digit)
- { case 0 { return 'zero' } case [ 2, 4, 6, 8 ]{ return 'even' }
- case [ 1, 3, 4, 7, 9 ]{ return 'odd' } case /[A-F]/i { return 'hex' } }
- }
----------
};
##############################
$rtests = {
+ 'scl.scl' => {
+ source => "scl",
+ params => "scl",
+ expect => <<'#1...........',
+ # try -scl=12 to see '$returns' joined with the previous line
+ $format =
+ "format STDOUT =\n"
+ . &format_line('Function: @') . '$name' . "\n"
+ . &format_line('Arguments: @') . '$args' . "\n"
+ . &format_line('Returns: @') . '$returns' . "\n"
+ . &format_line(' ~~ ^') . '$desc' . "\n.\n";
+#1...........
+ },
+
+ 'semicolon2.def' => {
+ source => "semicolon2",
+ params => "def",
+ expect => <<'#2...........',
+ # will not add semicolon for this block type
+ $highest = List::Util::reduce {
+ Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b
+ }
+#2...........
+ },
+
'side_comments1.def' => {
source => "side_comments1",
params => "def",
- expect => <<'#1...........',
+ expect => <<'#3...........',
# side comments at different indentation levels should not be aligned
{
{
} # end level 3
} # end level 2
} # end level 1
-#1...........
+#3...........
},
'sil1.def' => {
source => "sil1",
params => "def",
- expect => <<'#2...........',
+ expect => <<'#4...........',
#############################################################
# This will walk to the left because of bad -sil guess
SKIP: {
or ov_method mycan( $package, '(bool' ), $package
or ov_method mycan( $package, '(nomethod' ), $package;
-#2...........
+#4...........
},
'sil1.sil' => {
source => "sil1",
params => "sil",
- expect => <<'#3...........',
+ expect => <<'#5...........',
#############################################################
# This will walk to the left because of bad -sil guess
SKIP: {
or ov_method mycan( $package, '(bool' ), $package
or ov_method mycan( $package, '(nomethod' ), $package;
-#3...........
+#5...........
},
'slashslash.def' => {
source => "slashslash",
params => "def",
- expect => <<'#4...........',
+ expect => <<'#6...........',
$home = $ENV{HOME} // $ENV{LOGDIR} // ( getpwuid($<) )[7]
// die "You're homeless!\n";
defined( $x // $y );
foreach ( split( //, $lets ) ) { }
foreach ( split( //, $input ) ) { }
'xyz' =~ //;
-#4...........
+#6...........
},
'smart.def' => {
source => "smart",
params => "def",
- expect => <<'#5...........',
+ expect => <<'#7...........',
\&foo !~~ \&foo;
\&foo ~~ \&foo;
\&foo ~~ \&foo;
"foo" ~~ %hash;
%hash ~~ /bar/;
/bar/ ~~ %hash;
-#5...........
+#7...........
},
'space1.def' => {
source => "space1",
params => "def",
- expect => <<'#6...........',
+ expect => <<'#8...........',
# We usually want a space at '} (', for example:
map { 1 * $_; } ( $y, $M, $w, $d, $h, $m, $s );
# remove unwanted spaces after $ and -> here
&{ $_->[1] }( delete $_[$#_]{ $_->[0] } );
-#6...........
+#8...........
},
'space2.def' => {
source => "space2",
params => "def",
- expect => <<'#7...........',
+ expect => <<'#9...........',
# space before this opening paren
for $i ( 0 .. 20 ) { }
# retain any space between '-' and bare word
$myhash{ USER-NAME } = 'steve';
-#7...........
+#9...........
},
'space3.def' => {
source => "space3",
params => "def",
- expect => <<'#8...........',
+ expect => <<'#10...........',
# Treat newline as a whitespace. Otherwise, we might combine
# 'Send' and '-recipients' here
my $msg = new Fax::Send
-recipients => $to,
-data => $data;
-#8...........
+#10...........
},
'space4.def' => {
source => "space4",
params => "def",
- expect => <<'#9...........',
+ expect => <<'#11...........',
# first prototype line will cause space between 'redirect' and '(' to close
sub html::redirect($); #<-- temporary prototype;
use html;
print html::redirect('http://www.glob.com.au/');
-#9...........
+#11...........
},
'space5.def' => {
source => "space5",
params => "def",
- expect => <<'#10...........',
+ expect => <<'#12...........',
# first prototype line commented out; space after 'redirect' remains
#sub html::redirect($); #<-- temporary prototype;
use html;
print html::redirect ('http://www.glob.com.au/');
-#10...........
+#12...........
},
'structure1.def' => {
source => "structure1",
params => "def",
- expect => <<'#11...........',
+ expect => <<'#13...........',
push @contents,
$c->table(
{ -width => '100%' },
)
)
);
-#11...........
+#13...........
},
'style.def' => {
source => "style",
params => "def",
- expect => <<'#12...........',
+ expect => <<'#14...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe {
my (@order) = (
}
}
-#12...........
+#14...........
},
'style.style1' => {
source => "style",
params => "style1",
- expect => <<'#13...........',
+ expect => <<'#15...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe {
my (@order) = (
}
}
-#13...........
+#15...........
},
'style.style2' => {
source => "style",
params => "style2",
- expect => <<'#14...........',
+ expect => <<'#16...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe {
my (@order) = (
}
}
-#14...........
+#16...........
},
'style.style3' => {
source => "style",
params => "style3",
- expect => <<'#15...........',
+ expect => <<'#17...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe {
my (@order) = (
}
} ## end sub arrange_topframe
-#15...........
+#17...........
},
'style.style4' => {
source => "style",
params => "style4",
- expect => <<'#16...........',
+ expect => <<'#18...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe {
my (@order) = (
}
}
-#16...........
+#18...........
},
'style.style5' => {
source => "style",
params => "style5",
- expect => <<'#17...........',
+ expect => <<'#19...........',
# This test snippet is from package bbbike v3.214 by Slaven Rezic; GPL 2.0 licence
sub arrange_topframe
{
}
}
-#17...........
+#19...........
},
'sub1.def' => {
source => "sub1",
params => "def",
- expect => <<'#18...........',
+ expect => <<'#20...........',
my::doit();
join::doit();
for::doit();
package __DATA__;
sub doit { print "Hello __DATA__\n"; }
-#18...........
- },
-
- 'sub2.def' => {
- source => "sub2",
- params => "def",
- expect => <<'#19...........',
-my $selector;
-
-# leading atrribute separator:
-$a = sub
- : locked {
- print "Hello, World!\n";
- };
-$a->();
-
-# colon as both ?/: and attribute separator
-$a = $selector
- ? sub : locked {
- print "Hello, World!\n";
- }
- : sub : locked {
- print "GOODBYE!\n";
- };
-$a->();
-#19...........
- },
-
- 'switch1.def' => {
- source => "switch1",
- params => "def",
- expect => <<'#20...........',
-sub classify_digit($digit) {
- switch ($digit) {
- case 0 { return 'zero' }
- case [ 2, 4, 6, 8 ]{ return 'even' }
- case [ 1, 3, 4, 7, 9 ]{ return 'odd' }
- case /[A-F]/i { return 'hex' }
- }
-}
#20...........
},
};
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:35 2018
# To locate test #13 for example, search for the string '#13'
-bt=2
-pt=2
-sbt=2
-----------
- 'vtc' => <<'----------',
--sbvtc=2
--bvtc=2
--pvtc=2
----------
};
######################
$rsources = {
+ 'sub2' => <<'----------',
+my $selector;
+
+# leading atrribute separator:
+$a =
+ sub
+ : locked {
+ print "Hello, World!\n";
+ };
+$a->();
+
+# colon as both ?/: and attribute separator
+$a = $selector
+ ? sub : locked {
+ print "Hello, World!\n";
+ }
+ : sub : locked {
+ print "GOODBYE!\n";
+ };
+$a->();
+----------
+
+ 'switch1' => <<'----------',
+sub classify_digit($digit)
+ { switch($digit)
+ { case 0 { return 'zero' } case [ 2, 4, 6, 8 ]{ return 'even' }
+ case [ 1, 3, 4, 7, 9 ]{ return 'odd' } case /[A-F]/i { return 'hex' } }
+ }
+----------
+
'syntax1' => <<'----------',
# Caused trouble:
print $x **2;
'The Shire', undef],
);
----------
-
- 'vtc2' => <<'----------',
- ok(
- $s->call(
- SOAP::Data->name('getStateName')
- ->attr( { xmlns => 'urn:/My/Examples' } ),
- 1
- )->result eq 'Alabama'
- );
-----------
};
##############################
##############################
$rtests = {
+ 'sub2.def' => {
+ source => "sub2",
+ params => "def",
+ expect => <<'#1...........',
+my $selector;
+
+# leading atrribute separator:
+$a = sub
+ : locked {
+ print "Hello, World!\n";
+ };
+$a->();
+
+# colon as both ?/: and attribute separator
+$a = $selector
+ ? sub : locked {
+ print "Hello, World!\n";
+ }
+ : sub : locked {
+ print "GOODBYE!\n";
+ };
+$a->();
+#1...........
+ },
+
+ 'switch1.def' => {
+ source => "switch1",
+ params => "def",
+ expect => <<'#2...........',
+sub classify_digit($digit) {
+ switch ($digit) {
+ case 0 { return 'zero' }
+ case [ 2, 4, 6, 8 ]{ return 'even' }
+ case [ 1, 3, 4, 7, 9 ]{ return 'odd' }
+ case /[A-F]/i { return 'hex' }
+ }
+}
+#2...........
+ },
+
'syntax1.def' => {
source => "syntax1",
params => "def",
- expect => <<'#1...........',
+ expect => <<'#3...........',
# Caused trouble:
print $x **2;
-#1...........
+#3...........
},
'syntax2.def' => {
source => "syntax2",
params => "def",
- expect => <<'#2...........',
+ expect => <<'#4...........',
# ? was taken as pattern
my $case_flag = File::Spec->case_tolerant ? '(?i)' : '';
-#2...........
+#4...........
},
'ternary1.def' => {
source => "ternary1",
params => "def",
- expect => <<'#3...........',
+ expect => <<'#5...........',
my $flags =
( $_ & 1 )
? ( $_ & 4 )
: $THRf_ZOMBIE
: ( $_ & 4 ) ? $THRf_R_DETACHED
: $THRf_R_JOINABLE;
-#3...........
+#5...........
},
'ternary2.def' => {
source => "ternary2",
params => "def",
- expect => <<'#4...........',
+ expect => <<'#6...........',
my $a =
($b)
? ($c)
: $g2
: ($h) ? $h1
: $h2;
-#4...........
+#6...........
},
'tick1.def' => {
source => "tick1",
params => "def",
- expect => <<'#5...........',
+ expect => <<'#7...........',
sub a'this { $p'u'a = "mooo\n"; print $p::u::a; }
a::this(); # print "mooo"
print $p'u'a; # print "mooo"
$a'that = a'that();
$p::t::u = "booo\n";
$a'that->(); # print "booo"
-#5...........
+#7...........
},
'trim_quote.def' => {
source => "trim_quote",
params => "def",
- expect => <<'#6...........',
+ expect => <<'#8...........',
# space after quote will get trimmed
push @m, '
all :: pure_all manifypods
' . $self->{NOECHO} . '$(NOOP)
'
unless $self->{SKIPHASH}{'all'};
-#6...........
+#8...........
},
'tso1.def' => {
source => "tso1",
params => "def",
- expect => <<'#7...........',
+ expect => <<'#9...........',
print 0 + '42 EUR'; # 42
-#7...........
+#9...........
},
'tso1.tso' => {
source => "tso1",
params => "tso",
- expect => <<'#8...........',
+ expect => <<'#10...........',
print 0+ '42 EUR'; # 42
-#8...........
+#10...........
},
'tutor.def' => {
source => "tutor",
params => "def",
- expect => <<'#9...........',
+ expect => <<'#11...........',
#!/usr/bin/perl
$y = shift || 5;
for $i ( 1 .. 10 ) { $l[$i] = "T"; $w[$i] = 999999; }
print $l[$i], "\t", $w[$i], "\r\n";
}
}
-#9...........
+#11...........
},
'undoci1.def' => {
source => "undoci1",
params => "def",
- expect => <<'#10...........',
+ expect => <<'#12...........',
$rinfo{deleteStyle} = [
-fill => 'red',
-stipple => '@' . Tk->findINC('demos/images/grey.25'),
];
-#10...........
+#12...........
},
'use1.def' => {
source => "use1",
params => "def",
- expect => <<'#11...........',
+ expect => <<'#13...........',
# previously this caused an incorrect error message after '2.42'
use lib "$Common::global::gInstallRoot/lib";
use CGI 2.42 qw(fatalsToBrowser);
use constant MODE => do { 0666 & ( 0777 & ~umask ) };
use IO::File ();
-#11...........
+#13...........
},
'use2.def' => {
source => "use2",
params => "def",
- expect => <<'#12...........',
+ expect => <<'#14...........',
# Keep the space before the '()' here:
use Foo::Bar ();
use Foo::Bar ();
use Foo::Bar 1.0 ();
use Foo::Bar qw(baz);
use Foo::Bar 1.0 qw(baz);
-#12...........
+#14...........
},
'version1.def' => {
source => "version1",
params => "def",
- expect => <<'#13...........',
+ expect => <<'#15...........',
# VERSION statement unbroken, no semicolon added;
our $VERSION = do { my @r = ( q$Revision: 2.2 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }
-#13...........
+#15...........
},
'version2.def' => {
source => "version2",
params => "def",
- expect => <<'#14...........',
+ expect => <<'#16...........',
# On one line so MakeMaker will see it.
require Exporter; our $VERSION = $Exporter::VERSION;
-#14...........
+#16...........
},
'vert.def' => {
source => "vert",
params => "def",
- expect => <<'#15...........',
+ expect => <<'#17...........',
# if $w->vert is tokenized as type 'U' then the ? will start a quote
# and an error will occur.
sub vert {
sub Restore {
$w->vert ? $w->delta_width(0) : $w->delta_height(0);
}
-#15...........
+#17...........
},
'vmll.def' => {
source => "vmll",
params => "def",
- expect => <<'#16...........',
+ expect => <<'#18...........',
# perltidy -act=2 -vmll will leave these intact and greater than 80 columns
# in length, which is what vmll does
BEGIN {
This has the comma on the next line exception {
Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)
},
-#16...........
+#18...........
},
'vmll.vmll' => {
source => "vmll",
params => "vmll",
- expect => <<'#17...........',
+ expect => <<'#19...........',
# perltidy -act=2 -vmll will leave these intact and greater than 80 columns
# in length, which is what vmll does
BEGIN {is_deeply(\@init_metas_called, [1]) || diag(Dumper(\@init_metas_called))}
This has the comma on the next line exception {
Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo)
},
-#17...........
+#19...........
},
'vtc1.def' => {
source => "vtc1",
params => "def",
- expect => <<'#18...........',
+ expect => <<'#20...........',
@lol = (
[
'Dr. Watson', undef, '221b', 'Baker St.',
'The Shire', undef
],
);
-#18...........
- },
-
- 'vtc1.vtc' => {
- source => "vtc1",
- params => "vtc",
- expect => <<'#19...........',
-@lol = (
- [
- 'Dr. Watson', undef, '221b', 'Baker St.',
- undef, 'London', 'NW1', undef,
- 'England', undef ],
- [
- 'Sam Gamgee', undef, undef, 'Bagshot Row',
- undef, 'Hobbiton', undef, undef,
- 'The Shire', undef ], );
-#19...........
- },
-
- 'vtc2.def' => {
- source => "vtc2",
- params => "def",
- expect => <<'#20...........',
- ok(
- $s->call(
- SOAP::Data->name('getStateName')
- ->attr( { xmlns => 'urn:/My/Examples' } ),
- 1
- )->result eq 'Alabama'
- );
#20...........
},
};
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:35 2018
# To locate test #13 for example, search for the string '#13'
######################
$rsources = {
+ 'vtc1' => <<'----------',
+@lol = (
+ [ 'Dr. Watson', undef, '221b', 'Baker St.',
+ undef, 'London', 'NW1', undef,
+ 'England', undef
+ ],
+ [ 'Sam Gamgee', undef, undef, 'Bagshot Row',
+ undef, 'Hobbiton', undef, undef,
+ 'The Shire', undef],
+ );
+----------
+
'vtc2' => <<'----------',
ok(
$s->call(
##############################
$rtests = {
+ 'vtc1.vtc' => {
+ source => "vtc1",
+ params => "vtc",
+ expect => <<'#1...........',
+@lol = (
+ [
+ 'Dr. Watson', undef, '221b', 'Baker St.',
+ undef, 'London', 'NW1', undef,
+ 'England', undef ],
+ [
+ 'Sam Gamgee', undef, undef, 'Bagshot Row',
+ undef, 'Hobbiton', undef, undef,
+ 'The Shire', undef ], );
+#1...........
+ },
+
+ 'vtc2.def' => {
+ source => "vtc2",
+ params => "def",
+ expect => <<'#2...........',
+ ok(
+ $s->call(
+ SOAP::Data->name('getStateName')
+ ->attr( { xmlns => 'urn:/My/Examples' } ),
+ 1
+ )->result eq 'Alabama'
+ );
+#2...........
+ },
+
'vtc2.vtc' => {
source => "vtc2",
params => "vtc",
- expect => <<'#1...........',
+ expect => <<'#3...........',
ok(
$s->call(
SOAP::Data->name('getStateName')
->attr( { xmlns => 'urn:/My/Examples' } ),
1 )->result eq 'Alabama' );
-#1...........
+#3...........
},
'vtc3.def' => {
source => "vtc3",
params => "def",
- expect => <<'#2...........',
+ expect => <<'#4...........',
$day_long = (
"Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday", "Sunday"
)[$wday];
-#2...........
+#4...........
},
'vtc3.vtc' => {
source => "vtc3",
params => "vtc",
- expect => <<'#3...........',
+ expect => <<'#5...........',
$day_long = (
"Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday", "Sunday" )[$wday];
-#3...........
+#5...........
},
'vtc4.def' => {
source => "vtc4",
params => "def",
- expect => <<'#4...........',
+ expect => <<'#6...........',
my $bg_color = $im->colorAllocate(
unpack(
'C3',
)
)
);
-#4...........
+#6...........
},
'vtc4.vtc' => {
source => "vtc4",
params => "vtc",
- expect => <<'#5...........',
+ expect => <<'#7...........',
my $bg_color = $im->colorAllocate(
unpack(
'C3',
length( $options_r->{'bg_color'} )
? $options_r->{'bg_color'}
: $MIDI::Opus::BG_color ) ) ) ) );
-#5...........
+#7...........
},
'wn1.def' => {
source => "wn1",
params => "def",
- expect => <<'#6...........',
+ expect => <<'#8...........',
my $bg_color = $im->colorAllocate(
unpack(
'C3',
)
)
);
-#6...........
+#8...........
},
'wn1.wn' => {
source => "wn1",
params => "wn",
- expect => <<'#7...........',
+ expect => <<'#9...........',
my $bg_color = $im->colorAllocate( unpack(
'C3',
pack(
)
)
) );
-#7...........
+#9...........
},
'wn2.def' => {
source => "wn2",
params => "def",
- expect => <<'#8...........',
+ expect => <<'#10...........',
if ( $PLATFORM eq 'aix' ) {
skip_symbols(
[
]
);
}
-#8...........
+#10...........
},
'wn2.wn' => {
source => "wn2",
params => "wn",
- expect => <<'#9...........',
+ expect => <<'#11...........',
if ( $PLATFORM eq 'aix' ) {
skip_symbols( [ qw(
Perl_dump_fds
PL_sys_intern
) ] );
}
-#9...........
+#11...........
},
'wn3.def' => {
source => "wn3",
params => "def",
- expect => <<'#10...........',
+ expect => <<'#12...........',
deferred->resolve->then(
sub {
push @out, 'Resolve';
push @out, @_;
}
);
-#10...........
+#12...........
},
'wn3.wn' => {
source => "wn3",
params => "wn",
- expect => <<'#11...........',
+ expect => <<'#13...........',
deferred->resolve->then( sub {
push @out, 'Resolve';
return $then;
push @out, 'Reject';
push @out, @_;
} );
-#11...........
+#13...........
},
'wn4.def' => {
source => "wn4",
params => "def",
- expect => <<'#12...........',
+ expect => <<'#14...........',
{
{
{
}
}
}
-#12...........
+#14...........
},
'wn4.wn' => {
source => "wn4",
params => "wn",
- expect => <<'#13...........',
+ expect => <<'#15...........',
{ { {
# Orignal formatting looks nice but would be hard to duplicate
? %{ $G->{Attr}->{E}->{$u}->{$v} }
: ();
} } }
-#13...........
+#15...........
},
'wn5.def' => {
source => "wn5",
params => "def",
- expect => <<'#14...........',
+ expect => <<'#16...........',
# qw weld with -wn
use_all_ok(
qw{
PPI::Cache
}
);
-#14...........
+#16...........
},
'wn5.wn' => {
source => "wn5",
params => "wn",
- expect => <<'#15...........',
+ expect => <<'#17...........',
# qw weld with -wn
use_all_ok( qw{
PPI
PPI::Util
PPI::Cache
} );
-#15...........
+#17...........
},
'wn6.def' => {
source => "wn6",
params => "def",
- expect => <<'#16...........',
+ expect => <<'#18...........',
# illustration of some do-not-weld rules
# do not weld a two-line function call
$_[0]->();
}
);
-#16...........
+#18...........
},
'wn6.wn' => {
source => "wn6",
params => "wn",
- expect => <<'#17...........',
+ expect => <<'#19...........',
# illustration of some do-not-weld rules
# do not weld a two-line function call
push @tracelog => 'around 1';
$_[0]->();
} );
-#17...........
+#19...........
},
};
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
-dac
----------
'rt125506' => "-io",
- 'rt50702' => <<'----------',
+ 'rt18318' => <<'----------',
+-nwrs='A'
+----------
+ 'rt50702' => <<'----------',
-wbb='='
----------
'rt70747' => "-i=2",
'rt15735' => <<'----------',
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 );
+----------
+
+ 'rt18318' => <<'----------',
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
----------
'rt27000' => <<'----------',
} @$_;
]
};
-----------
-
- 'rt74856' => <<'----------',
-{
-my $foo = '1';
-#<<<
-my $bar = (test())
- ? 'some value'
- : undef;
-#>>>
-my $baz = 'something else';
-}
-----------
-
- 'rt78156' => <<'----------',
-package Some::Class 2.012;
----------
};
#10...........
},
+ 'rt18318.def' => {
+ source => "rt18318",
+ params => "def",
+ expect => <<'#11...........',
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of : ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
+#11...........
+ },
+
+ 'rt18318.rt18318' => {
+ source => "rt18318",
+ params => "rt18318",
+ expect => <<'#12...........',
+# Class::Std attribute list
+# The token type of the first colon is 'A' so use -nwrs='A' to avoid space
+# after it
+my %rank_of :ATTR( :init_arg<starting_rank> :get<rank> :set<rank> );
+#12...........
+ },
+
'rt27000.def' => {
source => "rt27000",
params => "def",
- expect => <<'#11...........',
+ expect => <<'#13...........',
print add( 3, 4 ), "\n";
print add( 4, 3 ), "\n";
die "$term1 > $term2" if $term1 > $term2;
return $term1 + $term2;
}
-#11...........
+#13...........
},
'rt31741.def' => {
source => "rt31741",
params => "def",
- expect => <<'#12...........',
+ expect => <<'#14...........',
$msg //= 'World';
-#12...........
+#14...........
},
'rt49289.def' => {
source => "rt49289",
params => "def",
- expect => <<'#13...........',
+ expect => <<'#15...........',
use constant qw{ DEBUG 0 };
-#13...........
+#15...........
},
'rt50702.def' => {
source => "rt50702",
params => "def",
- expect => <<'#14...........',
+ expect => <<'#16...........',
if (1) {
my $uid =
$ENV{'ORIG_LOGNAME'}
|| $ENV{'REMOTE_USER'}
|| 'foobar' );
}
-#14...........
+#16...........
},
'rt50702.rt50702' => {
source => "rt50702",
params => "rt50702",
- expect => <<'#15...........',
+ expect => <<'#17...........',
if (1) {
my $uid
= $ENV{'ORIG_LOGNAME'}
|| $ENV{'REMOTE_USER'}
|| 'foobar' );
}
-#15...........
+#17...........
},
'rt68870.def' => {
source => "rt68870",
params => "def",
- expect => <<'#16...........',
+ expect => <<'#18...........',
s///r;
-#16...........
+#18...........
},
'rt70747.def' => {
source => "rt70747",
params => "def",
- expect => <<'#17...........',
+ expect => <<'#19...........',
coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
[
map {
} @$_;
]
};
-#17...........
+#19...........
},
'rt70747.rt70747' => {
source => "rt70747",
params => "rt70747",
- expect => <<'#18...........',
+ expect => <<'#20...........',
coerce Q2RawStatGroupArray, from ArrayRef [Q2StatGroup], via {
[
map {
} @$_;
]
};
-#18...........
- },
-
- 'rt74856.def' => {
- source => "rt74856",
- params => "def",
- expect => <<'#19...........',
-{
- my $foo = '1';
-#<<<
-my $bar = (test())
- ? 'some value'
- : undef;
-#>>>
- my $baz = 'something else';
-}
-#19...........
- },
-
- 'rt78156.def' => {
- source => "rt78156",
- params => "def",
- expect => <<'#20...........',
-package Some::Class 2.012;
#20...........
},
};
# **This script was automatically generated**
# Created with: ./make_t.pl
-# Tue Jun 12 19:09:24 2018
+# Thu Jun 14 13:29:34 2018
# To locate test #13 for example, search for the string '#13'
-act=2
----------
'rt98902' => "-boc",
- 'scl' => "-scl=12",
};
######################
######################
$rsources = {
+ '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;
# try -scl=12 to see '$returns' joined with the previous line
$format = "format STDOUT =\n" . &format_line('Function: @') . '$name' . "\n" . &format_line('Arguments: @') . '$args' . "\n" . &format_line('Returns: @') . '$returns' . "\n" . &format_line(' ~~ ^') . '$desc' . "\n.\n";
----------
-
- 'semicolon2' => <<'----------',
- # will not add semicolon for this block type
- $highest = List::Util::reduce { Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b }
-----------
};
##############################
##############################
$rtests = {
+ 'rt74856.def' => {
+ source => "rt74856",
+ params => "def",
+ expect => <<'#1...........',
+{
+ my $foo = '1';
+#<<<
+my $bar = (test())
+ ? 'some value'
+ : undef;
+#>>>
+ my $baz = 'something else';
+}
+#1...........
+ },
+
+ 'rt78156.def' => {
+ source => "rt78156",
+ params => "def",
+ expect => <<'#2...........',
+package Some::Class 2.012;
+#2...........
+ },
+
'rt78764.def' => {
source => "rt78764",
params => "def",
- expect => <<'#1...........',
+ expect => <<'#3...........',
qr/3/ ~~ ['1234'] ? 1 : 0;
map { $_ ~~ [ '0', '1' ] ? 'x' : 'o' } @a;
-#1...........
+#3...........
},
'rt79813.def' => {
source => "rt79813",
params => "def",
- expect => <<'#2...........',
+ expect => <<'#4...........',
my %hash = (
a => {
bbbbbbbbb => {
},
},
);
-#2...........
+#4...........
},
'rt79947.def' => {
source => "rt79947",
params => "def",
- expect => <<'#3...........',
+ expect => <<'#5...........',
try { croak "An Error!"; }
catch ($error) {
print STDERR $error . "\n";
}
-#3...........
+#5...........
},
'rt80645.def' => {
source => "rt80645",
params => "def",
- expect => <<'#4...........',
+ expect => <<'#6...........',
BEGIN { $^W = 1; }
use warnings;
use strict;
@$ = 'test';
print $#{$};
-#4...........
+#6...........
},
'rt81852.def' => {
source => "rt81852",
params => "def",
- expect => <<'#5...........',
+ expect => <<'#7...........',
do {
{
next if ( $n % 2 );
print $n, "\n";
}
} while ( $n++ < 10 );
-#5...........
+#7...........
},
'rt81852.rt81852' => {
source => "rt81852",
params => "rt81852",
- expect => <<'#6...........',
+ expect => <<'#8...........',
do {{
next if ($n % 2);
print $n, "\n";
}} while ($n++ < 10);
-#6...........
+#8...........
},
'rt81854.def' => {
source => "rt81854",
params => "def",
- expect => <<'#7...........',
+ expect => <<'#9...........',
return "this is a descriptive error message"
if $res->is_error or not length $data;
-#7...........
+#9...........
},
'rt87502.def' => {
source => "rt87502",
params => "def",
- expect => <<'#8...........',
+ expect => <<'#10...........',
if ( @ARGV ~~ { map { $_ => 1 } qw(re restart reload) } ) {
# CODE
}
-#8...........
+#10...........
},
'rt93197.def' => {
source => "rt93197",
params => "def",
- expect => <<'#9...........',
+ expect => <<'#11...........',
$to = $to->{$_} ||= {} for @key;
if (1) { 2; }
else { 3; }
-#9...........
+#11...........
},
'rt94338.def' => {
source => "rt94338",
params => "def",
- expect => <<'#10...........',
+ expect => <<'#12...........',
# for-loop in a parenthesized block-map triggered an error message
map( {
foreach my $item ( '0', '1' ) {
print $item;
}
} qw(a b c) );
-#10...........
+#12...........
},
'rt95419.def' => {
source => "rt95419",
params => "def",
- expect => <<'#11...........',
+ expect => <<'#13...........',
case "blah" => sub {
{ a => 1 }
};
-#11...........
+#13...........
},
'rt95708.def' => {
source => "rt95708",
params => "def",
- expect => <<'#12...........',
+ expect => <<'#14...........',
use strict;
use JSON;
my $ref = {
when => time(),
message => 'abc'
};
-#12...........
+#14...........
},
'rt96021.def' => {
source => "rt96021",
params => "def",
- expect => <<'#13...........',
+ expect => <<'#15...........',
$a->@*;
$a->**;
$a->$*;
$a->&*;
$a->%*;
$a->$#*
-#13...........
+#15...........
},
'rt96101.def' => {
source => "rt96101",
params => "def",
- expect => <<'#14...........',
+ expect => <<'#16...........',
# Example for rt.cpan.org #96101; Perltidy not properly formatting subroutine
# references inside subroutine execution.
);
}
-#14...........
+#16...........
},
'rt98902.def' => {
source => "rt98902",
params => "def",
- expect => <<'#15...........',
+ expect => <<'#17...........',
my %foo = (
alpha => 1,
beta => 2,
my @bar =
map { { number => $_, character => chr $_, padding => ( ' ' x $_ ), } }
( 0 .. 32 );
-#15...........
+#17...........
},
'rt98902.rt98902' => {
source => "rt98902",
params => "rt98902",
- expect => <<'#16...........',
+ expect => <<'#18...........',
my %foo = (
alpha => 1,
beta => 2, gamma => 3,
padding => ( ' ' x $_ ),
}
} ( 0 .. 32 );
-#16...........
+#18...........
},
'rt99961.def' => {
source => "rt99961",
params => "def",
- expect => <<'#17...........',
+ expect => <<'#19...........',
%thing = %{
print qq[blah1\n];
$b;
};
-#17...........
+#19...........
},
'scl.def' => {
source => "scl",
params => "def",
- expect => <<'#18...........',
+ expect => <<'#20...........',
# try -scl=12 to see '$returns' joined with the previous line
$format =
"format STDOUT =\n"
. &format_line('Returns: @')
. '$returns' . "\n"
. &format_line(' ~~ ^') . '$desc' . "\n.\n";
-#18...........
- },
-
- 'scl.scl' => {
- source => "scl",
- params => "scl",
- expect => <<'#19...........',
- # try -scl=12 to see '$returns' joined with the previous line
- $format =
- "format STDOUT =\n"
- . &format_line('Function: @') . '$name' . "\n"
- . &format_line('Arguments: @') . '$args' . "\n"
- . &format_line('Returns: @') . '$returns' . "\n"
- . &format_line(' ~~ ^') . '$desc' . "\n.\n";
-#19...........
- },
-
- 'semicolon2.def' => {
- source => "semicolon2",
- params => "def",
- expect => <<'#20...........',
- # will not add semicolon for this block type
- $highest = List::Util::reduce {
- Sort::Versions::versioncmp( $a, $b ) > 0 ? $a : $b
- }
#20...........
},
};
projects / perltidy.git / commitdiff