From 74b7f2e2e8878427f9605f79f998fb82d1906ad4 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Fri, 11 Oct 2019 09:56:07 -0700 Subject: [PATCH] added -sub-alias-list and -space-prototype-paren --- CHANGES.md | 29 +++++++++ bin/perltidy | 29 +++++++++ docs/ChangeLog.html | 29 +++++++++ docs/Tidy.html | 2 +- docs/perltidy.html | 34 +++++++++- lib/Perl/Tidy.pm | 33 ++++++++++ lib/Perl/Tidy/Formatter.pm | 29 +++++++++ lib/Perl/Tidy/Tokenizer.pm | 51 ++++++++++++--- t/snippets/expect/git14.def | 5 ++ t/snippets/expect/sal.def | 11 ++++ t/snippets/expect/sal.sal | 11 ++++ t/snippets/expect/spp.def | 5 ++ t/snippets/expect/spp.spp0 | 5 ++ t/snippets/expect/spp.spp1 | 5 ++ t/snippets/expect/spp.spp2 | 5 ++ t/snippets/packing_list.txt | 7 +++ t/snippets/sal.in | 11 ++++ t/snippets/sal.par | 1 + t/snippets/spp.in | 5 ++ t/snippets/spp0.par | 1 + t/snippets/spp1.par | 1 + t/snippets/spp2.par | 1 + t/snippets15.t | 111 ++++++++++++++++++++++++++++++++ t/snippets16.t | 122 ++++++++++++++++++++++++++++++++++++ 24 files changed, 532 insertions(+), 11 deletions(-) create mode 100644 t/snippets/expect/git14.def create mode 100644 t/snippets/expect/sal.def create mode 100644 t/snippets/expect/sal.sal create mode 100644 t/snippets/expect/spp.def create mode 100644 t/snippets/expect/spp.spp0 create mode 100644 t/snippets/expect/spp.spp1 create mode 100644 t/snippets/expect/spp.spp2 create mode 100644 t/snippets/sal.in create mode 100644 t/snippets/sal.par create mode 100644 t/snippets/spp.in create mode 100644 t/snippets/spp0.par create mode 100644 t/snippets/spp1.par create mode 100644 t/snippets/spp2.par create mode 100644 t/snippets16.t diff --git a/CHANGES.md b/CHANGES.md index ead3f16d..90a02e4a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,35 @@ ## 2019 09 15.01 + - implement issue RT#130640: Allow different subroutine keywords. + Added a flag --sub-alias-list=s or -sal=s, where s is a string with + one or more aliases for 'sub', separated by spaces or commas. + For example, + + perltidy -sal='method fun' + + will cause the perltidy to treate the words 'method' and 'fun' to be + treated the same as if they were 'sub'. + + - Added flag --space-prototype-paren=i, or -spp=i, to control spacing + before the opening paren of a prototype, where i=0, 1, or 2: + i=0 no space + i=1 follow input [current and default] + i=2 always space + + Previously, perltidy always followed the input. + For example, given the following input + + sub usage(); + + The result will be: + sub usage(); # i=0 [no space] + sub usage(); # i=1 [default; follows input] + sub usage (); # i=2 [space] + + +## 2019 09 15 + - fixed issue RT#130344: false warning "operator in print statement" for "use lib". diff --git a/bin/perltidy b/bin/perltidy index 6ea4f6ba..34d3d32a 100755 --- a/bin/perltidy +++ b/bin/perltidy @@ -376,6 +376,16 @@ other words that the input code is 'untidy' according to the formatting parameters. If this is not the case, an error message noting this is produced. This flag has no other effect on the functioning of perltidy. +=item B<-sal=s>, B<--sub-alias-list=s> + +This flag causes one or more words to be treated the same as if they were the keyword 'sub'. The string B contains one or more alias words, separated by spaces or commas. + +For example, + + perltidy -sal='method fun _sub M4' + +will cause the perltidy to treate the words 'method', 'fun', '_sub' and 'M4' to be treated the same as if they were 'sub'. Note that if the alias words are separated by spaces then the string of words should be placed in quotes. + =back @@ -1070,6 +1080,25 @@ B<-sfp> or B<--space-function-paren> You will probably also want to use the flag B<-skp> (previous item) too. +=item B<-spp=n> or B<--space-prototype-paren=n> + +This flag can be used to control whether a function prototype is preceded by a space. For example, the following prototype does not have a space. + + sub usage(); + +This integer B may have the value 0, 1, or 2 as follows: + + -spp=0 means no space before the paren + -spp=1 means follow the example of the source code [DEFAULT] + -spp=2 means always put a space before the paren + +The default is B<-spp=1>, meaning that a space will be used if and only if there is one in the source code. Given the above line of code, the result of +applying the different options would be: + + sub usage(); # n=0 [no space] + sub usage(); # n=1 [default; follows input] + sub usage (); # n=2 [space] + =item Trimming whitespace around C quotes B<-tqw> or B<--trim-qw> provide the default behavior of trimming diff --git a/docs/ChangeLog.html b/docs/ChangeLog.html index a2a6434f..4ace19e7 100644 --- a/docs/ChangeLog.html +++ b/docs/ChangeLog.html @@ -1,5 +1,34 @@

