From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Thu, 11 Jun 2020 13:44:45 +0000 (-0700)
Subject: allow Switch::Plain constructs within ternary stmts
X-Git-Tag: 20200619~7
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=078d9e2c6d0f69843fb7157e2c2414c1e627c718;p=perltidy.git
allow Switch::Plain constructs within ternary stmts
---
diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index cf7aa740..db8c81e5 100644
--- a/lib/Perl/Tidy/Tokenizer.pm
+++ b/lib/Perl/Tidy/Tokenizer.pm
@@ -1,4 +1,4 @@
-########################################################################
+#######################################################################
#
# the Perl::Tidy::Tokenizer package is essentially a filter which
# reads lines of perl source code from a source object and provides
@@ -1550,16 +1550,13 @@ sub prepare_for_a_new_file {
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.
+ # Note that the line 'default:' will be parsed as a label elsewhere.
+
if ( $statement_type eq 'case' || $statement_type eq 'default' ) {
# The type will be the same as a label
@@ -2187,7 +2184,7 @@ sub prepare_for_a_new_file {
}
# if an error would otherwise occur, check for extended syntax
- elsif ( !$current_depth[QUESTION_COLON]
+ elsif ( !is_balanced_closing_container(QUESTION_COLON)
&& $extended_syntax_type->() )
{
@@ -4980,6 +4977,27 @@ sub increase_nesting_depth {
return ( $seqno, $indent );
}
+sub is_balanced_closing_container {
+
+ # Return true if a closing container can go here without error
+ # Return false if not
+ my ($aa) = @_;
+
+ # cannot close if there was no opening
+ return unless ( $current_depth[$aa] > 0 );
+
+ # check that any other brace types $bb contained within would be balanced
+ for my $bb ( 0 .. @closing_brace_names - 1 ) {
+ next if ( $bb == $aa );
+ return
+ unless ( $depth_array[$aa][$bb][ $current_depth[$aa] ] ==
+ $current_depth[$bb] );
+ }
+
+ # OK, everything will be balanced
+ return 1;
+}
+
sub decrease_nesting_depth {
my ( $aa, $pos ) = @_;
diff --git a/t/snippets/expect/switch_plain.def b/t/snippets/expect/switch_plain.def
index 54bedb3f..65278a37 100644
--- a/t/snippets/expect/switch_plain.def
+++ b/t/snippets/expect/switch_plain.def
@@ -1,4 +1,4 @@
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -8,13 +8,17 @@ nswitch( 1 + $x * 2 ) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
diff --git a/t/snippets/expect/switch_plain.switch_plain b/t/snippets/expect/switch_plain.switch_plain
index 66d9cbf7..3e9a0cd2 100644
--- a/t/snippets/expect/switch_plain.switch_plain
+++ b/t/snippets/expect/switch_plain.switch_plain
@@ -1,4 +1,4 @@
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -8,13 +8,17 @@ nswitch( 1 + $x * 2 ) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index d0d040e9..d21f2552 100644
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -252,6 +252,8 @@
../snippets20.t hanging_side_comments3.def
../snippets20.t lop.def
../snippets21.t lop.lop
+../snippets21.t switch_plain.def
+../snippets21.t switch_plain.switch_plain
../snippets3.t ce_wn1.ce_wn
../snippets3.t ce_wn1.def
../snippets3.t colin.colin
@@ -392,5 +394,3 @@
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
-../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
index 58cae32a..ee14f834 100644
--- a/t/snippets/switch_plain.in
+++ b/t/snippets/switch_plain.in
@@ -1,4 +1,4 @@
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -8,13 +8,17 @@ nswitch (1 + $x * 2) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
- sswitch ($words[rand @words]) {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
+ sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
diff --git a/t/snippets21.t b/t/snippets21.t
index 42061dd4..2eff5aa9 100644
--- a/t/snippets21.t
+++ b/t/snippets21.t
@@ -52,7 +52,7 @@ lc( $self->mime_attr('content-type')
----------
'switch_plain' => <<'----------',
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -62,16 +62,20 @@ nswitch (1 + $x * 2) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
- sswitch ($words[rand @words]) {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
+ sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
----------
};
@@ -108,7 +112,7 @@ lc( $self->mime_attr('content-type')
source => "switch_plain",
params => "def",
expect => <<'#2...........',
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -118,16 +122,20 @@ nswitch( 1 + $x * 2 ) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
#2...........
},
@@ -135,7 +143,7 @@ $r = do {
source => "switch_plain",
params => "switch_plain",
expect => <<'#3...........',
-# must run with -nola to keep default from outdenting
+# run with -nola to keep default from outdenting
use Switch::Plain;
my $r = 'fail';
my $x = int rand 100_000;
@@ -145,16 +153,20 @@ nswitch( 1 + $x * 2 ) {
$r = 'ok';
}
}
-my @words = qw(speed me towards death);
-$r = do {
+
+my @words = qw(cinnamon ginger nutmeg cloves);
+my $test = 1;
+$r = $test
+ ? do {
sswitch( $words[ rand @words ] ) {
case $words[0]:
case $words[1]:
case $words[2]:
case $words[3]: { 'ok' }
- default: { 'wtf' }
+ default: { 'default case' }
}
-};
+ }
+ : 'not ok';
#3...........
},
};