add --weld-fat-comma for issue git #108

diff --git a/CHANGES.md b/CHANGES.md
index e444ac10b8e1f04816ba7f95d798ae7e0ed10221..283d18b392c7db98d4790da6f3ed782c708873b3 100644 (file)
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,27 @@
 
 ## 2022 06 13.04
 
+    - Add option --weld-fat-comma (-wfc) for issue git #108. When -wfc
+      is set, along with -wn, perltidy is allowed to weld an opening paren
+      to an inner opening container when they are separated by a hash key
+      and fat comma (=>).  For example:
+
+        # perltidy -wn
+        elf->call_method(
+            method_name_foo => {
+                some_arg1       => $foo,
+                some_other_arg3 => $bar->{'baz'},
+            }
+        );
+
+        # perltidy -wn -wfc
+        elf->call_method( method_name_foo => {
+            some_arg1       => $foo,
+            some_other_arg3 => $bar->{'baz'},
+        } );
+
+     This flag is off by default.
+
     - Fix issue git #106. This fixes some edge cases of formatting with the
       combination -xlp -pt=2, mainly for two-line lists with short function
       names. One indentation space is removed to improve alignment:

diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 99e8d3791b507993f89004f0247654093813820b..5ca7c884ab3bc2b5e59a2616edb34af377df0aa8 100644 (file)
--- a/lib/Perl/Tidy.pm
+++ b/lib/Perl/Tidy.pm
@@ -3247,6 +3247,7 @@ sub generate_options {
     $add_option->( 'paren-vertical-tightness-closing',        'pvtc',  '=i' );
     $add_option->( 'weld-nested-containers',                  'wn',    '!' );
     $add_option->( 'weld-nested-exclusion-list',              'wnxl',  '=s' );
+    $add_option->( 'weld-fat-comma',                          'wfc',   '!' );
     $add_option->( 'space-backslash-quote',                   'sbq',   '=i' );
     $add_option->( 'stack-closing-block-brace',               'scbb',  '!' );
     $add_option->( 'stack-closing-hash-brace',                'schb',  '!' );

diff --git a/lib/Perl/Tidy/Formatter.pm b/lib/Perl/Tidy/Formatter.pm
index 1e626318955ef52e5c14d28b55caf6237a6bc39f..453b9cadc918bcf0dad002cd44f8e53c74d28b64 100644 (file)
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -319,6 +319,7 @@ my (
     %stack_closing_token,
 
     %weld_nested_exclusion_rules,
+    %weld_fat_comma_rules,
     %line_up_parentheses_control_hash,
     $line_up_parentheses_control_is_lxpl,
 
@@ -1990,6 +1991,7 @@ EOM
     }
 
     initialize_weld_nested_exclusion_rules();
+    initialize_weld_fat_comma_rules();
 
     %line_up_parentheses_control_hash    = ();
     $line_up_parentheses_control_is_lxpl = 1;
@@ -2203,6 +2205,27 @@ EOM
     return;
 } ## end sub initialize_weld_nested_exclusion_rules
 