Perltidy Change Log

+

2019 09 15.01

+ +
- implement issue RT#130640: Allow different subroutine keywords.
+  Added a flag --sub-alias-list=s or -sal=s, where s is a string with
+  one or more aliases for 'sub', separated by spaces or commas.  
+  For example,
+
+    perltidy -sal='method fun' 
+
+  will cause the perltidy to treate the words 'method' and 'fun' to be
+  treated the same as if they were 'sub'.
+
+- Added flag --space-prototype-paren=i, or -spp=i, to control spacing 
+  before the opening paren of a prototype, where i=0, 1, or 2:
+  i=0 no space
+  i=1 follow input [current and default]
+  i=2 always space
+
+  Previously, perltidy always followed the input.
+  For example, given the following input 
+
+     sub usage();
+
+  The result will be:
+    sub usage();    # i=0 [no space]
+    sub usage();    # i=1 [default; follows input]
+    sub usage ();   # i=2 [space]
+
+

2019 09 15

- fixed issue RT#130344: false warning "operator in print statement" 
diff --git a/docs/Tidy.html b/docs/Tidy.html
index d77229bc..3babc560 100644
--- a/docs/Tidy.html
+++ b/docs/Tidy.html
@@ -353,7 +353,7 @@
 
 

VERSION

-

This man page documents Perl::Tidy version 20190915

+

This man page documents Perl::Tidy version 20190915.01

LICENSE

diff --git a/docs/perltidy.html b/docs/perltidy.html index 070d8700..34da9faf 100644 --- a/docs/perltidy.html +++ b/docs/perltidy.html @@ -317,6 +317,18 @@

This flag asserts that the input and output code streams are different, or in other words that the input code is 'untidy' according to the formatting parameters. If this is not the case, an error message noting this is produced. This flag has no other effect on the functioning of perltidy.

+ +
-sal=s, --sub-alias-list=s
+
+ +

This flag causes one or more words to be treated the same as if they were the keyword 'sub'. The string s contains one or more alias words, separated by spaces or commas.

+ +

For example,

+ +
        perltidy -sal='method fun _sub M4' 
+ +

will cause the perltidy to treate the words 'method', 'fun', '_sub' and 'M4' to be treated the same as if they were 'sub'. Note that if the alias words are separated by spaces then the string of words should be placed in quotes.

+
@@ -846,6 +858,26 @@

You will probably also want to use the flag -skp (previous item) too.

+ +
-spp=n or --space-prototype-paren=n
+
+ +

This flag can be used to control whether a function prototype is preceded by a space. For example, the following prototype does not have a space.

+ +
      sub usage();
+ +

This integer n may have the value 0, 1, or 2 as follows:

+ +
    -spp=0 means no space before the paren
+    -spp=1 means follow the example of the source code [DEFAULT]
+    -spp=2 means always put a space before the paren
+ +

The default is -spp=1, meaning that a space will be used if and only if there is one in the source code. Given the above line of code, the result of applying the different options would be:

+ +
        sub usage();    # n=0 [no space]
+        sub usage();    # n=1 [default; follows input]
+        sub usage ();   # n=2 [space]
+
Trimming whitespace around qw quotes
@@ -2898,7 +2930,7 @@

VERSION

-

This man page documents perltidy version 20190915

+

This man page documents perltidy version 20190915.01

