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 e87a44d529313dbf9e16a240d9643e6f362290fc
Author: Paul Evans <leon...@leonerd.org.uk>
Date:   Sat Dec 11 23:36:56 2010 +0000

    Import of PEVANS/Parser-MGC-0.02 from CPAN.
    
    gitpan-cpan-distribution: Parser-MGC
    gitpan-cpan-version:      0.02
    gitpan-cpan-path:         PEVANS/Parser-MGC-0.02.tar.gz
    gitpan-cpan-author:       PEVANS
    gitpan-cpan-maturity:     released
---
 Changes               |  9 ++++++++
 MANIFEST              |  1 +
 META.yml              |  4 ++--
 README                | 12 +++++------
 examples/eval-expr.pl | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++
 lib/Parser/MGC.pm     | 37 ++++++++++++++++---------------
 t/02expect.t          |  9 ++++----
 t/10token_int.t       |  4 +++-
 8 files changed, 104 insertions(+), 32 deletions(-)

diff --git a/Changes b/Changes
index 086fef5..6b61864 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,13 @@
 Revision history for Parser-MGC
 
+0.02    CHANGES:
+         * ->expect now returns the consumed string
+         * ->token_int recognises negative integers
+         * ->token_* raises a failure at end-of-scope, rather than returning
+           undef
+
+        BUGFIXES:
+         * 'use overload fallback' to keep Test::More 0.96 happy
+
 0.01    First version, released on an unsuspecting world.
 
diff --git a/MANIFEST b/MANIFEST
index ace5273..eedbeb7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,5 +1,6 @@
 Build.PL
 Changes
+examples/eval-expr.pl
 lib/Parser/MGC.pm
 LICENSE
 Makefile.PL
diff --git a/META.yml b/META.yml
index 4f0c13c..f4262cd 100644
--- a/META.yml
+++ b/META.yml
@@ -15,7 +15,7 @@ name: Parser-MGC
 provides:
   Parser::MGC:
     file: lib/Parser/MGC.pm
-    version: 0.01
+    version: 0.02
 resources:
   license: http://dev.perl.org/licenses/
-version: 0.01
+version: 0.02
diff --git a/README b/README
index c1ac37f..bfd056f 100644
--- a/README
+++ b/README
@@ -117,8 +117,8 @@ STRUCTURE-FORMING METHODS
     whatever the code reference returned.
 
     While the code is being executed, the $stop pattern will be used by the
-    token parsing methods as an end-of-scope marker; causing them to return
-    "undef".
+    token parsing methods as an end-of-scope marker; causing them to raise a
+    failure if called at the end of a scope.
 
   $ret = $parser->list_of( $sep, $code )
     Expects to find a list of instances of something parsed by $code,
@@ -161,17 +161,15 @@ TOKEN PARSING METHODS
     The following methods attempt to consume some part of the input string,
     to be used as part of the parsing process.
 
-    As a convenience for parsing, each of these methods will return undef if
-    the string is already at the end (if "at_eos" returns true).
-
   $parser->expect( $string )
   $parser->expect( qr/pattern/ )
     Expects to find a literal string or regexp pattern match, and consumes
-    it. This method does not return a useful value.
+    it. This method returns the string that was captured.
 
   $int = $parser->token_int
     Expects to find an integer in decimal, octal or hexadecimal notation,
-    and consumes it.
+    and consumes it. Negative integers, preceeded by "-", are also
+    recognised.
 
   $str = $parser->token_string
     Expects to find a quoted string, and consumes it. The string should be
diff --git a/examples/eval-expr.pl b/examples/eval-expr.pl
new file mode 100755
index 0000000..71c2ecb
--- /dev/null
+++ b/examples/eval-expr.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use base qw( Parser::MGC );
+
+sub parse
+{
+   my $self = shift;
+
+   $self->parse_term;
+}
+
+sub parse_term
+{
+   my $self = shift;
+
+   my $lhs = $self->parse_factor;
+
+   $self->one_of(
+      sub { $self->expect( "+" ); $self->commit; $lhs + $self->parse_term },
+      sub { $self->expect( "-" ); $self->commit; $lhs - $self->parse_term },
+      sub { $lhs }
+   );
+}
+
+sub parse_factor
+{
+   my $self = shift;
+
+   my $lhs = $self->parse_atom;
+
+   $self->one_of(
+      sub { $self->expect( "*" ); $self->commit; $lhs * $self->parse_term },
+      sub { $self->expect( "/" ); $self->commit; $lhs / $self->parse_term },
+      sub { $lhs }
+   );
+}
+
+sub parse_atom
+{
+   my $self = shift;
+
+   $self->one_of(
+      sub { $self->scope_of( "(", sub { $self->commit; $self->parse }, ")" ) },
+      sub { $self->token_int },
+   );
+}
+
+use Data::Dump qw( pp );
+
+my $parser = __PACKAGE__->new;
+
+while( defined( my $line = <STDIN> ) ) {
+   my $ret = eval { $parser->from_string( $line ) };
+   print $@ and next if $@;
+
+   print pp( $ret ) . "\n";
+}
diff --git a/lib/Parser/MGC.pm b/lib/Parser/MGC.pm
index 1bd12d0..3b6675b 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.01';
+our $VERSION = '0.02';
 
 use Carp;
 