+sub initialize_weld_fat_comma_rules {
+
+    # Initialize a hash controlling which opening token types can be
+    # welded around a fat comma
+    %weld_fat_comma_rules = ();
+
+    # The -wfc flag turns on welding of '=>' after an opening paren
+    if ( $rOpts->{'weld-fat-comma'} ) { $weld_fat_comma_rules{'('} = 1 }
+
+    # This could be generalized in the future by introducing a parameter
+    # -weld-fat-comma-after=str (-wfca=str), where str contains any of:
+    #    * { [ (
+    # to indicate which opening parens may weld to a subsequent '=>'
+
+    # The flag -wfc would then be equivalent to -wfca='('
+
+    # This has not been done because it is not yet clear how useful
+    # this generalization would be.
+    return;
+} ## end sub initialize_weld_fat_comma_rules
+
 sub initialize_line_up_parentheses_control_hash {
     my ( $str, $opt_name ) = @_;
     return unless ($str);
@@ -8513,6 +8536,12 @@ sub find_nested_pairs {
         my $token_outer_closing = $rLL->[$K_outer_closing]->[_TOKEN_];
         next unless ( $is_closing_token{$token_outer_closing} );
 
+        # Simple filter: No commas or semicolons in the outer container
+        my $rtype_count = $self->[_rtype_count_by_seqno_]->{$outer_seqno};
+        if ($rtype_count) {
+            next if ( $rtype_count->{','} || $rtype_count->{';'} );
+        }
+
         # Now we have to check the opening tokens.
         my $K_outer_opening = $K_opening_container->{$outer_seqno};
         my $K_inner_opening = $K_opening_container->{$inner_seqno};
@@ -8580,7 +8609,9 @@ sub find_nested_pairs {
         # They can be separated by a small amount.
         my $K_diff = $K_inner_opening - $K_outer_opening;
 
-        # Count nonblank characters separating them.
+        # Count the number of nonblank characters separating them.
+        # Note: the $nonblank_count includes the inner opening container
+        # but not the outer opening container, so it will be >= 1.
         if ( $K_diff < 0 ) { next }    # Shouldn't happen
         my $nonblank_count = 0;
         my $type;
@@ -8594,6 +8625,7 @@ sub find_nested_pairs {
         my $Kn_first = $K_outer_opening;
         my $Kn_last_nonblank;
         my $saw_comment;
+
         foreach my $Kn ( $K_outer_opening + 1 .. $K_inner_opening ) {
             next if ( $rLL->[$Kn]->[_TYPE_] eq 'b' );
             if ( !$nonblank_count )        { $Kn_first = $Kn }
@@ -8608,6 +8640,9 @@ sub find_nested_pairs {
             $is_name = $is_name_type->{$type};
             next if ( $is_name && $last_is_name );
 
+            # do not count a possible leading - of bareword hash key
+            next if ( $type eq 'm' && !$last_type );
+
             $nonblank_count++;
             last if ( $nonblank_count > 2 );
         }
@@ -8627,16 +8662,14 @@ sub find_nested_pairs {
             if ( $is_sort_map_grep{$token} ) { $nonblank_count = 10 }
         }
 
+        my $token_oo = $rLL->[$K_outer_opening]->[_TOKEN_];
+
         if (
 
-            # adjacent opening containers, like: do {{
+            # 1: adjacent opening containers, like: do {{
             $nonblank_count == 1
 
-            # short item following opening paren, like:  fun( yyy (
-            || (   $nonblank_count == 2
-                && $rLL->[$K_outer_opening]->[_TOKEN_] eq '(' )
-
-            # anonymous sub + prototype or sig:  )->then( sub ($code) {
+            # 2. anonymous sub + prototype or sig:  )->then( sub ($code) {
             # ... but it seems best not to stack two structural blocks, like
             # this
             #    sub make_anon_with_my_sub { sub {
@@ -8645,6 +8678,16 @@ sub find_nested_pairs {
                 && $inner_blocktype eq 'sub'
                 && $rLL->[$Kn_first]->[_TOKEN_] eq 'sub'
                 && !$outer_blocktype )
+
+            # 3. short item following opening paren, like:  fun( yyy (
+            || $nonblank_count == 2 && $token_oo eq '('
+
+            # 4. weld around fat commas, if requested (git #108), such as
+            #     elf->call_method( method_name_foo => {
+            || (   $type eq '=>'
+                && $nonblank_count <= 3
+                && %weld_fat_comma_rules
+                && $weld_fat_comma_rules{$token_oo} )
           )
         {
             push @nested_pairs,

diff --git a/t/snippets/expect/git108.def b/t/snippets/expect/git108.def
new file mode 100644 (file)
index 0000000..15fa4d9
--- /dev/null
+++ b/t/snippets/expect/git108.def
@@ -0,0 +1,18 @@
+elf->call_method(
+    method_name_foo => {
+        some_arg1       => $foo,
+        some_other_arg3 => $bar->{'baz'},
+    }
+);
+
+# leading dash
+my $species = new Bio::Species(
+    -classification => [
+        qw(
+          sapiens Homo Hominidae
+          Catarrhini Primates Eutheria
+          Mammalia Vertebrata
+          Chordata Metazoa Eukaryota
+        )
+    ]
+);

diff --git a/t/snippets/expect/git108.git108 b/t/snippets/expect/git108.git108
new file mode 100644 (file)
index 0000000..912527e
--- /dev/null
+++ b/t/snippets/expect/git108.git108
@@ -0,0 +1,12 @@
+elf->call_method( method_name_foo => {
+    some_arg1       => $foo,
+    some_other_arg3 => $bar->{'baz'},
+} );
+
+# leading dash
+my $species = new Bio::Species( -classification => [ qw(
+    sapiens Homo Hominidae
+    Catarrhini Primates Eutheria
+    Mammalia Vertebrata
+    Chordata Metazoa Eukaryota
+) ] );

diff --git a/t/snippets/git108.in b/t/snippets/git108.in
new file mode 100644 (file)
index 0000000..15fa4d9
--- /dev/null
+++ b/t/snippets/git108.in
@@ -0,0 +1,18 @@
+elf->call_method(
+    method_name_foo => {
+        some_arg1       => $foo,
+        some_other_arg3 => $bar->{'baz'},
+    }
+);
+
+# leading dash
+my $species = new Bio::Species(
+    -classification => [
+        qw(
+          sapiens Homo Hominidae
+          Catarrhini Primates Eutheria
+          Mammalia Vertebrata
+          Chordata Metazoa Eukaryota
+        )
+    ]
+);

diff --git a/t/snippets/git108.par b/t/snippets/git108.par
new file mode 100644 (file)
index 0000000..bc8f4e3
--- /dev/null
+++ b/t/snippets/git108.par
@@ -0,0 +1 @@
+-wn -wfc

diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index d8e9f78f4bed0630117a9b69709ff7e072e7fb3a..ec2db72a97442c20a6895ec8205e04c26b06d1ff 100644 (file)
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -361,6 +361,7 @@
 ../snippets26.t        git106.git106
 ../snippets26.t        c154.def
 ../snippets26.t        code_skipping.code_skipping
+../snippets26.t        c158.def
 ../snippets3.t ce_wn1.ce_wn
 ../snippets3.t ce_wn1.def
 ../snippets3.t colin.colin
@@ -501,4 +502,5 @@
 ../snippets9.t rt98902.def
 ../snippets9.t rt98902.rt98902
 ../snippets9.t rt99961.def
-../snippets26.t        c158.def
+../snippets26.t        git108.def
+../snippets26.t        git108.git108

diff --git a/t/snippets26.t b/t/snippets26.t
index 3e466a6d817a398960f56cdc5e118e268abb2fc9..f197dfea0c0fb705373790ace50c4c6089ff6266 100644 (file)
--- a/t/snippets26.t
+++ b/t/snippets26.t
@@ -17,6 +17,8 @@
 #14 c154.def
 #15 code_skipping.code_skipping
 #16 c158.def
+#17 git108.def
+#18 git108.git108
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -45,6 +47,7 @@ BEGIN {
         'def'    => "",
         'drc'    => "-drc",
         'git106' => "-xlp -gnu -xci",
+        'git108' => "-wn -wfc",
         'git93'  => <<'----------',
 -vxl='q'
 ----------
@@ -242,6 +245,27 @@ abcdefghijklmnopq
         }
     }
 }
+----------
+
+        'git108' => <<'----------',
+elf->call_method(
+    method_name_foo => {
+        some_arg1       => $foo,
+        some_other_arg3 => $bar->{'baz'},
+    }
+);
+
+# leading dash
+my $species = new Bio::Species(
+    -classification => [
+        qw(
+          sapiens Homo Hominidae
+          Catarrhini Primates Eutheria
+          Mammalia Vertebrata
+          Chordata Metazoa Eukaryota
+        )
+    ]
+);
 ----------
 
         'git93' => <<'----------',
@@ -771,6 +795,50 @@ my ($curr) = current();
 err(@_);
 #16...........
         },
+
+        'git108.def' => {
+            source => "git108",
+            params => "def",
+            expect => <<'#17...........',
+elf->call_method(
+    method_name_foo => {
+        some_arg1       => $foo,
+        some_other_arg3 => $bar->{'baz'},
+    }
+);
+
+# leading dash
+my $species = new Bio::Species(
+    -classification => [
+        qw(
+          sapiens Homo Hominidae
+          Catarrhini Primates Eutheria
+          Mammalia Vertebrata
+          Chordata Metazoa Eukaryota
+        )
+    ]
+);
+#17...........
+        },
+
+        'git108.git108' => {
+            source => "git108",
+            params => "git108",
+            expect => <<'#18...........',
+elf->call_method( method_name_foo => {
+    some_arg1       => $foo,
+    some_other_arg3 => $bar->{'baz'},
+} );
+
+# leading dash
+my $species = new Bio::Species( -classification => [ qw(
+    sapiens Homo Hominidae
+    Catarrhini Primates Eutheria
+    Mammalia Vertebrata
+    Chordata Metazoa Eukaryota
+) ] );
+#18...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};