From 470f769f911d5dd36be6273f58ea44a833102a9b Mon Sep 17 00:00:00 2001 From: Steffen Mueller Date: Wed, 22 May 2013 22:07:59 +0200 Subject: [PATCH] EU::ParseXS: Move several constants out of the runtime object --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 61 +++++++++++----------- .../lib/ExtUtils/ParseXS/Constants.pm | 2 + 2 files changed, 33 insertions(+), 30 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index af000a5..3849339 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -44,21 +44,29 @@ our @EXPORT_OK = qw( report_error_count ); +############################## +# A number of "constants" + our ($C_group_rex, $C_arg); -BEGIN { - # Group in C (no support for comments or literals) - $C_group_rex = qr/ [({\[] - (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )* - [)}\]] /x; - # Chunk in C without comma at toplevel (no comments): - $C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) - | (??{ $C_group_rex }) - | " (?: (?> [^\\"]+ ) - | \\. - )* " # String literal - | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal - )* /xs; -} +# Group in C (no support for comments or literals) +$C_group_rex = qr/ [({\[] + (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )* + [)}\]] /x; +# Chunk in C without comma at toplevel (no comments): +$C_arg = qr/ (?: (?> [^()\[\]{},"']+ ) + | (??{ $C_group_rex }) + | " (?: (?> [^\\"]+ ) + | \\. + )* " # String literal + | ' (?: (?> [^\\']+ ) | \\. )* ' # Char literal + )* /xs; + +# "impossible" keyword (multiple newline) +my $END = "!End!\n\n"; +# Match an XS Keyword +my $BLOCK_regexp = '\s*(' . $ExtUtils::ParseXS::Constants::XSKeywordsAlternation . "|$END)\\s*:"; + + sub new { return bless {} => shift; @@ -171,13 +179,6 @@ sub process_file { $self->{typemap} = process_typemaps( $args{typemap}, $pwd ); - my $END = "!End!\n\n"; # "impossible" keyword (multiple newline) - - # Match an XS keyword - $self->{BLOCK_re} = '\s*(' . - join('|' => @ExtUtils::ParseXS::Constants::XSKeywords) . - "|$END)\\s*:"; - # Since at this point we're ready to begin printing to the output file and # reading from the input file, I want to get as much data as possible into # the proto-object $self. That means assigning to $self and elements of @@ -783,7 +784,7 @@ EOF next; } last if $_ eq "$END:"; - $self->death(/^$self->{BLOCK_re}/o ? "Misplaced '$1:'" : "Junk at end of function ($_)"); + $self->death(/^$BLOCK_regexp/o ? "Misplaced '$1:'" : "Junk at end of function ($_)"); } print Q(<<"EOF") if $self->{except}; @@ -1020,7 +1021,7 @@ sub print_section { print("#line ", $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1], " \"", escape_file_for_line_directive($self->{filepathname}), "\"\n") if $self->{WantLineNumbers} && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/; - for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; defined($_) && !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { print "$_\n"; $consumed_code .= "$_\n"; } @@ -1037,7 +1038,7 @@ sub merge_section { $_ = shift(@{ $self->{line} }); } - for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; defined($_) && !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { $in .= "$_\n"; } chomp $in; @@ -1067,7 +1068,7 @@ sub CASE_handler { sub INPUT_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { last if /^\s*NOT_IMPLEMENTED_YET/; next unless /\S/; # skip blank lines @@ -1163,7 +1164,7 @@ sub OUTPUT_handler { $self->{have_OUTPUT} = 1; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) { $self->{DoSetMagic} = ($1 eq "ENABLE" ? 1 : 0); @@ -1302,7 +1303,7 @@ sub ATTRS_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); push @{ $self->{Attributes} }, $_; @@ -1313,7 +1314,7 @@ sub ALIAS_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); $self->get_aliases($_) if $_; @@ -1324,7 +1325,7 @@ sub OVERLOAD_handler { my $self = shift; $_ = shift; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; trim_whitespace($_); while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) { @@ -1400,7 +1401,7 @@ sub PROTOTYPE_handler { $self->death("Error: Only 1 PROTOTYPE definition allowed per xsub") if $self->{proto_in_this_xsub}++; - for (; !/^$self->{BLOCK_re}/o; $_ = shift(@{ $self->{line} })) { + for (; !/^$BLOCK_regexp/o; $_ = shift(@{ $self->{line} })) { next unless /\S/; $specified = 1; trim_whitespace($_); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index ffb9449..f457ba5 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm @@ -39,4 +39,6 @@ our @XSKeywords = qw( EXPORT_XSUB_SYMBOLS ); +our $XSKeywordsAlternation = join('|', @XSKeywords); + 1; -- 2.7.4