From 7fdc514fb2d9768b3d38d078cf24d9d03403539b Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 1 Aug 2011 23:27:34 -0500 Subject: remove test numbers --- t/01-basic.t | 48 --------------------- t/02-close-over.t | 55 ------------------------ t/03-description.t | 53 ----------------------- t/04-canonicalize-source.t | 31 -------------- t/05-memoize.t | 102 --------------------------------------------- t/10-errors.t | 67 ----------------------------- t/11-debugger.t | 23 ---------- t/basic.t | 48 +++++++++++++++++++++ t/canonicalize-source.t | 31 ++++++++++++++ t/close-over.t | 55 ++++++++++++++++++++++++ t/debugger.t | 23 ++++++++++ t/description.t | 53 +++++++++++++++++++++++ t/errors.t | 67 +++++++++++++++++++++++++++++ t/memoize.t | 102 +++++++++++++++++++++++++++++++++++++++++++++ 14 files changed, 379 insertions(+), 379 deletions(-) delete mode 100644 t/01-basic.t delete mode 100644 t/02-close-over.t delete mode 100644 t/03-description.t delete mode 100644 t/04-canonicalize-source.t delete mode 100644 t/05-memoize.t delete mode 100644 t/10-errors.t delete mode 100644 t/11-debugger.t create mode 100644 t/basic.t create mode 100644 t/canonicalize-source.t create mode 100644 t/close-over.t create mode 100644 t/debugger.t create mode 100644 t/description.t create mode 100644 t/errors.t create mode 100644 t/memoize.t (limited to 't') diff --git a/t/01-basic.t b/t/01-basic.t deleted file mode 100644 index 3a318ac..0000000 --- a/t/01-basic.t +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -use Eval::Closure; - -{ - my $code = eval_closure( - source => 'sub { die "called\n" }', - ); - ok($code, "got something"); - - like(exception { $code->() }, qr/^called$/, "got the right thing"); -} - -{ - my $foo = []; - - my $code = eval_closure( - source => 'sub { push @$bar, @_ }', - environment => { - '$bar' => \$foo, - }, - ); - 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/02-close-over.t b/t/02-close-over.t deleted file mode 100644 index 8a58aa3..0000000 --- a/t/02-close-over.t +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -use Eval::Closure; - -use Test::Requires 'PadWalker'; - -{ - my $foo = []; - my $env = { '$foo' => \$foo }; - - my $code = eval_closure( - source => 'sub { push @$foo, @_ }', - environment => $env, - ); - is_deeply(scalar(PadWalker::closed_over($code)), $env, - "closed over the right things"); -} - -{ - my $foo = {}; - my $bar = []; - my $env = { '$foo' => \$bar, '$bar' => \$foo }; - - my $code = eval_closure( - source => 'sub { push @$foo, @_; $bar->{foo} = \@_ }', - environment => $env, - ); - is_deeply(scalar(PadWalker::closed_over($code)), $env, - "closed over the right things"); -} - -{ - my $foo = []; - my $env = { '$foo' => \$foo }; - - like( - exception { - eval_closure( - source => 'sub { push @$foo, @_; return $__captures }', - environment => $env, - ); - }, - qr/Global symbol "\$__captures/, - "we don't close over \$__captures" - ); -} - -# it'd be nice if we could test that closing over other things wasn't possible, -# but perl's optimizer gets in the way of that - -done_testing; diff --git a/t/03-description.t b/t/03-description.t deleted file mode 100644 index 15a2ce1..0000000 --- a/t/03-description.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -use Eval::Closure; - -my $source = <<'SOURCE'; -sub { - Carp::confess("foo") -} -SOURCE - -{ - my $code = eval_closure( - source => $source, - ); - - like( - exception { $code->() }, - qr/^foo at \(eval \d+\) line \d+\n/, - "no location info if context isn't passed" - ); -} - -{ - my $code = eval_closure( - source => $source, - description => 'accessor foo (defined at Class.pm line 282)', - ); - - like( - exception { $code->() }, - qr/^foo at accessor foo \(defined at Class\.pm line 282\) line 2\n/, - "description is set" - ); -} - -{ - my $code = eval_closure( - source => $source, - line => 100, - description => 'accessor foo (defined at Class.pm line 282)', - ); - - like( - exception { $code->() }, - qr/^foo at accessor foo \(defined at Class\.pm line 282\) line 101\n/, - "description is set" - ); -} -done_testing; diff --git a/t/04-canonicalize-source.t b/t/04-canonicalize-source.t deleted file mode 100644 index 79c08a3..0000000 --- a/t/04-canonicalize-source.t +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; - -use Eval::Closure; - -{ - my $code = eval_closure( - source => - 'sub {' - . '"foo"' - . '}', - ); - ok($code, "got code"); - is($code->(), "foo", "got the right code"); -} - -{ - my $code = eval_closure( - source => [ - 'sub {', - '"foo"', - '}', - ], - ); - ok($code, "got code"); - is($code->(), "foo", "got the right code"); -} - -done_testing; diff --git a/t/05-memoize.t b/t/05-memoize.t deleted file mode 100644 index 02fd11f..0000000 --- a/t/05-memoize.t +++ /dev/null @@ -1,102 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; -use Test::Requires 'Test::Output'; - -use Eval::Closure; - -{ - my $source = 'BEGIN { warn "foo\n" } sub { $foo * 2 }'; - - my $code; - my $bar = 15; - stderr_is { - $code = eval_closure( - source => $source, - environment => { - '$foo' => \$bar, - }, - ); - } "foo\n", "BEGIN was run"; - - is($code->(), 30, "got the right sub"); - - my $code2; - my $baz = 8; - stderr_is { - $code2 = eval_closure( - source => $source, - environment => { - '$foo' => \$baz, - }, - ); - } '', "BEGIN was not run twice"; - - is($code2->(), 16, "got the right sub"); -} - -{ - my $source = 'BEGIN { warn "bar\n" } sub { $bar * 2 }'; - - my $code; - my $foo = 60; - stderr_is { - $code = eval_closure( - source => $source, - environment => { - '$bar' => \$foo, - }, - description => 'foo', - ); - } "bar\n", "BEGIN was run"; - - is($code->(), 120, "got the right sub"); - - my $code2; - my $baz = 23; - { local $TODO = "description breaks memoization"; - stderr_is { - $code2 = eval_closure( - source => $source, - environment => { - '$bar' => \$baz, - }, - description => 'baz', - ); - } '', "BEGIN was not run twice"; - } - - is($code2->(), 46, "got the right sub"); -} - -{ - my $source = 'BEGIN { warn "baz\n" } sub { Carp::confess "baz" }'; - - my $code; - stderr_is { - $code = eval_closure( - source => $source, - description => 'first', - ); - } "baz\n", "BEGIN was run"; - - like(exception { $code->() }, qr/baz at first line 1/, - "got the right description"); - - my $code2; - { local $TODO = "description breaks memoization"; - stderr_is { - $code2 = eval_closure( - source => $source, - description => 'second', - ); - } '', "BEGIN was not run twice"; - } - - like(exception { $code2->() }, qr/baz at second line 1/, - "got the right description"); -} - -done_testing; diff --git a/t/10-errors.t b/t/10-errors.t deleted file mode 100644 index 905d6c8..0000000 --- a/t/10-errors.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -use Eval::Closure; - -like( - exception { eval_closure() }, - qr/'source'.*required/, - "error when source isn't declared" -); - -like( - exception { eval_closure(source => {}) }, - qr/'source'.*string or array/, - "error when source isn't string or array" -); - -like( - exception { eval_closure(source => 1) }, - qr/'source'.*return.*sub/, - "error when source doesn't return a sub" -); - -like( - exception { - eval_closure( - source => 'sub { }', - environment => { 'foo' => \1 }, - ) - }, - qr/should start with \@, \%, or \$/, - "error from malformed env" -); - -like( - exception { - eval_closure( - source => 'sub { }', - environment => { '$foo' => 1 }, - ) - }, - qr/must be.*reference/, - "error from non-ref value" -); - -like( - exception { eval_closure(source => '$1++') }, - qr/Modification of a read-only value/, - "gives us compile errors properly" -); - -like( - exception { eval_closure(source => 'sub { $x }') }, - qr/sub \s* { \s* \$x \s* }/x, - "without terse_error, includes the source code" -); - -unlike( - exception { eval_closure(source => 'sub { $x }', terse_error => 1) }, - qr/sub \s* { \s* \$x \s* }/x, - "with terse_error, does not include the source code" -); - -done_testing; diff --git a/t/11-debugger.t b/t/11-debugger.t deleted file mode 100644 index 7b97272..0000000 --- a/t/11-debugger.t +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Test::More; -use Test::Fatal; - -BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE - -use Eval::Closure; - -unlike( - exception { - eval_closure( - source => 'sub { $bar }', - description => 'foo', - ) - }, - qr/#line/, - "#line directive isn't added when debugger is active" -); - - -done_testing; diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..3a318ac --- /dev/null +++ b/t/basic.t @@ -0,0 +1,48 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Eval::Closure; + +{ + my $code = eval_closure( + source => 'sub { die "called\n" }', + ); + ok($code, "got something"); + + like(exception { $code->() }, qr/^called$/, "got the right thing"); +} + +{ + my $foo = []; + + my $code = eval_closure( + source => 'sub { push @$bar, @_ }', + environment => { + '$bar' => \$foo, + }, + ); + 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/canonicalize-source.t b/t/canonicalize-source.t new file mode 100644 index 0000000..79c08a3 --- /dev/null +++ b/t/canonicalize-source.t @@ -0,0 +1,31 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Eval::Closure; + +{ + my $code = eval_closure( + source => + 'sub {' + . '"foo"' + . '}', + ); + ok($code, "got code"); + is($code->(), "foo", "got the right code"); +} + +{ + my $code = eval_closure( + source => [ + 'sub {', + '"foo"', + '}', + ], + ); + ok($code, "got code"); + is($code->(), "foo", "got the right code"); +} + +done_testing; diff --git a/t/close-over.t b/t/close-over.t new file mode 100644 index 0000000..8a58aa3 --- /dev/null +++ b/t/close-over.t @@ -0,0 +1,55 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Eval::Closure; + +use Test::Requires 'PadWalker'; + +{ + my $foo = []; + my $env = { '$foo' => \$foo }; + + my $code = eval_closure( + source => 'sub { push @$foo, @_ }', + environment => $env, + ); + is_deeply(scalar(PadWalker::closed_over($code)), $env, + "closed over the right things"); +} + +{ + my $foo = {}; + my $bar = []; + my $env = { '$foo' => \$bar, '$bar' => \$foo }; + + my $code = eval_closure( + source => 'sub { push @$foo, @_; $bar->{foo} = \@_ }', + environment => $env, + ); + is_deeply(scalar(PadWalker::closed_over($code)), $env, + "closed over the right things"); +} + +{ + my $foo = []; + my $env = { '$foo' => \$foo }; + + like( + exception { + eval_closure( + source => 'sub { push @$foo, @_; return $__captures }', + environment => $env, + ); + }, + qr/Global symbol "\$__captures/, + "we don't close over \$__captures" + ); +} + +# it'd be nice if we could test that closing over other things wasn't possible, +# but perl's optimizer gets in the way of that + +done_testing; diff --git a/t/debugger.t b/t/debugger.t new file mode 100644 index 0000000..7b97272 --- /dev/null +++ b/t/debugger.t @@ -0,0 +1,23 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +BEGIN { $^P |= 0x210 } # PERLDBf_SUBLINE + +use Eval::Closure; + +unlike( + exception { + eval_closure( + source => 'sub { $bar }', + description => 'foo', + ) + }, + qr/#line/, + "#line directive isn't added when debugger is active" +); + + +done_testing; diff --git a/t/description.t b/t/description.t new file mode 100644 index 0000000..15a2ce1 --- /dev/null +++ b/t/description.t @@ -0,0 +1,53 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Eval::Closure; + +my $source = <<'SOURCE'; +sub { + Carp::confess("foo") +} +SOURCE + +{ + my $code = eval_closure( + source => $source, + ); + + like( + exception { $code->() }, + qr/^foo at \(eval \d+\) line \d+\n/, + "no location info if context isn't passed" + ); +} + +{ + my $code = eval_closure( + source => $source, + description => 'accessor foo (defined at Class.pm line 282)', + ); + + like( + exception { $code->() }, + qr/^foo at accessor foo \(defined at Class\.pm line 282\) line 2\n/, + "description is set" + ); +} + +{ + my $code = eval_closure( + source => $source, + line => 100, + description => 'accessor foo (defined at Class.pm line 282)', + ); + + like( + exception { $code->() }, + qr/^foo at accessor foo \(defined at Class\.pm line 282\) line 101\n/, + "description is set" + ); +} +done_testing; diff --git a/t/errors.t b/t/errors.t new file mode 100644 index 0000000..905d6c8 --- /dev/null +++ b/t/errors.t @@ -0,0 +1,67 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; + +use Eval::Closure; + +like( + exception { eval_closure() }, + qr/'source'.*required/, + "error when source isn't declared" +); + +like( + exception { eval_closure(source => {}) }, + qr/'source'.*string or array/, + "error when source isn't string or array" +); + +like( + exception { eval_closure(source => 1) }, + qr/'source'.*return.*sub/, + "error when source doesn't return a sub" +); + +like( + exception { + eval_closure( + source => 'sub { }', + environment => { 'foo' => \1 }, + ) + }, + qr/should start with \@, \%, or \$/, + "error from malformed env" +); + +like( + exception { + eval_closure( + source => 'sub { }', + environment => { '$foo' => 1 }, + ) + }, + qr/must be.*reference/, + "error from non-ref value" +); + +like( + exception { eval_closure(source => '$1++') }, + qr/Modification of a read-only value/, + "gives us compile errors properly" +); + +like( + exception { eval_closure(source => 'sub { $x }') }, + qr/sub \s* { \s* \$x \s* }/x, + "without terse_error, includes the source code" +); + +unlike( + exception { eval_closure(source => 'sub { $x }', terse_error => 1) }, + qr/sub \s* { \s* \$x \s* }/x, + "with terse_error, does not include the source code" +); + +done_testing; diff --git a/t/memoize.t b/t/memoize.t new file mode 100644 index 0000000..02fd11f --- /dev/null +++ b/t/memoize.t @@ -0,0 +1,102 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; +use Test::Fatal; +use Test::Requires 'Test::Output'; + +use Eval::Closure; + +{ + my $source = 'BEGIN { warn "foo\n" } sub { $foo * 2 }'; + + my $code; + my $bar = 15; + stderr_is { + $code = eval_closure( + source => $source, + environment => { + '$foo' => \$bar, + }, + ); + } "foo\n", "BEGIN was run"; + + is($code->(), 30, "got the right sub"); + + my $code2; + my $baz = 8; + stderr_is { + $code2 = eval_closure( + source => $source, + environment => { + '$foo' => \$baz, + }, + ); + } '', "BEGIN was not run twice"; + + is($code2->(), 16, "got the right sub"); +} + +{ + my $source = 'BEGIN { warn "bar\n" } sub { $bar * 2 }'; + + my $code; + my $foo = 60; + stderr_is { + $code = eval_closure( + source => $source, + environment => { + '$bar' => \$foo, + }, + description => 'foo', + ); + } "bar\n", "BEGIN was run"; + + is($code->(), 120, "got the right sub"); + + my $code2; + my $baz = 23; + { local $TODO = "description breaks memoization"; + stderr_is { + $code2 = eval_closure( + source => $source, + environment => { + '$bar' => \$baz, + }, + description => 'baz', + ); + } '', "BEGIN was not run twice"; + } + + is($code2->(), 46, "got the right sub"); +} + +{ + my $source = 'BEGIN { warn "baz\n" } sub { Carp::confess "baz" }'; + + my $code; + stderr_is { + $code = eval_closure( + source => $source, + description => 'first', + ); + } "baz\n", "BEGIN was run"; + + like(exception { $code->() }, qr/baz at first line 1/, + "got the right description"); + + my $code2; + { local $TODO = "description breaks memoization"; + stderr_is { + $code2 = eval_closure( + source => $source, + description => 'second', + ); + } '', "BEGIN was not run twice"; + } + + like(exception { $code2->() }, qr/baz at second line 1/, + "got the right description"); +} + +done_testing; -- cgit v1.2.3-54-g00ecf