BUG REPORTS

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm index 1541ed27..825f3315 100644 --- a/lib/Perl/Tidy.pm +++ b/lib/Perl/Tidy.pm @@ -684,6 +684,7 @@ EOM } Perl::Tidy::Formatter::check_options($rOpts); + Perl::Tidy::Tokenizer::check_options($rOpts); if ( $rOpts->{'format'} eq 'html' ) { Perl::Tidy::HtmlWriter->check_options($rOpts); } @@ -1766,6 +1767,7 @@ sub generate_options { $add_option->( 'extended-syntax', 'xs', '!' ); $add_option->( 'assert-tidy', 'ast', '!' ); $add_option->( 'assert-untidy', 'asu', '!' ); + $add_option->( 'sub-alias-list', 'sal', '=s' ); ######################################## $category = 2; # Code indentation control @@ -1810,6 +1812,7 @@ sub generate_options { $add_option->( 'trim-pod', 'trp', '!' ); $add_option->( 'want-left-space', 'wls', '=s' ); $add_option->( 'want-right-space', 'wrs', '=s' ); + $add_option->( 'space-prototype-paren', 'spp', '=i' ); ######################################## $category = 4; # Comment controls @@ -2028,6 +2031,8 @@ sub generate_options { 'keyword-group-blanks-before' => [ 0, 2 ], 'keyword-group-blanks-after' => [ 0, 2 ], + + 'space-prototype-paren' => [ 0, 2 ], ); # Note: we could actually allow negative ci if someone really wants it: @@ -2116,6 +2121,7 @@ sub generate_options { short-concatenation-item-length=8 space-for-semicolon space-backslash-quote=1 + space-prototype-paren=1 square-bracket-tightness=1 square-bracket-vertical-tightness-closing=0 square-bracket-vertical-tightness=0 @@ -2841,6 +2847,33 @@ EOM $rOpts->{'default-tabsize'} = 8; } + # Check and clean up any sub-alias-list + if ( $rOpts->{'sub-alias-list'} ) { + my $sub_alias_string = $rOpts->{'sub-alias-list'}; + $sub_alias_string =~ s/,/ /g; # allow commas + $sub_alias_string =~ s/^\s+//; + $sub_alias_string =~ s/\s+$//; + my @sub_alias_list = split /\s+/, $sub_alias_string; + my @filtered_word_list = ('sub'); + my %seen; + + # include 'sub' for later convenience + $seen{sub}++; + foreach my $word (@sub_alias_list) { + if ($word) { + if ( $word !~ /^\w[\w\d]*$/ ) { + Warn("unexpected sub alias '$word' - ignoring\n"); + } + if ( !$seen{$word} ) { + $seen{$word}++; + push @filtered_word_list, $word; + } + } + } + my $joined_words = join ' ', @filtered_word_list; + $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list; + } + # Define $tabsize, the number of spaces per tab for use in # guessing the indentation of source lines with leading tabs. # Assume same as for this run if tabs are used , otherwise assume diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm index ca506792..ae189bca 100644 --- a/lib/Perl/Tidy/Formatter.pm +++ b/lib/Perl/Tidy/Formatter.pm @@ -2937,6 +2937,17 @@ sub respace_tokens { } if ( $token =~ /$SUB_PATTERN/ ) { + + # -spp = 0 : no space before opening prototype paren + # -spp = 1 : stable (follow input spacing) + # -spp = 2 : always space before opening prototype paren + my $spp = $rOpts->{'space-prototype-paren'}; + if ( defined($spp) ) { + if ( $spp == 0 ) { $token =~ s/\s+\(/\(/; } + elsif ( $spp == 2 ) { $token =~ s/\(/ (/; } + } + + # one space max, and no tabs $token =~ s/\s+/ /g; $rtoken_vars->[_TOKEN_] = $token; } @@ -5380,6 +5391,7 @@ sub check_options { } } + make_sub_matching_pattern(); make_bli_pattern(); make_block_brace_vertical_tightness_pattern(); make_blank_line_pattern(); @@ -6038,6 +6050,23 @@ sub make_closing_side_comment_list_pattern { return; } +sub make_sub_matching_pattern { + + $SUB_PATTERN = '^sub\s+(::|\w)'; + $ASUB_PATTERN = '^sub$'; + + if ( $rOpts->{'sub-alias-list'} ) { + + # Note that any 'sub-alias-list' has been preprocessed to + # be a trimmed, space-separated list which includes 'sub' + # for example, it might be 'sub method fun' + my $sub_alias_list = $rOpts->{'sub-alias-list'}; + $sub_alias_list =~ s/\s+/\|/g; + $SUB_PATTERN =~ s/sub/\($sub_alias_list\)/; + $ASUB_PATTERN =~ s/sub/\($sub_alias_list\)/; + } +} + sub make_bli_pattern { if ( defined( $rOpts->{'brace-left-and-indent-list'} ) diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index 0029370d..d537b9c6 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -114,6 +114,8 @@ use vars qw{ %is_keyword_taking_list %is_keyword_taking_optional_args %is_q_qq_qw_qx_qr_s_y_tr_m + %is_sub + %is_package }; # possible values of operator_expected() @@ -144,6 +146,28 @@ sub DESTROY { return; } +sub check_options { + + # Check Tokenizer parameters + my $rOpts = shift; + + %is_sub = ( ); + $is_sub{'sub'} = 1; + + # Install any aliases to 'sub' + if ( $rOpts->{'sub-alias-list'} ) { + + # Note that any 'sub-alias-list' has been preprocessed to + # be a trimmed, space-separated list which includes 'sub' + # for example, it might be 'sub method fun' + my @sub_alias_list = split /\s+/, $rOpts->{'sub-alias-list'}; + foreach my $word (@sub_alias_list) { + $is_sub{$word} = 1; + } + } + return; +} + sub new { my ( $class, @args ) = @_; @@ -2441,10 +2465,6 @@ sub prepare_for_a_new_file { @_ = qw(use require); @is_use_require{@_} = (1) x scalar(@_); - my %is_sub_package; - @_ = qw(sub package); - @is_sub_package{@_} = (1) x scalar(@_); - # This hash holds the hash key in $tokenizer_self for these keywords: my %is_format_END_DATA = ( 'format' => '_in_format', @@ -2860,7 +2880,7 @@ EOM # but do not start on blanks and comments if ( $id_scan_state && $pre_type !~ /[b#]/ ) { - if ( $id_scan_state =~ /^(sub|package)/ ) { + if ( $is_sub{$id_scan_state} || $is_package{$id_scan_state} ) { scan_id(); } else { @@ -3236,7 +3256,7 @@ EOM } # 'sub' || 'package' - elsif ( $is_sub_package{$tok_kw} ) { + elsif ( $is_sub{$tok_kw} || $is_package{$tok_kw} ) { error_if_expecting_OPERATOR() if ( $expecting == OPERATOR ); scan_id(); @@ -3709,7 +3729,7 @@ EOM if ( $type eq ';' && $tok =~ /\w/ ) { $fix_type = 'k' } # output anonymous 'sub' as keyword - if ( $type eq 't' && $tok eq 'sub' ) { $fix_type = 'k' } + if ( $type eq 't' && $is_sub{$tok} ) { $fix_type = 'k' } # ----------------------------------------------------------------- @@ -4524,6 +4544,13 @@ sub code_block_type { return $last_nonblank_token; } + # or a sub alias + elsif (( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' ) + && ( $is_sub{$last_nonblank_token} ) ) + { + return 'sub'; + } + elsif ( $statement_type =~ /^(sub|package)\b/ ) { return $statement_type; } @@ -5531,7 +5558,7 @@ sub scan_id_do { # handle non-blank line; identifier, if any, must follow unless ($blank_line) { - if ( $id_scan_state eq 'sub' ) { + if ( $is_sub{$id_scan_state} ) { ( $i, $tok, $type, $id_scan_state ) = do_scan_sub( $input_line, $i, $i_beg, $tok, $type, $rtokens, @@ -5539,7 +5566,7 @@ sub scan_id_do { ); } - elsif ( $id_scan_state eq 'package' ) { + elsif ( $is_package{$id_scan_state} ) { ( $i, $tok, $type ) = do_scan_package( $input_line, $i, $i_beg, $tok, $type, $rtokens, $rtoken_map, $max_token_index ); @@ -7763,6 +7790,12 @@ BEGIN { @q = qw(q qq qw qx qr s y tr m); @is_q_qq_qw_qx_qr_s_y_tr_m{@q} = (1) x scalar(@q); + @q = qw(sub); + @is_sub{@q} = (1) x scalar(@q); + + @q = qw(package); + @is_package{@q} = (1) x scalar(@q); + # These keywords are handled specially in the tokenizer code: my @special_keywords = qw( do diff --git a/t/snippets/expect/git14.def b/t/snippets/expect/git14.def new file mode 100644 index 00000000..08b0c1ea --- /dev/null +++ b/t/snippets/expect/git14.def @@ -0,0 +1,5 @@ +# git#14; do not break at trailing 'or' +$second = { + key1 => 'aaa', + key2 => 'bbb', +} if $flag1 or $flag2; diff --git a/t/snippets/expect/sal.def b/t/snippets/expect/sal.def new file mode 100644 index 00000000..f7584da2 --- /dev/null +++ b/t/snippets/expect/sal.def @@ -0,0 +1,11 @@ +sub get_val () { + +} + +method get_value() { + +} + +fun get_other_value() { + +} diff --git a/t/snippets/expect/sal.sal b/t/snippets/expect/sal.sal new file mode 100644 index 00000000..fbd4ee02 --- /dev/null +++ b/t/snippets/expect/sal.sal @@ -0,0 +1,11 @@ +sub get_val () { + +} + +method get_value () { + +} + +fun get_other_value () { + +} diff --git a/t/snippets/expect/spp.def b/t/snippets/expect/spp.def new file mode 100644 index 00000000..4b8e38c6 --- /dev/null +++ b/t/snippets/expect/spp.def @@ -0,0 +1,5 @@ +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } diff --git a/t/snippets/expect/spp.spp0 b/t/snippets/expect/spp.spp0 new file mode 100644 index 00000000..f663642f --- /dev/null +++ b/t/snippets/expect/spp.spp0 @@ -0,0 +1,5 @@ +sub get_val() { } + +sub get_Val() { } + +sub Get_val() { } diff --git a/t/snippets/expect/spp.spp1 b/t/snippets/expect/spp.spp1 new file mode 100644 index 00000000..4b8e38c6 --- /dev/null +++ b/t/snippets/expect/spp.spp1 @@ -0,0 +1,5 @@ +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } diff --git a/t/snippets/expect/spp.spp2 b/t/snippets/expect/spp.spp2 new file mode 100644 index 00000000..7cd649c9 --- /dev/null +++ b/t/snippets/expect/spp.spp2 @@ -0,0 +1,5 @@ +sub get_val () { } + +sub get_Val () { } + +sub Get_val () { } diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 1cac8692..26655c92 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -291,3 +291,10 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def +../snippets15.t git14.def +../snippets15.t sal.def +../snippets15.t sal.sal +../snippets15.t spp.def +../snippets15.t spp.spp0 +../snippets16.t spp.spp1 +../snippets16.t spp.spp2 diff --git a/t/snippets/sal.in b/t/snippets/sal.in new file mode 100644 index 00000000..fbd4ee02 --- /dev/null +++ b/t/snippets/sal.in @@ -0,0 +1,11 @@ +sub get_val () { + +} + +method get_value () { + +} + +fun get_other_value () { + +} diff --git a/t/snippets/sal.par b/t/snippets/sal.par new file mode 100644 index 00000000..136acbc5 --- /dev/null +++ b/t/snippets/sal.par @@ -0,0 +1 @@ +-sal='method fun' diff --git a/t/snippets/spp.in b/t/snippets/spp.in new file mode 100644 index 00000000..f54bbe8a --- /dev/null +++ b/t/snippets/spp.in @@ -0,0 +1,5 @@ +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } diff --git a/t/snippets/spp0.par b/t/snippets/spp0.par new file mode 100644 index 00000000..f7ab11fd --- /dev/null +++ b/t/snippets/spp0.par @@ -0,0 +1 @@ +-spp=0 diff --git a/t/snippets/spp1.par b/t/snippets/spp1.par new file mode 100644 index 00000000..a8f427c3 --- /dev/null +++ b/t/snippets/spp1.par @@ -0,0 +1 @@ +-spp=1 diff --git a/t/snippets/spp2.par b/t/snippets/spp2.par new file mode 100644 index 00000000..fd1b795d --- /dev/null +++ b/t/snippets/spp2.par @@ -0,0 +1 @@ +-spp=2 diff --git a/t/snippets15.t b/t/snippets15.t index 7998152d..affba1b7 100644 --- a/t/snippets15.t +++ b/t/snippets15.t @@ -15,6 +15,11 @@ #12 align30.def #13 git09.def #14 git09.git09 +#15 git14.def +#16 sal.def +#17 sal.sal +#18 spp.def +#19 spp.spp0 # To locate test #13 you can search for its name or the string '#13' @@ -39,6 +44,10 @@ BEGIN { 'gnu' => "-gnu", 'olbs0' => "-olbs=0", 'olbs2' => "-olbs=2", + 'sal' => <<'----------', +-sal='method fun' +---------- + 'spp0' => "-spp=0", }; ############################ @@ -113,6 +122,14 @@ my $q = $rs } map { [$_, length($_)] } @unsorted; +---------- + + 'git14' => <<'----------', +# git#14; do not break at trailing 'or' +$second = { + key1 => 'aaa', + key2 => 'bbb', +} if $flag1 or $flag2; ---------- 'gnu5' => <<'----------', @@ -132,6 +149,28 @@ if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked" } for $x ( 1, 2 ) { s/(.*)/+$1/; } for $x ( 1, 2 ) { s/(.*)/+$1/; } # side comment if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; } +---------- + + 'sal' => <<'----------', +sub get_val () { + +} + +method get_value () { + +} + +fun get_other_value () { + +} +---------- + + 'spp' => <<'----------', +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } ---------- 'wngnu1' => <<'----------', @@ -373,6 +412,78 @@ elsif ( $i > $depth ) { $_ = 0; } } @unsorted; #14........... }, + + 'git14.def' => { + source => "git14", + params => "def", + expect => <<'#15...........', +# git#14; do not break at trailing 'or' +$second = { + key1 => 'aaa', + key2 => 'bbb', +} if $flag1 or $flag2; +#15........... + }, + + 'sal.def' => { + source => "sal", + params => "def", + expect => <<'#16...........', +sub get_val () { + +} + +method get_value() { + +} + +fun get_other_value() { + +} +#16........... + }, + + 'sal.sal' => { + source => "sal", + params => "sal", + expect => <<'#17...........', +sub get_val () { + +} + +method get_value () { + +} + +fun get_other_value () { + +} +#17........... + }, + + 'spp.def' => { + source => "spp", + params => "def", + expect => <<'#18...........', +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } +#18........... + }, + + 'spp.spp0' => { + source => "spp", + params => "spp0", + expect => <<'#19...........', +sub get_val() { } + +sub get_Val() { } + +sub Get_val() { } +#19........... + }, }; my $ntests = 0 + keys %{$rtests}; diff --git a/t/snippets16.t b/t/snippets16.t new file mode 100644 index 00000000..09941562 --- /dev/null +++ b/t/snippets16.t @@ -0,0 +1,122 @@ +# Created with: ./make_t.pl + +# Contents: +#1 spp.spp1 +#2 spp.spp2 + +# To locate test #13 you can search for its name or the string '#13' + +use strict; +use Test; +use Carp; +use Perl::Tidy; +my $rparams; +my $rsources; +my $rtests; + +BEGIN { + + ########################################### + # BEGIN SECTION 1: Parameter combinations # + ########################################### + $rparams = { + 'spp1' => "-spp=1", + 'spp2' => "-spp=2", + }; + + ############################ + # BEGIN SECTION 2: Sources # + ############################ + $rsources = { + + 'spp' => <<'----------', +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } +---------- + }; + + #################################### + # BEGIN SECTION 3: Expected output # + #################################### + $rtests = { + + 'spp.spp1' => { + source => "spp", + params => "spp1", + expect => <<'#1...........', +sub get_val() { } + +sub get_Val () { } + +sub Get_val () { } +#1........... + }, + + 'spp.spp2' => { + source => "spp", + params => "spp2", + expect => <<'#2...........', +sub get_val () { } + +sub get_Val () { } + +sub Get_val () { } +#2........... + }, + }; + + 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 ) { + if ($err) { + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$err ); + } + if ($stderr_string) { + print STDERR "---------------------\n"; + print STDERR "<>\n$stderr_string\n"; + print STDERR "---------------------\n"; + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$stderr_string ); + } + if ($errorfile_string) { + print STDERR "---------------------\n"; + print STDERR "<<.ERR file>>\n$errorfile_string\n"; + print STDERR "---------------------\n"; + print STDERR +"This error received calling Perl::Tidy with '$sname' + '$pname'\n"; + ok( !$errorfile_string ); + } + } + else { + ok( $output, $expect ); + } +} -- 2.39.5