added support of Switch::Plain

diff --git a/lib/Perl/Tidy/Tokenizer.pm b/lib/Perl/Tidy/Tokenizer.pm
index a132f82dd984c402600f08adde01f91676bbc5b2..cf7aa7406515535836685a4d9b8c780573617ba1 100644 (file)
--- 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 (file)
index 0000000..54bedb3
--- /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 (file)
index 0000000..66d9cbf
--- /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 41c88a8d7b0606c6daec20f431052efaf9e7cb4a..d0d040e93f062f95712e7bb0243e594f13571377 100644 (file)
--- 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 (file)
index 0000000..58cae32
--- /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 (file)
index 0000000..1b3093c
--- /dev/null
+++ b/t/snippets/switch_plain.par
@@ -0,0 +1 @@
+-nola

diff --git a/t/snippets21.t b/t/snippets21.t
index 6edfb8d272199f70e28f611387149f21109ba755..42061dd40219fae82246c1c3cf4421fa0d52dd67 100644 (file)
--- 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};