From f5c216b7cfdd393c15e2a1430bca6f6c6f2171eb Mon Sep 17 00:00:00 2001 From: Jitka Plesnikova Date: Wed, 19 Jan 2022 15:29:44 +0100 Subject: [PATCH] Version 1.03 --- Changes | 3 + MANIFEST | 4 ++ Makefile.PL | 2 +- bin/perl.prov | 49 ++++++++++------ bin/perl.req | 27 +++++---- t/01_basic.t | 1 - t/02_list.t | 1 - t/07_multiline.t | 20 +++++++ t/08_heredoc.t | 29 ++++++++++ t/data/basic | 3 - t/data/heredoc | 147 +++++++++++++++++++++++++++++++++++++++++++++++ t/data/list | 3 - t/data/multiline | 6 ++ 13 files changed, 258 insertions(+), 37 deletions(-) create mode 100644 t/07_multiline.t create mode 100644 t/08_heredoc.t create mode 100644 t/data/heredoc create mode 100644 t/data/multiline diff --git a/Changes b/Changes index 5a8178d..cec0128 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,7 @@ Revision history for perl-generators. +1.03 Mon Feb 2 2015 +- Updated parcing of here-doc and quoted section which should be skipped +- Update tests suite 1.02 Fri Dec 12 2014 - Fix BZ#1172716 - update regex to properly match the module name diff --git a/MANIFEST b/MANIFEST index 5563349..afd7d92 100644 --- a/MANIFEST +++ b/MANIFEST @@ -11,9 +11,13 @@ t/03_anymoose.t t/04_provides.t t/05_whitespace.t t/06_variables.t +t/07_multiline.t +t/08_heredoc.t t/data/anymoose t/data/basic +t/data/heredoc t/data/list +t/data/multiline t/data/provides t/data/todo t/data/variables diff --git a/Makefile.PL b/Makefile.PL index 39ab562..9406c42 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -5,7 +5,7 @@ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'generators', - 'VERSION' => '1.02', + 'VERSION' => '1.03', 'AUTHOR' => 'Jitka Plesnikova ', 'LICENSE' => 'gpl', 'EXE_FILES' => [ ( glob 'bin/*' ) ], diff --git a/bin/perl.prov b/bin/perl.prov index baca33a..4b40c00 100755 --- a/bin/perl.prov +++ b/bin/perl.prov @@ -72,31 +72,46 @@ sub process_file { while () { + # skip the here-docs "<<" blocks + # assume that <<12 means bitwise operation + if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ && + ($2 !~ m/^\d+$/)) || + m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/ + ) && + ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/ + ) { + $tag = $2; + while () { + chomp; + ( $_ eq $tag ) && last; + } + $_ = ; + } + + # skip q{} quoted sections - just hope we don't have curly brackets + # within the quote, nor an escaped hash mark that isn't a comment + # marker, such as occurs right here. Draw the line somewhere. + if ( m/^.*\Wq[qxwr]?\s*([{([#|!\/])[^})\]#|!\/]*$/ && ! m/^\s*(package)\s/ ) { + $tag = $1; + $tag =~ tr/{\(\[\#|!\//})]#|!\//; + $tag = quotemeta($tag); + while () { + ( $_ =~ m/$tag/ ) && last; + } + } + # skip the documentation # we should not need to have item in this if statement (it # properly belongs in the over/back section) but people do not # read the perldoc. - if (m/^=(head[1-4]|pod|for|item)/) { - $incomment = 1; - } - - if (m/^=(cut)/) { - $incomment = 0; - $inover = 0; - } - - if (m/^=(over)/) { - $inover = 1; - } - - if (m/^=(back)/) { - $inover = 0; + if (/^=(head[1-4]|pod|for|item)/) { + /^=cut/ && next while ; } - if ($incomment || $inover) { - next; + if (/^=over/) { + /^=back/ && next while ; } # skip the data section diff --git a/bin/perl.req b/bin/perl.req index 3c848c7..b6485f0 100755 --- a/bin/perl.req +++ b/bin/perl.req @@ -83,11 +83,16 @@ sub process_file { while () { - # skip the "= <<" block - - if (m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ || - m/^\s*\$(.*)\s*=\s*<<(\w+)\s*;/) { + # skip the here-docs "<<" blocks + # assume that <<12 means bitwise operation + if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?([^"'#<@])<<(\w+)\s*/ && + ($2 !~ m/^\d+$/)) || + m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*(["'`])(.+?|)\1\s*/ + ) && + ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/ + ) { $tag = $2; + if ($_ =~ m/^\s*use\s(constant)\s/) { add_require($1, undef) } while () { chomp; ( $_ eq $tag ) && last; @@ -98,9 +103,9 @@ sub process_file { # skip q{} quoted sections - just hope we don't have curly brackets # within the quote, nor an escaped hash mark that isn't a comment # marker, such as occurs right here. Draw the line somewhere. - if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) { + if ( m/^.*\Wq[qxwr]?\s*([{([#|!\/])[^})\]#|!\/]*$/ && ! m/^\s*(require|use)\s/ ) { $tag = $1; - $tag =~ tr/{\(\[\#|\//})]#|\//; + $tag =~ tr/{\(\[\#|!\//})]#|!\//; $tag = quotemeta($tag); while () { ( $_ =~ m/$tag/ ) && last; @@ -154,9 +159,9 @@ sub process_file { (m/^(\s*) # we hope the inclusion starts the line (require|use)\s+(?!\{) # do not want 'do {' loops # quotes around name are always legal - $begin_re?\s* - ([\w:\.\/]+?) - \s*$end_re?[^\w]*?[\t; \n] + (?:$begin_re?\s*([\w:\/\.]+?)\s*$end_re?| + ([\w:\.]+?))[^\w]*? + [\t; \n] # the syntax for 'use' allows version requirements \s*($modver_re)?\s* # catch parameter like '-norequire,' @@ -164,10 +169,10 @@ sub process_file { # the latter part is for "use base qw(Foo)" and friends special case (?:$begin_re\s* ([^)\/"'\$!|}]*?) - \s*$end_re|['"][^'"]+['"]|)\s* + \s*$end_re|)\s* /x) ) { - my ($whitespace, $statement, $module, $version, $params, $list) = ($1, $2, $3, $4, $5, $6); + my ($whitespace, $statement, $module, $version, $params, $list) = ($1, $2, $3, $5, $6, $7); $version = undef if ($version eq ''); # we only consider require statements that are flushed against diff --git a/t/01_basic.t b/t/01_basic.t index 8b1b4ef..37b66f0 100644 --- a/t/01_basic.t +++ b/t/01_basic.t @@ -24,7 +24,6 @@ my @expectedrequires = ( "perl(Epsilon)\n", "perl(Eta)\n", "perl(ExtUtils::MM_Unix)\n", - "perl(ExtUtils::MakeMaker)\n", "perl(Gamma)\n", "perl(Iota)\n", "perl(Kappa)\n", diff --git a/t/02_list.t b/t/02_list.t index a4afb15..fc9d5b7 100644 --- a/t/02_list.t +++ b/t/02_list.t @@ -23,7 +23,6 @@ my @expectedrequires = ( "perl(aliased)\n", "perl(base)\n", "perl(parent)\n", - "perl(overload)\n", ); is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found."); diff --git a/t/07_multiline.t b/t/07_multiline.t new file mode 100644 index 0000000..e0c73f6 --- /dev/null +++ b/t/07_multiline.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test::More tests => 2; + +my $file = "t/data/multiline"; +my @requires = qx(bin/perl.req $file); +my @provides = qx(bin/perl.prov $file); + +# +# Provides +is(scalar(@provides), 0, 'No package is provided'); + +# +# Requires +my @expectedrequires = ( + "perl(At::The::End)\n", + "perl(overload)\n", +); + +is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found."); diff --git a/t/08_heredoc.t b/t/08_heredoc.t new file mode 100644 index 0000000..da500e3 --- /dev/null +++ b/t/08_heredoc.t @@ -0,0 +1,29 @@ +use strict; +use warnings; +use Test::More tests => 2; + +my $file = "t/data/heredoc"; +my @requires = qx(bin/perl.req $file); +my @provides = qx(bin/perl.prov $file); + +# +# Provides +my @expectedprovides = ( + "perl(More::Then::Two::Mark)\n", + "perl(Not::In::Heredoc)\n", + "perl(THAT)\n", +); + +is_deeply([ sort @provides ], [ sort @expectedprovides ], "Only expected provides were found."); + +# +# Requires +my @expectedrequires = ( + "perl(Bitwise::Operator)\n", + "perl(constant)\n", + "perl(More::Then::Two::Mark)\n", + "perl(Not::In::Heredoc)\n", + "perl(THAT)\n", +); + +is_deeply([ sort @requires ], [ sort @expectedrequires ], "Only expected requires were found."); diff --git a/t/data/basic b/t/data/basic index 6e53811..8ba52c7 100644 --- a/t/data/basic +++ b/t/data/basic @@ -20,9 +20,6 @@ use 5.010; # 'use' does not accept module name with .pm use 'Ignore.pm'; -# Dist-Zilla-5.027/lib/Dist/Zilla/Plugin/MakeMaker.pm -use ExtUtils::MakeMaker{{ defined $eumm_version && 0+$eumm_version ? ' ' . $eumm_version : '' }}; - require Eta; require 'Theta.pm'; require "Iota.pm"; diff --git a/t/data/heredoc b/t/data/heredoc new file mode 100644 index 0000000..35d4bd6 --- /dev/null +++ b/t/data/heredoc @@ -0,0 +1,147 @@ +# +# 'authentication' should not be found, because it is part of "= <<" block +twitter_api_method suggestion_categories => ( + path => 'users/suggestions', + method => 'GET', + params => [], + required => [], + returns => 'ArrayRef', + description => <<'' +Returns the list of suggested user categories. The category slug can be used in +the C API method get the users in that category . Does not +require authentication +package authentication; + +); + +%hash = ( + "text" => << 'EOT' +use and require is a horrible stuff +package EOT +EOT +); + +$template = <get_diff($log) ); + return << "HERE"; +package Use::Template; +use Template; +HERE +} + +$pod .= << 'HERE'; +package Simply::Pod; +use Simply::Pod; +HERE + +push @LIB, <note_template( $log, << "HERE" ); +perldelta: $section [pending] +use +HERE + +write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' ); +package Foo; +use Foo; +1; +EOT + +is (eval <<'END', 1, 'lexical topic compiles') or diag $@; + package Experimental + ; + use experimental 'lexical_topic'; + my $_ = 1; + is($_, 1, '$_ is 1'); +END + + +# Multiple here-docs does not properly. The skipping finish on the first tag +myfunc(<< "THIS", 23, <<'THAT'); +package THIS; +use THIS; +THIS +package THAT; +use THAT; +THAT + +print <<< 'test'; +package More::Then::Two::Mark; +use More::Then::Two::Mark; + +print 20 << 20; +print 20<<20; +use Bitwise::Operator; + +use constant COPYRIGHT_SHORT => <>}, + Parse::RecDescent::_tracefirst($_[1]), + q{' . $self->{"name"} .'}, + $tracelevel) +} + +$trase = q!< "ShorterName"; -use overload - '+' => \&myadd, - '-' => \&mysub; diff --git a/t/data/multiline b/t/data/multiline new file mode 100644 index 0000000..68c7beb --- /dev/null +++ b/t/data/multiline @@ -0,0 +1,6 @@ +# Only a module 'overload' should be reported from the file +use overload + '+' => \&myadd, + '-' => \&mysub; + +use At::The::End