From 2e642d21565bbbef2a6e9d321c3e71e7d7d5e4cf Mon Sep 17 00:00:00 2001
From: Steve Hancock <perltidy@users.sourceforge.net>
Date: Wed, 11 Nov 2020 19:04:10 -0800
Subject: [PATCH] added -wnxl=s for control of -wn

---
 CHANGES.md                   |   5 +
 bin/perltidy                 |  41 ++++++
 docs/ChangeLog.html          |   7 +-
 docs/perltidy.html           |  30 +++-
 lib/Perl/Tidy.pm             |   1 +
 lib/Perl/Tidy/Formatter.pm   | 171 +++++++++++++++++++++--
 t/snippets/expect/wnxl.def   |  38 ++++++
 t/snippets/expect/wnxl.wnxl1 |  36 +++++
 t/snippets/expect/wnxl.wnxl2 |  28 ++++
 t/snippets/expect/wnxl.wnxl3 |  30 ++++
 t/snippets/expect/wnxl.wnxl4 |  34 +++++
 t/snippets/packing_list.txt  |  27 ++--
 t/snippets/wnxl.in           |  30 ++++
 t/snippets/wnxl1.par         |   2 +
 t/snippets/wnxl2.par         |   2 +
 t/snippets/wnxl3.par         |   3 +
 t/snippets/wnxl4.par         |   2 +
 t/snippets23.t               | 256 +++++++++++++++++++++++++++++++++++
 18 files changed, 722 insertions(+), 21 deletions(-)
 create mode 100644 t/snippets/expect/wnxl.def
 create mode 100644 t/snippets/expect/wnxl.wnxl1
 create mode 100644 t/snippets/expect/wnxl.wnxl2
 create mode 100644 t/snippets/expect/wnxl.wnxl3
 create mode 100644 t/snippets/expect/wnxl.wnxl4
 create mode 100644 t/snippets/wnxl.in
 create mode 100644 t/snippets/wnxl1.par
 create mode 100644 t/snippets/wnxl2.par
 create mode 100644 t/snippets/wnxl3.par
 create mode 100644 t/snippets/wnxl4.par

diff --git a/CHANGES.md b/CHANGES.md
index 8caa3df8..cb346716 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -2,6 +2,11 @@
 
 ## 2020 10 01.03
 
+    - Added flag -wnxl=s, --weld-nested-exclusion-list=s, to provide control which containers
+      are welded with the --weld-nested-containers parameter.  This is related to issue git #45.
+
+    - Merged pull request git #46 which fixes the docs regarding the -fse flag.
+
     - This release is being made to make available a number of new formatting 
       parameters. No significant bugs have been found since the previous release, 
       but several minor issues have been found and fixed as listed below.
diff --git a/bin/perltidy b/bin/perltidy
index dda84aa6..a5ba84f9 100755
--- a/bin/perltidy
+++ b/bin/perltidy
@@ -2442,6 +2442,47 @@ specially in perltidy.
 Finally, the stacking of containers defined by this flag have priority over
 any other container stacking flags.  This is because any welding is done first.
 
+=item B<-wnxl=s>,  B<--weld-nested-exclusion-list> 
+
+The B<-wnxl=s> flag provides some control over the types of containers which
+can be welded.  It does this by supplying a string B<s> which is a list of
+things which should B<not> be welded.  This list is a string with spaces
+separating any number of items.  Each item consists of up to three pieces of
+information: (1) an optional positiion, (2) an optional preceding type, and (3)
+a container type.
+
+The container type is required and is one of '(', '[', '{' or 'q'.  The first three of
+these are container tokens and the last represents a quoted list.  So for example the string
+
+  -wnxl='[ { q'
+
+means do not include square-bracets, braces, or quotes in any welds. In other words, welds
+will only involve parens.
+
+Any of these container types may be prefixed with a position indicator which is either '^'
+(to indicate the start of a welded sequence) or '.' (to indicate the interior of a welded sequence).
+
+For example,
+
+  -wnxl='.{'
+
+would mean to exclude all braces which do not start a welded sequence.  Note that
+quotes always come last in a weld so a position indicator is not useful for them
+and is ignored if given.
+
+A third item of information which must go between these first two is an alphanumeric
+letter which limits the selection depending on the type of token immediately before the 
+container. There are, at present, just two possible letters: 'k' matches the previous
+token if it is any keyword, and 'K' matches the previous token if it is not be a keyword.
+
+For example,
+
+  -wnxl = '{ [ ^K('
+
+means the sequence of welds must not contain a brace, square-bracket, and must
+not begin with a paren which is preceded by something which is not a keyword.
+In other words, the weld must start with a paren preceded by keyword followed
+by more parens.
 
 =item B<Vertical tightness> of non-block curly braces, parentheses, and square brackets.
 
