[Bps-public-commit] r19115 - in Lorzy/trunk: . lib/Lorzy/Lambda t
clkao at bestpractical.com
clkao at bestpractical.com
Thu Apr 9 10:58:44 EDT 2009
Author: clkao
Date: Thu Apr 9 10:58:44 2009
New Revision: 19115
Added:
Lorzy/trunk/lib/Lorzy/Exception.pm
Modified:
Lorzy/trunk/Makefile.PL
Lorzy/trunk/lib/Lorzy/Evaluator.pm
Lorzy/trunk/lib/Lorzy/Lambda.pm
Lorzy/trunk/lib/Lorzy/Lambda/Native.pm
Lorzy/trunk/t/leaky-lexicals.t
Lorzy/trunk/t/named-params.t
Log:
Use exception::class for lorzy exceptions.
Modified: Lorzy/trunk/Makefile.PL
==============================================================================
--- Lorzy/trunk/Makefile.PL (original)
+++ Lorzy/trunk/Makefile.PL Thu Apr 9 10:58:44 2009
@@ -9,7 +9,7 @@
requires 'Module::Pluggable';
requires 'Params::Validate';
-
+requires 'Exception::Class';
build_requires 'Test::More';
build_requires 'Test::Exception';
Modified: Lorzy/trunk/lib/Lorzy/Evaluator.pm
==============================================================================
--- Lorzy/trunk/lib/Lorzy/Evaluator.pm (original)
+++ Lorzy/trunk/lib/Lorzy/Evaluator.pm Thu Apr 9 10:58:44 2009
@@ -5,6 +5,8 @@
use Lorzy::EvaluatorResult;
use Lorzy::Expression;
use Lorzy::Lambda::Native;
+use Lorzy::Exception;
+
use Params::Validate qw/validate validate_pos HASHREF/;
use UNIVERSAL::require;
@@ -76,9 +78,7 @@
$self->result->success(1);
};
- if ( my $err = $@ ) {
- # die $err; # for now
-
+ if (my $err = Lorzy::Exception->caught()) {
$self->result->success(0);
$self->result->value(undef);
$self->result->error($err);
@@ -86,6 +86,13 @@
return $self->result->success;
}
+sub throw_exception {
+ my ($self, $exception, $msg, %args) = @_;
+ $exception->throw( error => $msg,
+ stack => $self->stack_block,
+ %args );
+}
+
sub lookup_lex_name {
my ($self, $name) = @_;
@@ -109,7 +116,7 @@
my ($self, $name) = @_;
Carp::cluck("resolve_symbol_name was called with a reference $name.") if ref $name;
$self->lookup_lex_name($name) || $self->get_global_symbol($name)
- || die "Could not find symbol $name in the current lexical context.";
+ || $self->throw_exception( 'Lorzy::Exception' => "Could not find symbol $name in the current lexical context.");
}
sub apply_script {
@@ -122,6 +129,7 @@
);
my $ret = $lambda->apply($self => $args);
+
$self->result->value($ret);
$self->result->success(1);
return $self->result->value;
Added: Lorzy/trunk/lib/Lorzy/Exception.pm
==============================================================================
--- (empty file)
+++ Lorzy/trunk/lib/Lorzy/Exception.pm Thu Apr 9 10:58:44 2009
@@ -0,0 +1,32 @@
+package Lorzy::Exception;
+use Exception::Class
+ ( 'Lorzy::Exception' =>
+ { fields => ['details', 'stack'] },
+ 'Lorzy::Exception::Native' =>
+ { isa => 'Lorzy::Exception'},
+ 'Lorzy::Exception::Params' =>
+ { isa => 'Lorzy::Exception',
+ fields => ['missing', 'unwanted'] },
+ );
+
+
+sub as_string {
+ my $self = shift;
+ "Lorzy: ".$self->message;
+}
+
+sub stack_as_string {
+ my $self = shift;
+ join("\n", (map { $_->name } reverse @{$self->stack}), '');
+}
+
+package Lorzy::Exception::Params;
+
+sub as_string {
+ my $self = shift;
+ $self->message."\n".
+ (@{$self->missing} ? "The following arguments were missing: " . join(", ", @{$self->missing}) ."\n" : '').
+ (@{$self->unwanted} ? "The following arguments were unwanted: " . join(", ", @{$self->unwanted})."\n" : '');
+}
+
+1;
Modified: Lorzy/trunk/lib/Lorzy/Lambda.pm
==============================================================================
--- Lorzy/trunk/lib/Lorzy/Lambda.pm (original)
+++ Lorzy/trunk/lib/Lorzy/Lambda.pm Thu Apr 9 10:58:44 2009
@@ -1,5 +1,6 @@
package Lorzy::Lambda;
use Moose;
+use Lorzy::Exception;
with 'Lorzy::Block';
@@ -16,6 +17,11 @@
isa => 'HashRef[Lorzy::FunctionArgument]',
);
+sub name {
+ my $self = shift;
+ return 'Lorzy Code #'.$self->block_id;
+}
+
sub check_args {
my $self = shift;
my $passed = shift; #reference to hash of provided args
@@ -41,21 +47,21 @@
}
sub validate_args_or_die {
- my $self = shift;
- my $args = shift;
+ my ($self, $evaluator, $args) = @_;
my ($missing, $unwanted) = $self->check_args($args);
if (keys %$missing || keys %$unwanted) {
- die "Function signature mismatch \n"
- . (keys %$missing ? "The following arguments were missing: " . join(", ", keys %$missing) ."\n" : '')
- . (keys %$unwanted ? "The following arguments were unwanted: " . join(", ", keys %$unwanted)."\n" : '');
+ $evaluator->throw_exception( 'Lorzy::Exception::Params' => "function signature mismatch",
+ missing => [ keys %$missing ],
+ unwanted => [ keys %$unwanted ],
+ );
}
}
sub apply {
my ($self, $evaluator, $args) = @_;
- $self->validate_args_or_die($args);
+ $self->validate_args_or_die($evaluator, $args);
$evaluator->enter_stack_frame(args => $args, block => $self);
my $res = $self->progn->evaluate($evaluator);
Modified: Lorzy/trunk/lib/Lorzy/Lambda/Native.pm
==============================================================================
--- Lorzy/trunk/lib/Lorzy/Lambda/Native.pm (original)
+++ Lorzy/trunk/lib/Lorzy/Lambda/Native.pm Thu Apr 9 10:58:44 2009
@@ -7,12 +7,22 @@
isa => 'CodeRef',
);
+sub name {
+ my $self = shift;
+ return 'Native Code #'.$self->block_id;
+}
+
sub apply {
my ($self, $evaluator, $args) = @_;
- $self->validate_args_or_die($args);
+ $self->validate_args_or_die($evaluator, $args);
+
+# $evaluator->enter_stack_frame(args => $args, block => $self);
my %args = map { $_ => $evaluator->evaluated_result($args->{$_}) }
keys %$args;
- my $r = $self->body->(\%args, $evaluator);
+ my $r = eval { $self->body->(\%args, $evaluator) };
+ $evaluator->throw_exception( 'Lorzy::Exception::Native' => 'failed native code: '.$@ )
+ if $@;
+# $evaluator->leave_stack_frame;
return $r;
}
Modified: Lorzy/trunk/t/leaky-lexicals.t
==============================================================================
--- Lorzy/trunk/t/leaky-lexicals.t (original)
+++ Lorzy/trunk/t/leaky-lexicals.t Thu Apr 9 10:58:44 2009
@@ -38,3 +38,7 @@
$eval->run( $builder->build_expression( { name => 'b', args => { y => 'Y123' }}));
ok (!$eval->result->success);
like($eval->result->error,qr/Could not find symbol y in the current lexical context/);
+
+diag $eval->result->error->stack_as_string;
+
+
Modified: Lorzy/trunk/t/named-params.t
==============================================================================
--- Lorzy/trunk/t/named-params.t (original)
+++ Lorzy/trunk/t/named-params.t Thu Apr 9 10:58:44 2009
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More tests => 13;
use_ok('Lorzy::Lambda');
use_ok('Lorzy::Lambda::Native');
@@ -69,3 +69,10 @@
$eval6->run($match_orz);
ok( !$eval6->result->success, "yay! it failed when we gave it a wrong argument name". $eval6->result->error );
+
+isa_ok($eval6->result->error, "Lorzy::Exception::Params");
+is_deeply($eval6->result->error->unwanted,
+ [ 'wrong-param-name' ]);
+
+is_deeply($eval6->result->error->missing,
+ [ 'regex' ]);
More information about the Bps-public-commit
mailing list