'[ {' - exclude all brackets and braces
'[ ( ^K{' - exclude everything except nested structures like do {{ ... }}
-=item B<-dwic>, B<--delete-weld-interfering-commas>
-
-If the closing tokens of two nested containers are separated by a comma, then
-welding cannot occur. Any commas in this situation are optional trailing
-commas and can be removed if desired. This can be done by hand, but on large
-scripts it might be easier to use this parameter. The parameter B<-dwic> tells
-perltidy to remove any such commas that it finds. For example, using a
-previous example with an added comma, we see that the comma prevents welding:
-
- # perltidy -wn
- skip_symbols(
- [ qw(
- Perl_dump_fds
- Perl_ErrorNo
- Perl_GetVars
- PL_sys_intern
- ) ],
- );
-
-If this is not desired, then the comma can be removed manually or by using B<-dwic>, as follows:
-
- # perltidy -wn -dwic
- skip_symbols( [ qw(
- Perl_dump_fds
- Perl_ErrorNo
- Perl_GetVars
- PL_sys_intern
- ) ] );
-
-Here are some points to note about the B<-dwic> parameter
-
-=over 4
-
-=item *
-
-This operation is not reversible, so please check results of using this parameter carefully.
-
-=item *
-
-Removing these isolated trailing commas is necessary for welding to be
-possible, but not sufficient.
-
-=back
-
=item B<Vertical tightness> of non-block curly braces, parentheses, and square brackets.
=back
-=head2 Trailing Commas
+=head2 Trailing Comma Controls
A trailing comma is a comma following the last item of a list. Perl allows
-trailing commas but they are not required. By default, perltidy does not add
-or delete trailing commas, but it is possible to do this with the following set of three related parameters:
+trailing commas but they are not required. So using them is optional, but they
+can be useful. In particular, having a comma at the end of each line of a list
+can simplify the use of an editor to reorder or add new lines.
+
+By default, perltidy does not add or delete commas, but it is possible to
+manipulate trailing commas with the following set of three related parameters:
--want-trailing-commas=s, -wtc=s - defines where trailing commas are wanted
--add-trailing-commas, -atc - gives permission to add trailing commas to match the style wanted
-wtc=0 -dtc : delete all trailing commas
-wtc=1 -atc : put trailing commas on all lists
-wtc=m -atc : all multi-line lists get trailing commas;
- single line lists may or may not have trailing commas
+ single line lists remain unchanged.
-wtc=m -atc -dtc : all multi-line lists get trailing commas, and
any trailing commas on single line lists are removed.
newline). And it could also be achieved with B<-wtc=h> because this particular
list is a list of key=>value pairs.
-It is possible to apply a different style to different types of containing
-tokens by including an opening token ahead of the style character in the above table. For example
+The above styles should cover the main of situations of interest, but it is
+possible to apply a different style to each type of container token by
+including an opening token ahead of the style character in the above table.
+For example
-wtc='(m [b'
specification for curly braces in this example, their trailing commas would
remain unchanged.
-An optional additional item of information which can be given for parentheses is an alphanumeric
-letter which is used to limit the selection further depending on the type of
-token immediately before the opening paren. The possible letters are currently 'k',
-'K', 'f', 'F', 'w', and 'W', with these meanings for matching whatever precedes an opening paren:
+For parentheses, an additional item of information which can be given is an
+alphanumeric letter which is used to limit the selection further depending on
+the type of token immediately before the opening paren. The possible letters
+are currently 'k', 'K', 'f', 'F', 'w', and 'W', with these meanings for
+matching whatever precedes an opening paren:
'k' matches if the previous nonblank token is a perl built-in keyword (such as 'if', 'while'),
'K' matches if 'k' does not, meaning that the previous token is not a keyword.
means that trailing commas are wanted for multi-line parenthesized lists following a function call or keyword.
-Here are some points regarding adding and deleting trailing commas:
+Here are some points to note regarding adding and deleting trailing commas:
=over 4
=item *
For the implementation of these parameters, a B<list> is basically taken to be
-a container of items (parens, square brackets, or braces) which is not a code
+a container of items (parens, square brackets, or braces), which is not a code
block, with one or more commas. These parameters only apply to something that
fits this definition of a list.
-So a paren-less list of parameters is not a list by this definition, so these parameters have no effect on a peren-less list.
+So a paren-less list of parameters is not a list by this definition, so these parameters have no effect on a peren-less list. For example, the trailing comma
+in the following line cannot be manipulated with these parameters:
+
+ my $theta = atan2 $y, $x, ;
+
+Another consequence is that if the only comma in a list is deleted, then it
+cannot later be added back with these parameters because the container no
+longer fits this definition of a list. For example, given
+
+ $x = $r * cos( $theta, );
+
+and if we remove the comma with
+
+ # perltidy -wtc=m -dtc
+ $x = $r * cos( $theta );
-Also note that if the only comma in a list is a trailing comma, and it is
-deleted with these commands, then that container will no longer have a comma
-and will therefore no longer be a list by this definition. Consequently, a
-trailing comma cannot later be added back to that container.
+then we cannot use these trailing comma controls to add this comma back.
=item *
=item *
A B<bare> trailing comma is a comma which is at the end of a line. That is,
-the closing container token follows on a different line.
+the closing container token follows on a different line. So a bare trailing
+comma only occurs in a multi-line list.
=item *
-The decision regarding whether or not a list is multiline or bare is
+The decision regarding whether or not a list is multi-line or bare is
made based on the B<input> stream. In some cases it may take an iteration
or two to reach a final state.
=back
+=head2 Other Comma Controls
+
+=item B<-dwic>, B<--delete-weld-interfering-commas>
+
+If the closing tokens of two nested containers are separated by a comma, then
+welding requested with B<--weld-nested-containers> cannot occur. Any commas in
+this situation are optional trailing commas and can be removed with B<-dwic>.
+For example, a comma in this scipt prevents welding:
+
+ # perltidy -wn
+ skip_symbols(
+ [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ],
+ );
+
+Using B<-dwic> removes the comma and allows welding:
+
+ # perltidy -wn -dwic
+ skip_symbols( [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ] );
+
+Since the default is not to add or delete commas, this feature is off by default.
+Here are some points to note about the B<-dwic> parameter
+
+=over 4
+
+=item *
+
+This operation is not reversible, so please check results of using this parameter carefully.
+
+=item *
+
+Removing this type of isolated trailing comma is necessary for welding to be
+possible, but not sufficient. So welding will not always occur where these
+commas are removed.
+
+=back
+
+=item B<-drc>, B<--delete-repeated-commas>
+
+Repeated commas in a list are undesirable and can be removed with this flag.
+For example, given this list with a repeated comma
+
+ ignoreSpec( $file, "file",, \%spec, \%Rspec );
+
+we can remove it with -drc
+
+ # perltidy -drc:
+ ignoreSpec( $file, "file", \%spec, \%Rspec );
+
+Since the default is not to add or delete commas, this feature is off by default and must be requested.
+
+=back
+
=head2 Retaining or Ignoring Existing Line Breaks
Several additional parameters are available for controlling the extent
The following list shows all short parameter names which allow a prefix
'n' to produce the negated form:
- D anl asbl asc ast asu atnl aws b baa
- baao bar bbao bbb bbc bbs bl bli boa boc
- bok bol bom bos bot cblx ce conv cs csc
- cscb cscw dac dbc dcbl dcsc ddf dln dnl dop
- dp dpro dsc dsm dsn dtt dwls dwrs dws eos
- f fll fpva frm fs fso gcs hbc hbcm hbco
- hbh hbhh hbi hbj hbk hbm hbn hbp hbpd hbpu
- hbq hbs hbsc hbv hbw hent hic hicm hico hih
- hihh hii hij hik him hin hip hipd hipu hiq
- his hisc hiv hiw hsc html ibc icb icp iob
- isbc iscl kgb kgbd kgbi kis lal log lop lp
- lsl mem nib ohbr okw ola olc oll olq opr
- opt osbc osbr otr ple pod pvl q sac sbc
- sbl scbb schb scp scsb sct se sfp sfs skp
- sob sobb sohb sop sosb sot ssc st sts t
- tac tbc toc tp tqw trp ts tsc tso vbc
- vc vmll vsc w wn x xci xlp xs
+ D anl asbl asc ast asu atc atnl aws b
+ baa baao bar bbao bbb bbc bbs bl bli boa
+ boc bok bol bom bos bot cblx ce conv cs
+ csc cscb cscw dac dbc dcbl dcsc ddf dln dnl
+ dop dp dpro drc dsc dsm dsn dtc dtt dwic
+ dwls dwrs dws eos f fll fpva frm fs fso
+ gcs hbc hbcm hbco hbh hbhh hbi hbj hbk hbm
+ hbn hbp hbpd hbpu hbq hbs hbsc hbv hbw hent
+ hic hicm hico hih hihh hii hij hik him hin
+ hip hipd hipu hiq his hisc hiv hiw hsc html
+ ibc icb icp iob isbc iscl kgb kgbd kgbi kis
+ lal log lop lp lsl mem nib ohbr okw ola
+ olc oll olq opr opt osbc osbr otr ple pod
+ pvl q sac sbc sbl scbb schb scp scsb sct
+ se sfp sfs skp sob sobb sohb sop sosb sot
+ ssc st sts t tac tbc toc tp tqw trp
+ ts tsc tso vbc vc vmll vsc w wfc wn
+ x xci xlp xs
Equivalently, the prefix 'no' or 'no-' on the corresponding long names may be
used.
--- /dev/null
+ skip_symbols(
+ [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ],
+ );
--- /dev/null
+ skip_symbols(
+ [
+ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ )
+ ],
+ );
--- /dev/null
+ skip_symbols( [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ] );
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ]
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ }
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy", ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body, ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ },
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } },
+ };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ },
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ] );
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle' );
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ } )->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
../snippets26.t c154.def
../snippets26.t code_skipping.code_skipping
../snippets26.t c158.def
+../snippets26.t git108.def
+../snippets26.t git108.git108
+../snippets26.t wtc.def
+../snippets27.t wtc.wtc1
+../snippets27.t wtc.wtc2
+../snippets27.t wtc.wtc3
+../snippets27.t wtc.wtc4
+../snippets27.t wtc.wtc5
+../snippets27.t wtc.wtc6
../snippets3.t ce_wn1.ce_wn
../snippets3.t ce_wn1.def
../snippets3.t colin.colin
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
-../snippets26.t git108.def
-../snippets26.t git108.git108
+../snippets27.t dwic.def
+../snippets27.t dwic.dwic
--- /dev/null
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+
--- /dev/null
+-wtc=0 -dtc
--- /dev/null
+-wtc=1 -atc
--- /dev/null
+-wtc=m -atc
--- /dev/null
+-wtc=m -atc -dtc
--- /dev/null
+-wtc=b -atc -dtc -vtc=2
--- /dev/null
+-wtc=h -atc -dtc -vtc=2
#16 c158.def
#17 git108.def
#18 git108.git108
+#19 wtc.def
# To locate test #13 you can search for its name or the string '#13'
dog => {prowl => "growl", pool => "drool"},
mouse => {nibble => "kibble"},
};
+----------
+
+ 'wtc' => <<'----------',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+
----------
};
) ] );
#18...........
},
+
+ 'wtc.def' => {
+ source => "wtc",
+ params => "def",
+ expect => <<'#19...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+#19...........
+ },
};
my $ntests = 0 + keys %{$rtests};
--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 wtc.wtc1
+#2 wtc.wtc2
+#3 wtc.wtc3
+#4 wtc.wtc4
+#5 wtc.wtc5
+#6 wtc.wtc6
+#7 dwic.def
+#8 dwic.dwic
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test::More;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'def' => "",
+ 'dwic' => "-wn -dwic",
+ 'wtc1' => "-wtc=0 -dtc",
+ 'wtc2' => "-wtc=1 -atc",
+ 'wtc3' => "-wtc=m -atc",
+ 'wtc4' => "-wtc=m -atc -dtc",
+ 'wtc5' => "-wtc=b -atc -dtc -vtc=2",
+ 'wtc6' => "-wtc=h -atc -dtc -vtc=2",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'dwic' => <<'----------',
+ skip_symbols(
+ [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ],
+ );
+----------
+
+ 'wtc' => <<'----------',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'wtc.wtc1' => {
+ source => "wtc",
+ params => "wtc1",
+ expect => <<'#1...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ]
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green'
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle'
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ }
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
+#1...........
+ },
+
+ 'wtc.wtc2' => {
+ source => "wtc",
+ params => "wtc2",
+ expect => <<'#2...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy", ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body, ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+#2...........
+ },
+
+ 'wtc.wtc3' => {
+ source => "wtc",
+ params => "wtc3",
+ expect => <<'#3...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney", ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart", ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3, );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1, );
+ },
+)->pack( -side => 'left', );
+
+my $no_index_1_1 =
+ { 'map' =>
+ { ':key' => { name => \&string, list => { value => \&string }, }, }, };
+
+#3...........
+ },
+
+ 'wtc.wtc4' => {
+ source => "wtc",
+ params => "wtc4",
+ expect => <<'#4...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow', );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ },
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } },
+ };
+
+#4...........
+ },
+
+ 'wtc.wtc5' => {
+ source => "wtc",
+ params => "wtc5",
+ expect => <<'#5...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ],
+);
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle',
+);
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ },
+)->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
+#5...........
+ },
+
+ 'wtc.wtc6' => {
+ source => "wtc",
+ params => "wtc6",
+ expect => <<'#6...........',
+# both single and multiple line lists:
+@LoL = (
+ [ "fred", "barney" ],
+ [ "george", "jane", "elroy" ],
+ [ "homer", "marge", "bart" ] );
+
+# single line
+( $name, $body ) = ( $2, $3 );
+
+# multiline, but not bare
+$text = $main->Scrolled( TextUndo, $yyy, $zzz, $wwwww,
+ selectbackgroundxxxxx => 'yellow' );
+
+# this will pass for 'h'
+my $new = {
+ %$item,
+ text => $leaf,
+ color => 'green',
+};
+
+# and this
+my @list = (
+
+ $xx,
+ $yy,
+);
+
+# does not match 'h'
+$c1->create(
+ 'rectangle', 40, 60, 80, 80,
+ -fill => 'red',
+ -tags => 'rectangle' );
+
+$dasm_frame->Button(
+ -text => 'Locate',
+ -command => sub {
+ $target_binary = $fs->Show( -popover => 'cursor', -create => 1 );
+ } )->pack( -side => 'left' );
+
+my $no_index_1_1 =
+ { 'map' => { ':key' => { name => \&string, list => { value => \&string } } }
+ };
+
+#6...........
+ },
+
+ 'dwic.def' => {
+ source => "dwic",
+ params => "def",
+ expect => <<'#7...........',
+ skip_symbols(
+ [
+ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ )
+ ],
+ );
+#7...........
+ },
+
+ 'dwic.dwic' => {
+ source => "dwic",
+ params => "dwic",
+ expect => <<'#8...........',
+ skip_symbols( [ qw(
+ Perl_dump_fds
+ Perl_ErrorNo
+ Perl_GetVars
+ PL_sys_intern
+ ) ] );
+#8...........
+ },
+ };
+
+ my $ntests = 0 + keys %{$rtests};
+ plan tests => $ntests;
+}
+
+###############
+# EXECUTE TESTS
+###############
+
+foreach my $key ( sort keys %{$rtests} ) {
+ my $output;
+ my $sname = $rtests->{$key}->{source};
+ my $expect = $rtests->{$key}->{expect};
+ my $pname = $rtests->{$key}->{params};
+ my $source = $rsources->{$sname};
+ my $params = defined($pname) ? $rparams->{$pname} : "";
+ my $stderr_string;
+ my $errorfile_string;
+ my $err = Perl::Tidy::perltidy(
+ source => \$source,
+ destination => \$output,
+ perltidyrc => \$params,
+ argv => '', # for safety; hide any ARGV from perltidy
+ stderr => \$stderr_string,
+ errorfile => \$errorfile_string, # not used when -se flag is set
+ );
+ if ( $err || $stderr_string || $errorfile_string ) {
+ print STDERR "Error output received for test '$key'\n";
+ if ($err) {
+ print STDERR "An error flag '$err' was returned\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ if ( !is( $output, $expect, $key ) ) {
+ my $leno = length($output);
+ my $lene = length($expect);
+ if ( $leno == $lene ) {
+ print STDERR
+"#> Test '$key' gave unexpected output. Strings differ but both have length $leno\n";
+ }
+ else {
+ print STDERR
+"#> Test '$key' gave unexpected output. String lengths differ: output=$leno, expected=$lene\n";
+ }
+ }
+ }
+}
projects / perltidy.git / commitdiff