From 9736bf12e7521f7d8a4587c6c4be9c47da39c7cf Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Wed, 20 Oct 2010 16:17:19 -0500 Subject: more tests --- t/01-basic.t | 48 +++++++++++++++++++++++++++++++++++++----------- t/10-errors.t | 45 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 82 insertions(+), 11 deletions(-) create mode 100644 t/10-errors.t (limited to 't') diff --git a/t/01-basic.t b/t/01-basic.t index 82224d9..7856f6e 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -2,22 +2,48 @@ use strict; use warnings; use Test::More; +use Test::Exception; use Eval::Closure; -my $foo = []; +{ + my $code = eval_closure( + source => 'sub { die "called\n" }', + ); + ok($code, "got something"); -my $code = eval_closure( - source => 'sub { push @$bar, @_ }', - environment => { - '$bar' => \$foo, - }, - name => 'test', -); -ok($code, "got something"); + throws_ok { $code->() } qr/^called$/, "got the right thing"; +} -$code->(1); +{ + my $foo = []; -is_deeply($foo, [1], "got the right thing"); + my $code = eval_closure( + source => 'sub { push @$bar, @_ }', + environment => { + '$bar' => \$foo, + }, + name => 'test', + ); + ok($code, "got something"); + + $code->(1); + + is_deeply($foo, [1], "got the right thing"); +} + +{ + my $foo = [1, 2, 3]; + + my $code = eval_closure( + # not sure if strict leaking into evals is intended, i think i remember + # it being changed in newer perls + source => 'do { no strict; sub { $foo } }', + ); + + ok($code, "got something"); + + ok(!$code->(), "environment is clean"); +} done_testing; diff --git a/t/10-errors.t b/t/10-errors.t new file mode 100644 index 0000000..d8925ee --- /dev/null +++ b/t/10-errors.t @@ -0,0 +1,45 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Exception; + +use Eval::Closure; + +throws_ok { + eval_closure() +} qr/'source'.*required/, "error when source isn't declared"; + +throws_ok { + eval_closure( + source => {}, + ) +} qr/'source'.*string or array/, "error when source isn't string or array"; + +throws_ok { + eval_closure( + source => '1', + ) +} qr/'source'.*return.*sub/, "error when source doesn't return a sub"; + +throws_ok { + eval_closure( + source => 'sub { }', + environment => { 'foo' => \1 }, + ) +} qr/should start with \@, \%, or \$/, "error from malformed env"; + +throws_ok { + eval_closure( + source => 'sub { }', + environment => { '$foo' => 1 }, + ) +} qr/must be.*reference/, "error from non-ref value"; + +throws_ok { + eval_closure( + source => '$1++', + ) +} qr/Modification of a read-only value/, "gives us compile errors properly"; + +done_testing; -- cgit v1.2.3-54-g00ecf