diff --git a/docs/ChangeLog.html b/docs/ChangeLog.html
index bb3ae09b..d03a0267 100644
--- a/docs/ChangeLog.html
+++ b/docs/ChangeLog.html
@@ -2,7 +2,12 @@
 
 <h2>2020 10 01.03</h2>
 
-<pre><code>- This release is being made to make available a number of new formatting 
+<pre><code>- Added flag -wnxl=s, --weld-nested-exclusion-list=s, to provide control which containers
+  are welded with the --weld-nested-containers parameter.  This is related to issue git #45.
+
+- Merged pull request git #46 which fixes the docs regarding the -fse flag.
+
+- This release is being made to make available a number of new formatting 
   parameters. No significant bugs have been found since the previous release, 
   but several minor issues have been found and fixed as listed below.
 
diff --git a/docs/perltidy.html b/docs/perltidy.html
index 05265c68..f4432815 100644
--- a/docs/perltidy.html
+++ b/docs/perltidy.html
@@ -1493,7 +1493,7 @@
 <dt id="fse-string---format-skipping-end-string"><b>-fse=string</b>, <b>--format-skipping-end=string</b></dt>
 <dd>
 
-<p>The <b>-fse=string</b> is the corresponding parameter used to change the ending marker for format skipping. The default is equivalent to -fse=&#39;#&gt;&gt;&gt;&#39;.</p>
+<p>The <b>-fse=string</b> is the corresponding parameter used to change the ending marker for format skipping. The default is equivalent to -fse=&#39;#&lt;&lt;&lt;&#39;.</p>
 
 <p>The beginning and ending strings may be the same, but it is preferable to make them different for clarity.</p>
 
@@ -1941,6 +1941,34 @@
 
 <p>Finally, the stacking of containers defined by this flag have priority over any other container stacking flags. This is because any welding is done first.</p>
 
+</dd>
+<dt id="wnxl-s---weld-nested-exclusion-list"><b>-wnxl=s</b>, <b>--weld-nested-exclusion-list</b></dt>
+<dd>
+
+<p>The <b>-wnxl=s</b> flag provides some control over the types of containers which can be welded. It does this by supplying a string <b>s</b> which is a list of things which should <b>not</b> be welded. This list is a string with spaces separating any number of items. Each item consists of up to three pieces of information: (1) an optional positiion, (2) an optional preceding type, and (3) a container type.</p>
+
+<p>The container type is required and is one of &#39;(&#39;, &#39;[&#39;, &#39;{&#39; or &#39;q&#39;. The first three of these are container tokens and the last represents a quoted list. So for example the string</p>
+
+<pre><code>  -wnxl=&#39;[ { q&#39;</code></pre>
+
+<p>means do not include square-bracets, braces, or quotes in any welds. In other words, welds will only involve parens.</p>
+
+<p>Any of these container types may be prefixed with a position indicator which is either &#39;^&#39; (to indicate the start of a welded sequence) or &#39;.&#39; (to indicate the interior of a welded sequence).</p>
+
+<p>For example,</p>
+
+<pre><code>  -wnxl=&#39;.{&#39;</code></pre>
+
+<p>would mean to exclude all braces which do not start a welded sequence. Note that quotes always come last in a weld so a position indicator is not useful for them and is ignored if given.</p>
+
+<p>A third item of information which must go between these first two is an alphanumeric letter which limits the selection depending on the type of token immediately before the container. There are, at present, just two possible letters: &#39;k&#39; matches the previous token if it is any keyword, and &#39;K&#39; matches the previous token if it is not be a keyword.</p>
+
+<p>For example,</p>
+
+<pre><code>  -wnxl = &#39;{ [ ^K(&#39;</code></pre>
+
+<p>means the sequence of welds must not contain a brace, square-bracket, and must not begin with a paren which is preceded by something which is not a keyword. In other words, the weld must start with a paren preceded by keyword followed by more parens.</p>
+
 </dd>
 <dt id="Vertical-tightness-of-non-block-curly-braces-parentheses-and-square-brackets"><b>Vertical tightness</b> of non-block curly braces, parentheses, and square brackets.</dt>
 <dd>
