From c6af812efab11781f97814ab2eb6d68c74447655 Mon Sep 17 00:00:00 2001 From: Steve Hancock Date: Wed, 10 Jun 2020 19:39:20 -0700 Subject: [PATCH] added support of Switch::Plain --- lib/Perl/Tidy/Tokenizer.pm | 55 +++++++++++-- t/snippets/expect/switch_plain.def | 20 +++++ t/snippets/expect/switch_plain.switch_plain | 20 +++++ t/snippets/packing_list.txt | 6 +- t/snippets/switch_plain.in | 20 +++++ t/snippets/switch_plain.par | 1 + t/snippets21.t | 85 ++++++++++++++++++++- 7 files changed, 197 insertions(+), 10 deletions(-) create mode 100644 t/snippets/expect/switch_plain.def create mode 100644 t/snippets/expect/switch_plain.switch_plain create mode 100644 t/snippets/switch_plain.in create mode 100644 t/snippets/switch_plain.par diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm index a132f82d..cf7aa740 100644 --- a/lib/Perl/Tidy/Tokenizer.pm +++ b/lib/Perl/Tidy/Tokenizer.pm @@ -1542,6 +1542,34 @@ sub prepare_for_a_new_file { qw(if elsif unless while until for foreach switch case given when catch); @is_blocktype_with_paren{@_} = (1) x scalar(@_); + my $extended_syntax_type = sub { + + # check for certain extended syntax variations, and + # - if found, set $type and return the $type + # - if not found, return undef if not found + return unless ( $tokenizer_self->{'_extended_syntax'} ); + + if ( $type eq ':' ) { + my ( $next_nonblank_token, $i_next ) = + find_next_nonblank_token( $i + 1, $rtokens, $max_token_index ); + + # Look for Switch::Plain syntax; some examples + # case 1: { + # default: { + # default: + # This should be enough to identify this syntax. If necessary, we + # could also look for and require 'use Switch::Plain', but then + # perltidy would fail if run on small snippets in an editor. + if ( $statement_type eq 'case' || $statement_type eq 'default' ) { + + # The type will be the same as a label + $type = 'J'; + return $type; + } + } + return; + }; + # ------------------------------------------------------------ # begin hash of code for handling most token types # ------------------------------------------------------------ @@ -2158,6 +2186,15 @@ sub prepare_for_a_new_file { $in_attribute_list = 1; } + # if an error would otherwise occur, check for extended syntax + elsif ( !$current_depth[QUESTION_COLON] + && $extended_syntax_type->() ) + { + + # it is a recognized extended syntax + # $type was set by $extended_syntax_type + } + # otherwise, it should be part of a ?/: operator else { ( $type_sequence, $indent_flag ) = @@ -3405,8 +3442,11 @@ EOM } # patch for SWITCH/CASE if 'case' and 'when are - # treated as keywords. - elsif ( $tok eq 'when' || $tok eq 'case' ) { + # treated as keywords. Also 'default' for Switch::Plain + elsif ($tok eq 'when' + || $tok eq 'case' + || $tok eq 'default' ) + { $statement_type = $tok; # next '{' is block } @@ -7556,11 +7596,12 @@ BEGIN { # These tokens may precede a code block # patched for SWITCH/CASE/CATCH. Actually these could be removed - # now and we could let the extended-syntax coding handle them + # now and we could let the extended-syntax coding handle them. + # Added 'default' for Switch::Plain. @q = qw( BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue if elsif else unless do while until eval for foreach map grep sort - switch case given when catch try finally); + switch case given when default catch try finally); @is_code_block_token{@q} = (1) x scalar(@q); # I'll build the list of keywords incrementally @@ -7785,6 +7826,7 @@ BEGIN { switch case + default given when err @@ -7795,9 +7837,8 @@ BEGIN { # patched above for SWITCH/CASE given/when err say # 'err' is a fairly safe addition. - # TODO: 'default' still needed if appropriate - # 'use feature' seen, but perltidy works ok without it. - # Concerned that 'default' could break code. + # Added 'default' for Switch::Plain. Note that we could also have + # a separate set of keywords to include if we see 'use Switch::Plain' push( @Keywords, @value_requestor ); # These are treated the same but are not keywords: diff --git a/t/snippets/expect/switch_plain.def b/t/snippets/expect/switch_plain.def new file mode 100644 index 00000000..54bedb3f --- /dev/null +++ b/t/snippets/expect/switch_plain.def @@ -0,0 +1,20 @@ +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch( 1 + $x * 2 ) { + case $x: { } + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch( $words[ rand @words ] ) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; diff --git a/t/snippets/expect/switch_plain.switch_plain b/t/snippets/expect/switch_plain.switch_plain new file mode 100644 index 00000000..66d9cbf7 --- /dev/null +++ b/t/snippets/expect/switch_plain.switch_plain @@ -0,0 +1,20 @@ +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch( 1 + $x * 2 ) { + case $x: { } + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch( $words[ rand @words ] ) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt index 41c88a8d..d0d040e9 100644 --- a/t/snippets/packing_list.txt +++ b/t/snippets/packing_list.txt @@ -250,6 +250,8 @@ ../snippets20.t kpitl.def ../snippets20.t kpitl.kpitl ../snippets20.t hanging_side_comments3.def +../snippets20.t lop.def +../snippets21.t lop.lop ../snippets3.t ce_wn1.ce_wn ../snippets3.t ce_wn1.def ../snippets3.t colin.colin @@ -390,5 +392,5 @@ ../snippets9.t rt98902.def ../snippets9.t rt98902.rt98902 ../snippets9.t rt99961.def -../snippets20.t lop.def -../snippets21.t lop.lop +../snippets21.t switch_plain.def +../snippets21.t switch_plain.switch_plain diff --git a/t/snippets/switch_plain.in b/t/snippets/switch_plain.in new file mode 100644 index 00000000..58cae32a --- /dev/null +++ b/t/snippets/switch_plain.in @@ -0,0 +1,20 @@ +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch (1 + $x * 2) { + case $x: {} + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch ($words[rand @words]) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; diff --git a/t/snippets/switch_plain.par b/t/snippets/switch_plain.par new file mode 100644 index 00000000..1b3093c1 --- /dev/null +++ b/t/snippets/switch_plain.par @@ -0,0 +1 @@ +-nola diff --git a/t/snippets21.t b/t/snippets21.t index 6edfb8d2..42061dd4 100644 --- a/t/snippets21.t +++ b/t/snippets21.t @@ -2,6 +2,8 @@ # Contents: #1 lop.lop +#2 switch_plain.def +#3 switch_plain.switch_plain # To locate test #13 you can search for its name or the string '#13' @@ -18,7 +20,11 @@ BEGIN { ########################################### # BEGIN SECTION 1: Parameter combinations # ########################################### - $rparams = { 'lop' => "-nlop", }; + $rparams = { + 'def' => "", + 'lop' => "-nlop", + 'switch_plain' => "-nola", + }; ############################ # BEGIN SECTION 2: Sources # @@ -43,6 +49,29 @@ $bits = lc( $self->mime_attr('content-type') || $self->{MIH_DefaultType} || 'text/plain' ); +---------- + + 'switch_plain' => <<'----------', +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch (1 + $x * 2) { + case $x: {} + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch ($words[rand @words]) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; ---------- }; @@ -74,6 +103,60 @@ lc( $self->mime_attr('content-type') || 'text/plain' ); #1........... }, + + 'switch_plain.def' => { + source => "switch_plain", + params => "def", + expect => <<'#2...........', +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch( 1 + $x * 2 ) { + case $x: { } + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch( $words[ rand @words ] ) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; +#2........... + }, + + 'switch_plain.switch_plain' => { + source => "switch_plain", + params => "switch_plain", + expect => <<'#3...........', +# must run with -nola to keep default from outdenting +use Switch::Plain; +my $r = 'fail'; +my $x = int rand 100_000; +nswitch( 1 + $x * 2 ) { + case $x: { } + default: { + $r = 'ok'; + } +} +my @words = qw(speed me towards death); +$r = do { + sswitch( $words[ rand @words ] ) { + case $words[0]: + case $words[1]: + case $words[2]: + case $words[3]: { 'ok' } + default: { 'wtf' } + } +}; +#3........... + }, }; my $ntests = 0 + keys %{$rtests}; -- 2.39.5