## 2019 09 15.01
+ - implement issue RT#130640: Allow different subroutine keywords.
+ Added a flag --sub-alias-list=s or -sal=s, where s is a string with
+ one or more aliases for 'sub', separated by spaces or commas.
+ For example,
+
+ perltidy -sal='method fun'
+
+ will cause the perltidy to treate the words 'method' and 'fun' to be
+ treated the same as if they were 'sub'.
+
+ - Added flag --space-prototype-paren=i, or -spp=i, to control spacing
+ before the opening paren of a prototype, where i=0, 1, or 2:
+ i=0 no space
+ i=1 follow input [current and default]
+ i=2 always space
+
+ Previously, perltidy always followed the input.
+ For example, given the following input
+
+ sub usage();
+
+ The result will be:
+ sub usage(); # i=0 [no space]
+ sub usage(); # i=1 [default; follows input]
+ sub usage (); # i=2 [space]
+
+
+## 2019 09 15
+
- fixed issue RT#130344: false warning "operator in print statement"
for "use lib".
parameters. If this is not the case, an error message noting this is produced.
This flag has no other effect on the functioning of perltidy.
+=item B<-sal=s>, B<--sub-alias-list=s>
+
+This flag causes one or more words to be treated the same as if they were the keyword 'sub'. The string B<s> contains one or more alias words, separated by spaces or commas.
+
+For example,
+
+ perltidy -sal='method fun _sub M4'
+
+will cause the perltidy to treate the words 'method', 'fun', '_sub' and 'M4' to be treated the same as if they were 'sub'. Note that if the alias words are separated by spaces then the string of words should be placed in quotes.
+
=back
You will probably also want to use the flag B<-skp> (previous item) too.
+=item B<-spp=n> or B<--space-prototype-paren=n>
+
+This flag can be used to control whether a function prototype is preceded by a space. For example, the following prototype does not have a space.
+
+ sub usage();
+
+This integer B<n> may have the value 0, 1, or 2 as follows:
+
+ -spp=0 means no space before the paren
+ -spp=1 means follow the example of the source code [DEFAULT]
+ -spp=2 means always put a space before the paren
+
+The default is B<-spp=1>, meaning that a space will be used if and only if there is one in the source code. Given the above line of code, the result of
+applying the different options would be:
+
+ sub usage(); # n=0 [no space]
+ sub usage(); # n=1 [default; follows input]
+ sub usage (); # n=2 [space]
+
=item Trimming whitespace around C<qw> quotes
B<-tqw> or B<--trim-qw> provide the default behavior of trimming
<h1>Perltidy Change Log</h1>
+<h2>2019 09 15.01</h2>
+
+<pre><code>- implement issue RT#130640: Allow different subroutine keywords.
+ Added a flag --sub-alias-list=s or -sal=s, where s is a string with
+ one or more aliases for 'sub', separated by spaces or commas.
+ For example,
+
+ perltidy -sal='method fun'
+
+ will cause the perltidy to treate the words 'method' and 'fun' to be
+ treated the same as if they were 'sub'.
+
+- Added flag --space-prototype-paren=i, or -spp=i, to control spacing
+ before the opening paren of a prototype, where i=0, 1, or 2:
+ i=0 no space
+ i=1 follow input [current and default]
+ i=2 always space
+
+ Previously, perltidy always followed the input.
+ For example, given the following input
+
+ sub usage();
+
+ The result will be:
+ sub usage(); # i=0 [no space]
+ sub usage(); # i=1 [default; follows input]
+ sub usage (); # i=2 [space]
+</code></pre>
+
<h2>2019 09 15</h2>
<pre><code>- fixed issue RT#130344: false warning "operator in print statement"
<h1 id="VERSION">VERSION</h1>
-<p>This man page documents Perl::Tidy version 20190915</p>
+<p>This man page documents Perl::Tidy version 20190915.01</p>
<h1 id="LICENSE">LICENSE</h1>
<p>This flag asserts that the input and output code streams are different, or in other words that the input code is 'untidy' according to the formatting parameters. If this is not the case, an error message noting this is produced. This flag has no other effect on the functioning of perltidy.</p>
+</dd>
+<dt id="sal-s---sub-alias-list-s"><b>-sal=s</b>, <b>--sub-alias-list=s</b></dt>
+<dd>
+
+<p>This flag causes one or more words to be treated the same as if they were the keyword 'sub'. The string <b>s</b> contains one or more alias words, separated by spaces or commas.</p>
+
+<p>For example,</p>
+
+<pre><code> perltidy -sal='method fun _sub M4' </code></pre>
+
+<p>will cause the perltidy to treate the words 'method', 'fun', '_sub' and 'M4' to be treated the same as if they were 'sub'. Note that if the alias words are separated by spaces then the string of words should be placed in quotes.</p>
+
</dd>
</dl>
<p>You will probably also want to use the flag <b>-skp</b> (previous item) too.</p>
+</dd>
+<dt id="spp-n-or---space-prototype-paren-n"><b>-spp=n</b> or <b>--space-prototype-paren=n</b></dt>
+<dd>
+
+<p>This flag can be used to control whether a function prototype is preceded by a space. For example, the following prototype does not have a space.</p>
+
+<pre><code> sub usage();</code></pre>
+
+<p>This integer <b>n</b> may have the value 0, 1, or 2 as follows:</p>
+
+<pre><code> -spp=0 means no space before the paren
+ -spp=1 means follow the example of the source code [DEFAULT]
+ -spp=2 means always put a space before the paren</code></pre>
+
+<p>The default is <b>-spp=1</b>, meaning that a space will be used if and only if there is one in the source code. Given the above line of code, the result of applying the different options would be:</p>
+
+<pre><code> sub usage(); # n=0 [no space]
+ sub usage(); # n=1 [default; follows input]
+ sub usage (); # n=2 [space]</code></pre>
+
</dd>
<dt id="Trimming-whitespace-around-qw-quotes">Trimming whitespace around <code>qw</code> quotes</dt>
<dd>
<h1 id="VERSION">VERSION</h1>
-<p>This man page documents perltidy version 20190915</p>
+<p>This man page documents perltidy version 20190915.01</p>
<h1 id="BUG-REPORTS">BUG REPORTS</h1>
}
Perl::Tidy::Formatter::check_options($rOpts);
+ Perl::Tidy::Tokenizer::check_options($rOpts);
if ( $rOpts->{'format'} eq 'html' ) {
Perl::Tidy::HtmlWriter->check_options($rOpts);
}
$add_option->( 'extended-syntax', 'xs', '!' );
$add_option->( 'assert-tidy', 'ast', '!' );
$add_option->( 'assert-untidy', 'asu', '!' );
+ $add_option->( 'sub-alias-list', 'sal', '=s' );
########################################
$category = 2; # Code indentation control
$add_option->( 'trim-pod', 'trp', '!' );
$add_option->( 'want-left-space', 'wls', '=s' );
$add_option->( 'want-right-space', 'wrs', '=s' );
+ $add_option->( 'space-prototype-paren', 'spp', '=i' );
########################################
$category = 4; # Comment controls
'keyword-group-blanks-before' => [ 0, 2 ],
'keyword-group-blanks-after' => [ 0, 2 ],
+
+ 'space-prototype-paren' => [ 0, 2 ],
);
# Note: we could actually allow negative ci if someone really wants it:
short-concatenation-item-length=8
space-for-semicolon
space-backslash-quote=1
+ space-prototype-paren=1
square-bracket-tightness=1
square-bracket-vertical-tightness-closing=0
square-bracket-vertical-tightness=0
$rOpts->{'default-tabsize'} = 8;
}
+ # Check and clean up any sub-alias-list
+ if ( $rOpts->{'sub-alias-list'} ) {
+ my $sub_alias_string = $rOpts->{'sub-alias-list'};
+ $sub_alias_string =~ s/,/ /g; # allow commas
+ $sub_alias_string =~ s/^\s+//;
+ $sub_alias_string =~ s/\s+$//;
+ my @sub_alias_list = split /\s+/, $sub_alias_string;
+ my @filtered_word_list = ('sub');
+ my %seen;
+
+ # include 'sub' for later convenience
+ $seen{sub}++;
+ foreach my $word (@sub_alias_list) {
+ if ($word) {
+ if ( $word !~ /^\w[\w\d]*$/ ) {
+ Warn("unexpected sub alias '$word' - ignoring\n");
+ }
+ if ( !$seen{$word} ) {
+ $seen{$word}++;
+ push @filtered_word_list, $word;
+ }
+ }
+ }
+ my $joined_words = join ' ', @filtered_word_list;
+ $rOpts->{'sub-alias-list'} = join ' ', @filtered_word_list;
+ }
+
# Define $tabsize, the number of spaces per tab for use in
# guessing the indentation of source lines with leading tabs.
# Assume same as for this run if tabs are used , otherwise assume
}
if ( $token =~ /$SUB_PATTERN/ ) {
+
+ # -spp = 0 : no space before opening prototype paren
+ # -spp = 1 : stable (follow input spacing)
+ # -spp = 2 : always space before opening prototype paren
+ my $spp = $rOpts->{'space-prototype-paren'};
+ if ( defined($spp) ) {
+ if ( $spp == 0 ) { $token =~ s/\s+\(/\(/; }
+ elsif ( $spp == 2 ) { $token =~ s/\(/ (/; }
+ }
+
+ # one space max, and no tabs
$token =~ s/\s+/ /g;
$rtoken_vars->[_TOKEN_] = $token;
}
}
}
+ make_sub_matching_pattern();
make_bli_pattern();
make_block_brace_vertical_tightness_pattern();
make_blank_line_pattern();
return;
}
+sub make_sub_matching_pattern {
+
+ $SUB_PATTERN = '^sub\s+(::|\w)';
+ $ASUB_PATTERN = '^sub$';
+
+ if ( $rOpts->{'sub-alias-list'} ) {
+
+ # Note that any 'sub-alias-list' has been preprocessed to
+ # be a trimmed, space-separated list which includes 'sub'
+ # for example, it might be 'sub method fun'
+ my $sub_alias_list = $rOpts->{'sub-alias-list'};
+ $sub_alias_list =~ s/\s+/\|/g;
+ $SUB_PATTERN =~ s/sub/\($sub_alias_list\)/;
+ $ASUB_PATTERN =~ s/sub/\($sub_alias_list\)/;
+ }
+}
+
sub make_bli_pattern {
if ( defined( $rOpts->{'brace-left-and-indent-list'} )
%is_keyword_taking_list
%is_keyword_taking_optional_args
%is_q_qq_qw_qx_qr_s_y_tr_m
+ %is_sub
+ %is_package
};
# possible values of operator_expected()
return;
}
+sub check_options {
+
+ # Check Tokenizer parameters
+ my $rOpts = shift;
+
+ %is_sub = ( );
+ $is_sub{'sub'} = 1;
+
+ # Install any aliases to 'sub'
+ if ( $rOpts->{'sub-alias-list'} ) {
+
+ # Note that any 'sub-alias-list' has been preprocessed to
+ # be a trimmed, space-separated list which includes 'sub'
+ # for example, it might be 'sub method fun'
+ my @sub_alias_list = split /\s+/, $rOpts->{'sub-alias-list'};
+ foreach my $word (@sub_alias_list) {
+ $is_sub{$word} = 1;
+ }
+ }
+ return;
+}
+
sub new {
my ( $class, @args ) = @_;
@_ = qw(use require);
@is_use_require{@_} = (1) x scalar(@_);
- my %is_sub_package;
- @_ = qw(sub package);
- @is_sub_package{@_} = (1) x scalar(@_);
-
# This hash holds the hash key in $tokenizer_self for these keywords:
my %is_format_END_DATA = (
'format' => '_in_format',
# but do not start on blanks and comments
if ( $id_scan_state && $pre_type !~ /[b#]/ ) {
- if ( $id_scan_state =~ /^(sub|package)/ ) {
+ if ( $is_sub{$id_scan_state} || $is_package{$id_scan_state} ) {
scan_id();
}
else {
}
# 'sub' || 'package'
- elsif ( $is_sub_package{$tok_kw} ) {
+ elsif ( $is_sub{$tok_kw} || $is_package{$tok_kw} ) {
error_if_expecting_OPERATOR()
if ( $expecting == OPERATOR );
scan_id();
if ( $type eq ';' && $tok =~ /\w/ ) { $fix_type = 'k' }
# output anonymous 'sub' as keyword
- if ( $type eq 't' && $tok eq 'sub' ) { $fix_type = 'k' }
+ if ( $type eq 't' && $is_sub{$tok} ) { $fix_type = 'k' }
# -----------------------------------------------------------------
return $last_nonblank_token;
}
+ # or a sub alias
+ elsif (( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' )
+ && ( $is_sub{$last_nonblank_token} ) )
+ {
+ return 'sub';
+ }
+
elsif ( $statement_type =~ /^(sub|package)\b/ ) {
return $statement_type;
}
# handle non-blank line; identifier, if any, must follow
unless ($blank_line) {
- if ( $id_scan_state eq 'sub' ) {
+ if ( $is_sub{$id_scan_state} ) {
( $i, $tok, $type, $id_scan_state ) = do_scan_sub(
$input_line, $i, $i_beg,
$tok, $type, $rtokens,
);
}
- elsif ( $id_scan_state eq 'package' ) {
+ elsif ( $is_package{$id_scan_state} ) {
( $i, $tok, $type ) =
do_scan_package( $input_line, $i, $i_beg, $tok, $type, $rtokens,
$rtoken_map, $max_token_index );
@q = qw(q qq qw qx qr s y tr m);
@is_q_qq_qw_qx_qr_s_y_tr_m{@q} = (1) x scalar(@q);
+ @q = qw(sub);
+ @is_sub{@q} = (1) x scalar(@q);
+
+ @q = qw(package);
+ @is_package{@q} = (1) x scalar(@q);
+
# These keywords are handled specially in the tokenizer code:
my @special_keywords = qw(
do
--- /dev/null
+# git#14; do not break at trailing 'or'
+$second = {
+ key1 => 'aaa',
+ key2 => 'bbb',
+} if $flag1 or $flag2;
--- /dev/null
+sub get_val () {
+
+}
+
+method get_value() {
+
+}
+
+fun get_other_value() {
+
+}
--- /dev/null
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
--- /dev/null
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
--- /dev/null
+sub get_val() { }
+
+sub get_Val() { }
+
+sub Get_val() { }
--- /dev/null
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
--- /dev/null
+sub get_val () { }
+
+sub get_Val () { }
+
+sub Get_val () { }
../snippets9.t rt98902.def
../snippets9.t rt98902.rt98902
../snippets9.t rt99961.def
+../snippets15.t git14.def
+../snippets15.t sal.def
+../snippets15.t sal.sal
+../snippets15.t spp.def
+../snippets15.t spp.spp0
+../snippets16.t spp.spp1
+../snippets16.t spp.spp2
--- /dev/null
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
--- /dev/null
+-sal='method fun'
--- /dev/null
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
#12 align30.def
#13 git09.def
#14 git09.git09
+#15 git14.def
+#16 sal.def
+#17 sal.sal
+#18 spp.def
+#19 spp.spp0
# To locate test #13 you can search for its name or the string '#13'
'gnu' => "-gnu",
'olbs0' => "-olbs=0",
'olbs2' => "-olbs=2",
+ 'sal' => <<'----------',
+-sal='method fun'
+----------
+ 'spp0' => "-spp=0",
};
############################
} map {
[$_, length($_)]
} @unsorted;
+----------
+
+ 'git14' => <<'----------',
+# git#14; do not break at trailing 'or'
+$second = {
+ key1 => 'aaa',
+ key2 => 'bbb',
+} if $flag1 or $flag2;
----------
'gnu5' => <<'----------',
for $x ( 1, 2 ) { s/(.*)/+$1/; }
for $x ( 1, 2 ) { s/(.*)/+$1/; } # side comment
if ( $editlblk eq 1 ) { $editlblk = "on"; $editlblkchecked = "checked"; }
+----------
+
+ 'sal' => <<'----------',
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
+----------
+
+ 'spp' => <<'----------',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
----------
'wngnu1' => <<'----------',
} @unsorted;
#14...........
},
+
+ 'git14.def' => {
+ source => "git14",
+ params => "def",
+ expect => <<'#15...........',
+# git#14; do not break at trailing 'or'
+$second = {
+ key1 => 'aaa',
+ key2 => 'bbb',
+} if $flag1 or $flag2;
+#15...........
+ },
+
+ 'sal.def' => {
+ source => "sal",
+ params => "def",
+ expect => <<'#16...........',
+sub get_val () {
+
+}
+
+method get_value() {
+
+}
+
+fun get_other_value() {
+
+}
+#16...........
+ },
+
+ 'sal.sal' => {
+ source => "sal",
+ params => "sal",
+ expect => <<'#17...........',
+sub get_val () {
+
+}
+
+method get_value () {
+
+}
+
+fun get_other_value () {
+
+}
+#17...........
+ },
+
+ 'spp.def' => {
+ source => "spp",
+ params => "def",
+ expect => <<'#18...........',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+#18...........
+ },
+
+ 'spp.spp0' => {
+ source => "spp",
+ params => "spp0",
+ expect => <<'#19...........',
+sub get_val() { }
+
+sub get_Val() { }
+
+sub Get_val() { }
+#19...........
+ },
};
my $ntests = 0 + keys %{$rtests};
--- /dev/null
+# Created with: ./make_t.pl
+
+# Contents:
+#1 spp.spp1
+#2 spp.spp2
+
+# To locate test #13 you can search for its name or the string '#13'
+
+use strict;
+use Test;
+use Carp;
+use Perl::Tidy;
+my $rparams;
+my $rsources;
+my $rtests;
+
+BEGIN {
+
+ ###########################################
+ # BEGIN SECTION 1: Parameter combinations #
+ ###########################################
+ $rparams = {
+ 'spp1' => "-spp=1",
+ 'spp2' => "-spp=2",
+ };
+
+ ############################
+ # BEGIN SECTION 2: Sources #
+ ############################
+ $rsources = {
+
+ 'spp' => <<'----------',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+----------
+ };
+
+ ####################################
+ # BEGIN SECTION 3: Expected output #
+ ####################################
+ $rtests = {
+
+ 'spp.spp1' => {
+ source => "spp",
+ params => "spp1",
+ expect => <<'#1...........',
+sub get_val() { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+#1...........
+ },
+
+ 'spp.spp2' => {
+ source => "spp",
+ params => "spp2",
+ expect => <<'#2...........',
+sub get_val () { }
+
+sub get_Val () { }
+
+sub Get_val () { }
+#2...........
+ },
+ };
+
+ my $ntests = 0 + keys %{$rtests};
+ plan tests => $ntests;
+}
+
+###############
+# EXECUTE TESTS
+###############
+
+foreach my $key ( sort keys %{$rtests} ) {
+ my $output;
+ my $sname = $rtests->{$key}->{source};
+ my $expect = $rtests->{$key}->{expect};
+ my $pname = $rtests->{$key}->{params};
+ my $source = $rsources->{$sname};
+ my $params = defined($pname) ? $rparams->{$pname} : "";
+ my $stderr_string;
+ my $errorfile_string;
+ my $err = Perl::Tidy::perltidy(
+ source => \$source,
+ destination => \$output,
+ perltidyrc => \$params,
+ argv => '', # for safety; hide any ARGV from perltidy
+ stderr => \$stderr_string,
+ errorfile => \$errorfile_string, # not used when -se flag is set
+ );
+ if ( $err || $stderr_string || $errorfile_string ) {
+ if ($err) {
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$err );
+ }
+ if ($stderr_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<STDERR>>\n$stderr_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$stderr_string );
+ }
+ if ($errorfile_string) {
+ print STDERR "---------------------\n";
+ print STDERR "<<.ERR file>>\n$errorfile_string\n";
+ print STDERR "---------------------\n";
+ print STDERR
+"This error received calling Perl::Tidy with '$sname' + '$pname'\n";
+ ok( !$errorfile_string );
+ }
+ }
+ else {
+ ok( $output, $expect );
+ }
+}
projects / perltidy.git / commitdiff