[libparser-mgc-perl] 02/12: Import of PEVANS/Parser-MGC-0.02 from CPAN.
Jonas Smedegaard
dr at jones.dk
Sat Dec 17 17:37:00 UTC 2016
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 <leonerd at 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
More information about the Pkg-perl-cvs-commits
mailing list