diff --git a/lib/Perl/Tidy.pm b/lib/Perl/Tidy.pm
index 30ef4e2d..a7f889aa 100644
--- a/lib/Perl/Tidy.pm
+++ b/lib/Perl/Tidy.pm
@@ -2280,6 +2280,7 @@ sub generate_options {
     $add_option->( 'paren-vertical-tightness',                'pvt',   '=i' );
     $add_option->( 'paren-vertical-tightness-closing',        'pvtc',  '=i' );
     $add_option->( 'weld-nested-containers',                  'wn',    '!' );
+    $add_option->( 'weld-nested-exclusion-list',              'wnxl',  '=s' );
     $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 2d8f4abe..20487b75 100644
--- a/lib/Perl/Tidy/Formatter.pm
+++ b/lib/Perl/Tidy/Formatter.pm
@@ -236,6 +236,8 @@ my (
     %stack_opening_token,
     %stack_closing_token,
 
+    %weld_nested_exclusion_rules,
+
     # regex patterns for text identification.
     # Most are initialized in a sub make_**_pattern during configuration.
     # Most can be configured by user parameters.
@@ -1501,9 +1503,123 @@ EOM
         }
     }
 
+    initialize_weld_nested_exclusion_rules($rOpts);
     return;
 }
 
+sub initialize_weld_nested_exclusion_rules {
+    my ($rOpts) = @_;
+    %weld_nested_exclusion_rules = ();
+
+    my $opt_name = 'weld-nested-exclusion-list';
+    my $str      = $rOpts->{$opt_name};
+    return unless ($str);
+    $str =~ s/^\s+//;
+    $str =~ s/\s+$//;
+    return unless ($str);
+
+    # There are four container tokens.  A unique key is made by combining each
+    # token and its type.
+    my %token_keys = (
+        '(' => '(',
+        '[' => '[',
+        '{' => '{',
+        'q' => 'q',
+    );
+
+    # We are parsing an exclusion list for nested welds. The list is a string
+    # with spaces separating any number of items.  Each item consists of three
+    # pieces of information:
+    # <optional position> <optional type> <type of container>
+    # <     ^ or .      > <    k or K   > <     ( [ {       >
+
+    # The last character is the required container type and must be one of:
+    # ( = paren
+    # [ = square bracket
+    # { = brace
+
+    # An optional leading position indicator:
+    # ^ means the leading token position in the weld
+    # . means a secondary token position in the weld
+    #   no position indicator means all positions match
+
+    # An optional alphanumeric character between the position and container
+    # token selects to which the rule applies:
+    # k = any keyword
+    # K = any non-keyword
+    #     no letter means any preceding type matches
+
+    # Examples:
+    # ^(  - the weld must not start with a paren
+    # .(  - the second and later tokens may not be parens
+    # (   - no parens in weld
+    # ^K(  - exclude a leading paren not preceded by a keyword
+    # .k(  - exclude a secondary paren preceded by a keyword
+    # [ {  - exclude all brackets and braces
+
+    my @items = split /\s+/, $str;
+    my $msg1;
+    my $msg2;
+    foreach my $item (@items) {
+        my $item_save = $item;
+        my $tok       = chop($item);
+        my $key       = $token_keys{$tok};
+        if ( !defined($key) ) {
+            $msg1 .= " '$item_save'";
+            next;
+        }
+        if ( !defined( $weld_nested_exclusion_rules{$key} ) ) {
+            $weld_nested_exclusion_rules{$key} = [];
+        }
+        my $rflags = $weld_nested_exclusion_rules{$key};
+
+        # A 'q' means do not weld quotes
+        if ( $tok eq 'q' ) {
+            $rflags->[0] = '*';
+            $rflags->[1] = '*';
+            next;
+        }
+
+        my $pos    = '*';
+        my $select = '*';
+        if ($item) {
+            if ( $item =~ /^([\^\.])?([kK])?$/ ) {
+                $pos    = $1 if ($1);
+                $select = $2 if ($2);
+            }
+            else {
+                $msg1 .= " '$item_save'";
+                next;
+            }
+        }
+        if ( $pos eq '^' || $pos eq '*' ) {
+            if ( defined( $rflags->[0] ) && $rflags ne $select ) {
+                $msg1 .= " '$item_save'";
+            }
+            $rflags->[0] = $select;
+        }
+        if ( $pos eq '.' || $pos eq '*' ) {
+            if ( defined( $rflags->[1] ) && $rflags ne $select ) {
+                $msg1 .= " '$item_save'";
+            }
+            $rflags->[1] = $select;
+        }
+    }
+    if ($msg1) {
+        Warn(<<EOM);
+Unexpecting symbol(s) encountered in --$opt_name will be ignored:
+$msg1
+EOM
+    }
+    if ($msg2) {
+        Warn(<<EOM);
+Multiple specifications were encountered in the --weld-nested-exclusion-list for:
+$msg2
+Only the last will be used.
+EOM
+    }
+}
+
 sub initialize_whitespace_hashes {
 
     # This is called once before formatting begins to initialize these global
@@ -6194,6 +6310,28 @@ sub find_nested_pairs {
     return \@nested_pairs;
 }
 
+sub is_excluded_weld {
+
+    # decide if this weld is excluded by user request
+    my ( $self, $KK, $is_leading ) = @_;
+    my $rLL         = $self->[_rLL_];
+    my $rtoken_vars = $rLL->[$KK];
+    my $token       = $rtoken_vars->[_TOKEN_];
+    my $rflags      = $weld_nested_exclusion_rules{$token};
+    return 0 unless ( defined($rflags) );
+    my $flag = $is_leading ? $rflags->[0] : $rflags->[1];
+    return 0 unless ( defined($flag) );
+    return 1 if $flag eq '*';
+    my $Kp     = $self->K_previous_nonblank($KK);
+    my $type_p = 'b';
+    if ( defined($Kp) ) { $type_p = $rLL->[$Kp]->[_TYPE_] }
+
+    if ( $flag eq 'k' && $type_p eq 'k' || $flag eq 'K' && $type_p ne 'k' ) {
+        return 1;
+    }
+    return 0;
+}
+
 sub weld_nested_containers {
     my ($self) = @_;
 
@@ -6428,6 +6566,15 @@ sub weld_nested_containers {
             }
         }
 
+        # DO-NOT-WELD RULE 5: do not include welds excluded by user
+        if ( !$do_not_weld && %weld_nested_exclusion_rules ) {
+            $do_not_weld ||=
+              $self->is_excluded_weld( $Kouter_opening,
+                $starting_new_weld );
+            $do_not_weld ||=
+              $self->is_excluded_weld( $Kinner_opening, 0 );
+        }
+
         if ($do_not_weld) {
 
             # After neglecting a pair, we start measuring from start of point io
@@ -6543,6 +6690,10 @@ sub weld_nested_quotes {
 
     my $self = shift;
 
+    # See if quotes are excluded from welding
+    my $rflags = $weld_nested_exclusion_rules{'q'};
+    return if ( defined($rflags) && defined( $rflags->[1] ) );
+
     my $rweld_len_left_closing  = $self->[_rweld_len_left_closing_];
     my $rweld_len_right_opening = $self->[_rweld_len_right_opening_];
 
@@ -6639,6 +6790,10 @@ sub weld_nested_quotes {
             # Assume old line breaks for this estimate.
             next if ( $excess_line_length_K->( $KK, $Kn ) > 0 );
 
+            # Check weld exclusion rules for outer container
+            my $is_leading = !$self->[_rweld_len_left_opening_]->{$outer_seqno};
+            next if ( $self->is_excluded_weld( $KK, $is_leading ) );
+
             # OK to weld
             # FIXME: Are these always correct?
             $rweld_len_left_closing->{$outer_seqno}  = 1;
@@ -9610,8 +9765,8 @@ sub compare_indentation_levels {
 
         my $token = $tokens_to_go[$i];
 
-	# For certain tokens, use user settings to decide if we break before or
-	# after it
+        # For certain tokens, use user settings to decide if we break before or
+        # after it
         #    qw( = . : ? and or xor && || )
         if ( $break_before_or_after_token{$token} ) {
             if ( $want_break_before{$token} && $i >= 0 ) { $i-- }
@@ -9630,12 +9785,12 @@ sub compare_indentation_levels {
             };
 
             ######################################################################
-	    # NOTE: if we call set_closing_breakpoint below it will then call
-	    # this routing back. So there is the possibility of an infinite
-	    # loop if a programming error is made. As a precaution, I have
-	    # added a check on the forced_breakpoint flag, so that we won't
-	    # keep trying to set it.  That will give additional protection
-	    # against a loop.
+            # NOTE: if we call set_closing_breakpoint below it will then call
+            # this routing back. So there is the possibility of an infinite
+            # loop if a programming error is made. As a precaution, I have
+            # added a check on the forced_breakpoint flag, so that we won't
+            # keep trying to set it.  That will give additional protection
+            # against a loop.
             ######################################################################
 
             if (   $i_nonblank >= 0
diff --git a/t/snippets/expect/wnxl.def b/t/snippets/expect/wnxl.def
new file mode 100644
index 00000000..16559f82
--- /dev/null
+++ b/t/snippets/expect/wnxl.def
@@ -0,0 +1,38 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if (
+    _add_fqdn_host(
+        name => ...,
+        fqdn => ...
+    )
+  )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create(
+    sub {
+        my (%hash3);
+        share(%hash3);
+        $hash2{hash}     = \%hash3;
+        $hash3{"thread"} = "yes";
+    }
+)->join();
diff --git a/t/snippets/expect/wnxl.wnxl1 b/t/snippets/expect/wnxl.wnxl1
new file mode 100644
index 00000000..5f6b8fd4
--- /dev/null
+++ b/t/snippets/expect/wnxl.wnxl1
@@ -0,0 +1,36 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create(
+    sub {
+        my (%hash3);
+        share(%hash3);
+        $hash2{hash}     = \%hash3;
+        $hash3{"thread"} = "yes";
+    }
+)->join();
diff --git a/t/snippets/expect/wnxl.wnxl2 b/t/snippets/expect/wnxl.wnxl2
new file mode 100644
index 00000000..0b238d3f
--- /dev/null
+++ b/t/snippets/expect/wnxl.wnxl2
@@ -0,0 +1,28 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols( [ qw(
+        Perl_dump_fds
+        Perl_ErrorNo
+        Perl_GetVars
+        PL_sys_intern
+    ) ] );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do { {
+    next if ( $n % 2 );
+    print $n, "\n";
+} } while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
diff --git a/t/snippets/expect/wnxl.wnxl3 b/t/snippets/expect/wnxl.wnxl3
new file mode 100644
index 00000000..d58ae66f
--- /dev/null
+++ b/t/snippets/expect/wnxl.wnxl3
@@ -0,0 +1,30 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols( [ qw(
+        Perl_dump_fds
+        Perl_ErrorNo
+        Perl_GetVars
+        PL_sys_intern
+    ) ] );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
diff --git a/t/snippets/expect/wnxl.wnxl4 b/t/snippets/expect/wnxl.wnxl4
new file mode 100644
index 00000000..86b108f6
--- /dev/null
+++ b/t/snippets/expect/wnxl.wnxl4
@@ -0,0 +1,34 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
diff --git a/t/snippets/packing_list.txt b/t/snippets/packing_list.txt
index 3f7cc1a8..6d49a819 100644
--- a/t/snippets/packing_list.txt
+++ b/t/snippets/packing_list.txt
@@ -288,6 +288,17 @@
 ../snippets22.t	kba1.kba1
 ../snippets22.t	git45.def
 ../snippets22.t	git45.git45
+../snippets22.t	boa.boa
+../snippets23.t	boa.def
+../snippets23.t	bol.bol
+../snippets23.t	bol.def
+../snippets23.t	bot.bot
+../snippets23.t	bot.def
+../snippets23.t	hash_bang.def
+../snippets23.t	hash_bang.hash_bang
+../snippets23.t	listop1.listop1
+../snippets23.t	sbcp.def
+../snippets23.t	sbcp.sbcp1
 ../snippets3.t	ce_wn1.ce_wn
 ../snippets3.t	ce_wn1.def
 ../snippets3.t	colin.colin
@@ -428,14 +439,8 @@
 ../snippets9.t	rt98902.def
 ../snippets9.t	rt98902.rt98902
 ../snippets9.t	rt99961.def
-../snippets22.t	boa.boa
-../snippets23.t	boa.def
-../snippets23.t	bol.bol
-../snippets23.t	bol.def
-../snippets23.t	bot.bot
-../snippets23.t	bot.def
-../snippets23.t	hash_bang.def
-../snippets23.t	hash_bang.hash_bang
-../snippets23.t	listop1.listop1
-../snippets23.t	sbcp.def
-../snippets23.t	sbcp.sbcp1
+../snippets23.t	wnxl.def
+../snippets23.t	wnxl.wnxl1
+../snippets23.t	wnxl.wnxl2
+../snippets23.t	wnxl.wnxl3
+../snippets23.t	wnxl.wnxl4
diff --git a/t/snippets/wnxl.in b/t/snippets/wnxl.in
new file mode 100644
index 00000000..f044464e
--- /dev/null
+++ b/t/snippets/wnxl.in
@@ -0,0 +1,30 @@
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [ qw(
+            Perl_dump_fds
+            Perl_ErrorNo
+            Perl_GetVars
+            PL_sys_intern
+        ) ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {{
+    next if ($n % 2);
+    print $n, "\n";
+}} while ($n++ < 10);
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash} = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
diff --git a/t/snippets/wnxl1.par b/t/snippets/wnxl1.par
new file mode 100644
index 00000000..fc816c67
--- /dev/null
+++ b/t/snippets/wnxl1.par
@@ -0,0 +1,2 @@
+# only weld parens, and only if leading keyword
+-wn -wnxl='^K( [ { q'
diff --git a/t/snippets/wnxl2.par b/t/snippets/wnxl2.par
new file mode 100644
index 00000000..ade78e94
--- /dev/null
+++ b/t/snippets/wnxl2.par
@@ -0,0 +1,2 @@
+# do not weld leading '['
+-wn -wnxl='^['
diff --git a/t/snippets/wnxl3.par b/t/snippets/wnxl3.par
new file mode 100644
index 00000000..1fa48e9b
--- /dev/null
+++ b/t/snippets/wnxl3.par
@@ -0,0 +1,3 @@
+# do not weld interior or ending '{' without a keyword
+-wn -wnxl='.K{'
+
diff --git a/t/snippets/wnxl4.par b/t/snippets/wnxl4.par
new file mode 100644
index 00000000..6e95d93a
--- /dev/null
+++ b/t/snippets/wnxl4.par
@@ -0,0 +1,2 @@
+# do not weld except parens or trailing brace with keyword
+-wn -wnxl='.K{ ^{ ['
diff --git a/t/snippets23.t b/t/snippets23.t
index dd829fd6..bd0a2d4a 100644
--- a/t/snippets23.t
+++ b/t/snippets23.t
@@ -11,6 +11,11 @@
 #8 listop1.listop1
 #9 sbcp.def
 #10 sbcp.sbcp1
+#11 wnxl.def
+#12 wnxl.wnxl1
+#13 wnxl.wnxl2
+#14 wnxl.wnxl3
+#15 wnxl.wnxl4
 
 # To locate test #13 you can search for its name or the string '#13'
 
@@ -44,6 +49,23 @@ BEGIN {
 ----------
         'sbcp1' => <<'----------',
 -sbc -sbcp='#x#'
+----------
+        'wnxl1' => <<'----------',
+# only weld parens, and only if leading keyword
+-wn -wnxl='^K( [ { q'
+----------
+        'wnxl2' => <<'----------',
+# do not weld leading '['
+-wn -wnxl='^['
+----------
+        'wnxl3' => <<'----------',
+# do not weld interior or ending '{' without a keyword
+-wn -wnxl='.K{'
+
+----------
+        'wnxl4' => <<'----------',
+# do not weld except parens or trailing brace with keyword
+-wn -wnxl='.K{ ^{ ['
 ----------
     };
 
@@ -95,6 +117,39 @@ my @sorted = map { $_->[0] }
 ## 'Dec', 'Nov'
     'Nov', 'Dec'
 );
+----------
+
+        'wnxl' => <<'----------',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [ qw(
+            Perl_dump_fds
+            Perl_ErrorNo
+            Perl_GetVars
+            PL_sys_intern
+        ) ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {{
+    next if ($n % 2);
+    print $n, "\n";
+}} while ($n++ < 10);
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash} = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
 ----------
     };
 
@@ -214,6 +269,207 @@ my @sorted =
 );
 #10...........
         },
+
+        'wnxl.def' => {
+            source => "wnxl",
+            params => "def",
+            expect => <<'#11...........',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if (
+    _add_fqdn_host(
+        name => ...,
+        fqdn => ...
+    )
+  )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create(
+    sub {
+        my (%hash3);
+        share(%hash3);
+        $hash2{hash}     = \%hash3;
+        $hash3{"thread"} = "yes";
+    }
+)->join();
+#11...........
+        },
+
+        'wnxl.wnxl1' => {
+            source => "wnxl",
+            params => "wnxl1",
+            expect => <<'#12...........',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create(
+    sub {
+        my (%hash3);
+        share(%hash3);
+        $hash2{hash}     = \%hash3;
+        $hash3{"thread"} = "yes";
+    }
+)->join();
+#12...........
+        },
+
+        'wnxl.wnxl2' => {
+            source => "wnxl",
+            params => "wnxl2",
+            expect => <<'#13...........',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols( [ qw(
+        Perl_dump_fds
+        Perl_ErrorNo
+        Perl_GetVars
+        PL_sys_intern
+    ) ] );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do { {
+    next if ( $n % 2 );
+    print $n, "\n";
+} } while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
+#13...........
+        },
+
+        'wnxl.wnxl3' => {
+            source => "wnxl",
+            params => "wnxl3",
+            expect => <<'#14...........',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols( [ qw(
+        Perl_dump_fds
+        Perl_ErrorNo
+        Perl_GetVars
+        PL_sys_intern
+    ) ] );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
+#14...........
+        },
+
+        'wnxl.wnxl4' => {
+            source => "wnxl",
+            params => "wnxl4",
+            expect => <<'#15...........',
+if ( $PLATFORM eq 'aix' ) {
+    skip_symbols(
+        [
+            qw(
+              Perl_dump_fds
+              Perl_ErrorNo
+              Perl_GetVars
+              PL_sys_intern
+              )
+        ]
+    );
+}
+
+if ( _add_fqdn_host(
+    name => ...,
+    fqdn => ...
+) )
+{
+    ...;
+}
+
+do {
+    {
+        next if ( $n % 2 );
+        print $n, "\n";
+    }
+} while ( $n++ < 10 );
+
+threads->create( sub {
+    my (%hash3);
+    share(%hash3);
+    $hash2{hash}     = \%hash3;
+    $hash3{"thread"} = "yes";
+} )->join();
+#15...........
+        },
     };
 
     my $ntests = 0 + keys %{$rtests};
-- 
2.39.5