This is an automated email from the git hooks/post-receive script.
js pushed a commit to tag PEVANS
in repository libparser-mgc-perl.
commit 6cecc60f0a808c2c097a3a91fbc02e672a3cc04e
Author: Paul Evans <leon...@leonerd.org.uk>
Date: Wed Jan 5 13:38:33 2011 +0000
Import of PEVANS/Parser-MGC-0.04 from CPAN.
gitpan-cpan-distribution: Parser-MGC
gitpan-cpan-version: 0.04
gitpan-cpan-path: PEVANS/Parser-MGC-0.04.tar.gz
gitpan-cpan-author: PEVANS
gitpan-cpan-maturity: released
---
Changes | 9 ++++++
LICENSE | 6 ++--
MANIFEST | 8 +++--
META.yml | 4 +--
README | 15 +++++++++
examples/synopsis.pl | 26 ++++++++++++++++
lib/Parser/MGC.pm | 53 +++++++++++++++++++++++++++++---
t/10token_int.t | 6 +++-
t/11token_float.t | 45 +++++++++++++++++++++++++++
t/{11token_string.t => 12token_string.t} | 12 +++++++-
t/{12token_ident.t => 13token_ident.t} | 0
t/{13token_kw.t => 14token_kw.t} | 0
12 files changed, 170 insertions(+), 14 deletions(-)
diff --git a/Changes b/Changes
index 58675b5..18985a7 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,14 @@
Revision history for Parser-MGC
+0.04 CHANGES:
+ * Added ->token_float
+ * Optionally parse 0o... ad octal integers
+
+ BUGFIXES:
+ * Match strings non-greedily
+ * Correct exception printing when line indent includes tabs (thanks
+ to Khisanth/#perl)
+
0.03 CHANGES:
* Expanded documentation, more examples
diff --git a/LICENSE b/LICENSE
index bed175a..c441828 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-This software is copyright (c) 2010 by Paul Evans <leon...@leonerd.org.uk>.
+This software is copyright (c) 2011 by Paul Evans <leon...@leonerd.org.uk>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@ b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2010 by Paul Evans <leon...@leonerd.org.uk>.
+This software is Copyright (c) 2011 by Paul Evans <leon...@leonerd.org.uk>.
This is free software, licensed under:
@@ -270,7 +270,7 @@ That's all there is to it!
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2010 by Paul Evans <leon...@leonerd.org.uk>.
+This software is Copyright (c) 2011 by Paul Evans <leon...@leonerd.org.uk>.
This is free software, licensed under:
diff --git a/MANIFEST b/MANIFEST
index eedbeb7..af37bd3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,6 +1,7 @@
Build.PL
Changes
examples/eval-expr.pl
+examples/synopsis.pl
lib/Parser/MGC.pm
LICENSE
Makefile.PL
@@ -13,9 +14,10 @@ t/02expect.t
t/03where.t
t/04comment.t
t/10token_int.t
-t/11token_string.t
-t/12token_ident.t
-t/13token_kw.t
+t/11token_float.t
+t/12token_string.t
+t/13token_ident.t
+t/14token_kw.t
t/20maybe.t
t/21scope_of.t
t/22list_of.t
diff --git a/META.yml b/META.yml
index cb085ae..912d436 100644
--- a/META.yml
+++ b/META.yml
@@ -15,9 +15,9 @@ name: Parser-MGC
provides:
Parser::MGC:
file: lib/Parser/MGC.pm
- version: 0.03
+ version: 0.04
requires:
File::Slurp: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.03
+version: 0.04
diff --git a/README b/README
index 5130c07..4024ed1 100644
--- a/README
+++ b/README
@@ -50,6 +50,10 @@ CONSTRUCTOR
references, to override the default patterns used to match
tokens. See "PATTERNS" below
+ accept_0o_oct => BOOL
+ If true, the "token_int" method will also accept integers with a
+ "0o" prefix as octal.
+
PATTERNS
The following pattern names are recognised. They may be passed to the
constructor in the "patterns" hash, or provided as a class method under
@@ -64,6 +68,12 @@ PATTERNS
Pattern used to skip comments between tokens. Undefined by default.
+ * int
+
+ Pattern used to parse an integer by "token_int". Defaults to
+ "/0x[[:xdigit:]]+|[[:digit:]]+/". If "accept_0o_oct" is given, then
+ this will be expanded to match "/0o[0-7]+/" as well.
+
* ident
Pattern used to parse an identifier by "token_ident". Defaults to
@@ -228,6 +238,11 @@ TOKEN PARSING METHODS
and consumes it. Negative integers, preceeded by "-", are also
recognised.
+ $int = $parser->token_float
+ Expects to find a number expressed in floating-point notation; a
+ sequence of digits possibly prefixed by "-", possibly containing a
+ decimal point.
+
$str = $parser->token_string
Expects to find a quoted string, and consumes it. The string should be
quoted using """ or "'" quote marks.
diff --git a/examples/synopsis.pl b/examples/synopsis.pl
new file mode 100644
index 0000000..4c1cbb4
--- /dev/null
+++ b/examples/synopsis.pl
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+
+package LispParser;
+use base qw( Parser::MGC );
+
+use constant pattern_ident => qr{[[:alnum:]+*/._:-]+};
+
+sub parse
+{
+ my $self = shift;
+
+ $self->sequence_of( sub {
+ $self->one_of(
+ sub { $self->token_int },
+ sub { $self->token_string },
+ sub { \$self->token_ident },
+ sub { $self->scope_of( "(", \&parse, ")" ) }
+ );
+ } );
+}
+
+my $parser = LispParser->new;
+
+use Data::Dump qw( pp );
+print pp( $parser->from_file( $ARGV[0] ) );
diff --git a/lib/Parser/MGC.pm b/lib/Parser/MGC.pm
index fc4039b..73d442f 100644
--- a/lib/Parser/MGC.pm
+++ b/lib/Parser/MGC.pm
@@ -8,7 +8,7 @@ package Parser::MGC;
use strict;
use warnings;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
use Carp;
@@ -76,6 +76,11 @@ Takes the following named arguments
Keys in this hash should map to quoted regexp (C<qr//>) references, to
override the default patterns used to match tokens. See C<PATTERNS> below
+=item accept_0o_oct => BOOL
+
+If true, the C<token_int> method will also accept integers with a C<0o> prefix
+as octal.
+
=back
=cut
@@ -96,6 +101,12 @@ Pattern used to skip whitespace between tokens. Defaults to
C</[\s\n\t]+/>
Pattern used to skip comments between tokens. Undefined by default.
+=item * int
+
+Pattern used to parse an integer by C<token_int>. Defaults to
+C</0x[[:xdigit:]]+|[[:digit:]]+/>. If C<accept_0o_oct> is given, then this
+will be expanded to match C</0o[0-7]+/> as well.
+
=item * ident
Pattern used to parse an identifier by C<token_ident>. Defaults to
@@ -112,6 +123,7 @@ Pattern used to delimit a string by C<token_string>.
Defaults to C</["']/>.
my @patterns = qw(
ws
comment
+ int
ident
string_delim
);
@@ -119,6 +131,7 @@ my @patterns = qw(
use constant {
pattern_ws => qr/[\s\n\t]+/,
pattern_comment => undef,
+ pattern_int => qr/0x[[:xdigit:]]+|[[:digit:]]+/,
pattern_ident => qr/[[:alpha:]_]\w*/,
pattern_string_delim => qr/["']/,
};
@@ -137,6 +150,10 @@ sub new
$self->{patterns}{$_} = $args{patterns}{$_} || $self->${\"pattern_$_"} for
@patterns;
+ if( $args{accept_0o_oct} ) {
+ $self->{patterns}{int} = qr/0o[0-7]+|$self->{patterns}{int}/;
+ }
+
return $self;
}
@@ -542,16 +559,37 @@ sub token_int
$self->fail( "Expected integer" ) if $self->at_eos;
- $self->{str} =~ m/\G(-?)(0x[[:xdigit:]]+|[[:digit:]]+)/gc or
+ $self->{str} =~ m/\G(-?)($self->{patterns}{int})/gc or
$self->fail( "Expected integer" );
my $sign = $1 ? -1 : 1;
my $int = $2;
+ $int =~ s/^0o/0/;
+
return $sign * oct $int if $int =~ m/^0/;
return $sign * $int;
}
+=head2 $int = $parser->token_float
+
+Expects to find a number expressed in floating-point notation; a sequence of
+digits possibly prefixed by C<->, possibly containing a decimal point.
+
+=cut
+
+sub token_float
+{
+ my $self = shift;
+
+ $self->fail( "Expected float" ) if $self->at_eos;
+
+ $self->{str} =~ m/\G(-?(?:\d*\.\d+|\d+\.)(?:e-?\d+)?|-?\d+e-?\d+)/gci or
+ $self->fail( "Expected float" );
+
+ return $1 + 0;
+}
+
=head2 $str = $parser->token_string
Expects to find a quoted string, and consumes it. The string should be quoted
@@ -572,7 +610,7 @@ sub token_string
my $delim = $1;
- $self->{str} =~ m/\G((?:\\.|[^\\])*)$delim/gc or
+ $self->{str} =~ m/\G((?:\\.|[^\\])*?)$delim/gc or
pos($self->{str}) = $pos, $self->fail( "Expected contents of string" );
my $string = $1;
@@ -641,9 +679,16 @@ sub STRING
{
my $self = shift;
+ # Column number only counts characters. There may be tabs in there.
+ # Rather than trying to calculate the visual column number, just print the
+ # indentation as it stands.
+
+ my $indent = substr( $self->{text}, 0, $self->{col} );
+ $indent =~ s/[^ \t]/ /g; # blank out all the non-whitespace
+
return "$self->{message} on line $self->{linenum} at:\n" .
"$self->{text}\n" .
- ( " " x $self->{col} . "^" ) . "\n";
+ "$indent^\n";
}
# Provide fallback operators for cmp, eq, etc...
diff --git a/t/10token_int.t b/t/10token_int.t
index cec027d..943f219 100644
--- a/t/10token_int.t
+++ b/t/10token_int.t
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 6;
+use Test::More tests => 8;
package TestParser;
use base qw( Parser::MGC );
@@ -22,7 +22,11 @@ is( $parser->from_string( "123" ), 123, 'Decimal integer' );
is( $parser->from_string( "0" ), 0, 'Zero' );
is( $parser->from_string( "0x20" ), 32, 'Hexadecimal integer' );
is( $parser->from_string( "010" ), 8, 'Octal integer' );
+ok( !eval { $parser->from_string( "0o20" ) }, '0o prefix fails' );
is( $parser->from_string( "-4" ), -4, 'Negative decimal' );
ok( !eval { $parser->from_string( "hello" ) }, '"hello" fails' );
+
+$parser = TestParser->new( accept_0o_oct => 1 );
+is( $parser->from_string( "0o20" ), 16, 'Octal integer with 0o prefix' );
diff --git a/t/11token_float.t b/t/11token_float.t
new file mode 100644
index 0000000..3746f6b
--- /dev/null
+++ b/t/11token_float.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 13;
+
+package TestParser;
+use base qw( Parser::MGC );
+
+sub parse
+{
+ my $self = shift;
+
+ return $self->token_float;
+}
+
+package main;
+
+my $parser = TestParser->new;
+
+# We're going to be testing floating point values.
+sub approx
+{
+ my ( $got, $exp, $name ) = @_;
+
+ ok( abs( $got - $exp ) < 1E-12, $name ) or
+ diag( "Expected approximately $exp, got $got" );
+}
+
+approx( $parser->from_string( "123.0" ), 123, 'Decimal integer' );
+approx( $parser->from_string( "0.0" ), 0, 'Zero' );
+approx( $parser->from_string( "12." ), 12, 'Trailing DP' );
+approx( $parser->from_string( ".34" ), 0.34, 'Leading DP' );
+approx( $parser->from_string( "8.9" ), 8.9, 'Infix DP' );
+
+approx( $parser->from_string( "-4.0" ), -4, 'Negative decimal' );
+
+approx( $parser->from_string( "1E0" ), 1, 'Scientific without DP' );
+approx( $parser->from_string( "2.0E0" ), 2, 'Scientific with DP' );
+approx( $parser->from_string( "3.E0" ), 3, 'Scientific with trailing DP' );
+approx( $parser->from_string( ".4E1" ), 4, 'Scientific with leading DP' );
+approx( $parser->from_string( "50E-1" ), 5, 'Scientific with negative
exponent without DP' );
+approx( $parser->from_string( "60.0E-1" ), 6, 'Scientific with DP with
negative exponent' );
+
+approx( $parser->from_string( "1e0" ), 1, 'Scientific with lowercase e' );
diff --git a/t/11token_string.t b/t/12token_string.t
similarity index 73%
rename from t/11token_string.t
rename to t/12token_string.t
index 8c164c1..f57b560 100644
--- a/t/11token_string.t
+++ b/t/12token_string.t
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 6;
+use Test::More tests => 7;
package TestParser;
use base qw( Parser::MGC );
@@ -30,3 +30,13 @@ $parser = TestParser->new(
is( $parser->from_string( q["double"] ), "double", 'Double quoted string still
passes' );
ok( !eval { $parser->from_string( q['single'] ) }, 'Single quoted string now
fails' );
+
+no warnings 'redefine';
+local *TestParser::parse = sub {
+ my $self = shift;
+ return [ $self->token_string, $self->token_string ];
+};
+
+is_deeply( $parser->from_string( q["foo" "bar"] ),
+ [ "foo", "bar" ],
+ 'String-matching pattern is non-greedy' );
diff --git a/t/12token_ident.t b/t/13token_ident.t
similarity index 100%
rename from t/12token_ident.t
rename to t/13token_ident.t
diff --git a/t/13token_kw.t b/t/14token_kw.t
similarity index 100%
rename from t/13token_kw.t
rename to t/14token_kw.t
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libparser-mgc-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