@@ -303,8 +303,8 @@ C<$code> reference, then expects to find the C<$stop> 
pattern. Returns
 whatever the code reference returned.
 
 While the code is being executed, the C<$stop> pattern will be used by the
-token parsing methods as an end-of-scope marker; causing them to return
-C<undef>.
+token parsing methods as an end-of-scope marker; causing them to raise a
+failure if called at the end of a scope.
 
 =cut
 
@@ -395,7 +395,7 @@ sub one_of
       local $self->{committer} = sub { $committed++ };
 
       my $ret;
-      $ret = eval { shift->( $self ) } and return $ret;
+      eval { $ret = shift->( $self ); 1 } and return $ret;
       my $e = $@;
 
       pos( $self->{str} ) = $pos;
@@ -437,9 +437,6 @@ sub commit
 The following methods attempt to consume some part of the input string, to be
 used as part of the parsing process.
 
-As a convenience for parsing, each of these methods will return undef if the
-string is already at the end (if C<at_eos> returns true).
-
 =cut
 
 sub skip_ws
@@ -458,7 +455,7 @@ sub skip_ws
 =head2 $parser->expect( qr/pattern/ )
 
 Expects to find a literal string or regexp pattern match, and consumes it.
-This method does not return a useful value.
+This method returns the string that was captured.
 
 =cut
 
@@ -470,14 +467,16 @@ sub expect
    ref $expect or $expect = qr/\Q$expect/;
 
    $self->skip_ws;
-   $self->{str} =~ m/\G$expect/gc or
+   $self->{str} =~ m/\G($expect)/gc or
       $self->fail( "Expected $expect" );
+
+   return $1;
 }
 
 =head2 $int = $parser->token_int
 
 Expects to find an integer in decimal, octal or hexadecimal notation, and
-consumes it.
+consumes it. Negative integers, preceeded by C<->, are also recognised.
 
 =cut
 
@@ -485,15 +484,16 @@ sub token_int
 {
    my $self = shift;
 
-   return undef if $self->at_eos;
+   $self->fail( "Expected integer" ) if $self->at_eos;
 
-   $self->{str} =~ m/\G(0x[[:xdigit:]]+|[[:digit:]]+)/gc or
+   $self->{str} =~ m/\G(-?)(0x[[:xdigit:]]+|[[:digit:]]+)/gc or
       $self->fail( "Expected integer" );
 
-   my $int = $1;
+   my $sign = $1 ? -1 : 1;
+   my $int = $2;
 
-   return oct $int if $int =~ m/^0/;
-   return $int;
+   return $sign * oct $int if $int =~ m/^0/;
+   return $sign * $int;
 }
 
 =head2 $str = $parser->token_string
@@ -507,7 +507,7 @@ sub token_string
 {
    my $self = shift;
 
-   return undef if $self->at_eos;
+   $self->fail( "Expected string" ) if $self->at_eos;
 
    my $pos = pos $self->{str};
 
@@ -536,7 +536,7 @@ sub token_ident
 {
    my $self = shift;
 
-   return undef if $self->at_eos;
+   $self->fail( "Expected identifier" ) if $self->at_eos;
 
    $self->{str} =~ m/\G($self->{patterns}{ident})/gc or
       $self->fail( "Expected identifier" );
@@ -590,6 +590,9 @@ sub STRING
           ( " " x $self->{col} . "^" ) . "\n";
 }
 
+# Provide fallback operators for cmp, eq, etc...
+use overload fallback => 1;
+
 # Keep perl happy; keep Britain tidy
 1;
 
diff --git a/t/02expect.t b/t/02expect.t
index df8049b..b5a8e35 100644
--- a/t/02expect.t
+++ b/t/02expect.t
@@ -11,17 +11,16 @@ sub parse
 {
    my $self = shift;
 
-   $self->expect( "hello" );
-   $self->expect( qr/world/ );
-
-   return 1;
+   [ $self->expect( "hello" ), $self->expect( qr/world/ ) ];
 }
 
 package main;
 
 my $parser = TestParser->new;
 
-ok( $parser->from_string( "hello world" ), '"hello world"' );
+is_deeply( $parser->from_string( "hello world" ),
+   [ "hello", "world" ],
+   '"hello world"' );
 
 ok( !eval { $parser->from_string( "goodbye world" ) }, '"goodbye world" fails' 
);
 is( $@,
diff --git a/t/10token_int.t b/t/10token_int.t
index e5cc0ce..cec027d 100644
--- a/t/10token_int.t
+++ b/t/10token_int.t
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 5;
+use Test::More tests => 6;
 
 package TestParser;
 use base qw( Parser::MGC );
@@ -23,4 +23,6 @@ is( $parser->from_string( "0" ),     0, 'Zero' );
 is( $parser->from_string( "0x20" ), 32, 'Hexadecimal integer' );
 is( $parser->from_string( "010" ),   8, 'Octal integer' );
 
+is( $parser->from_string( "-4" ), -4, 'Negative decimal' );
+
 ok( !eval { $parser->from_string( "hello" ) }, '"hello" fails' );

-- 
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

Reply via email to