From: Vincent Pit Date: Fri, 9 Jan 2009 18:28:54 +0000 (+0100) Subject: Factor similar stress level tests in t/81-stress-level.t X-Git-Tag: v0.04~18 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=4106be64bc49ed8698c505798cc260bb8ae242a5;p=perl%2Fmodules%2FScope-Upper.git Factor similar stress level tests in t/81-stress-level.t --- diff --git a/MANIFEST b/MANIFEST index f18a425..7913d05 100644 --- a/MANIFEST +++ b/MANIFEST @@ -24,6 +24,7 @@ t/34-localize_elem-magic.t t/40-localize_delete-target.t t/41-localize_delete-level.t t/44-localize_delete-magic.t +t/81-stress-level.t t/90-boilerplate.t t/91-pod.t t/92-pod-coverage.t diff --git a/t/11-reap-level.t b/t/11-reap-level.t index ccee71b..8880ef3 100644 --- a/t/11-reap-level.t +++ b/t/11-reap-level.t @@ -42,7 +42,7 @@ DIAG } } -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { diff --git a/t/21-localize-level.t b/t/21-localize-level.t index d9cdf97..27effbf 100644 --- a/t/21-localize-level.t +++ b/t/21-localize-level.t @@ -40,7 +40,7 @@ DIAG } } -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { diff --git a/t/31-localize_elem-level.t b/t/31-localize_elem-level.t index 6f73cc4..b95acd6 100644 --- a/t/31-localize_elem-level.t +++ b/t/31-localize_elem-level.t @@ -25,7 +25,7 @@ local $Scope::Upper::TestGenerator::test = sub { our @a; -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { @@ -51,7 +51,7 @@ local $Scope::Upper::TestGenerator::test = sub { our %h; -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { diff --git a/t/41-localize_delete-level.t b/t/41-localize_delete-level.t index b759523..799c055 100644 --- a/t/41-localize_delete-level.t +++ b/t/41-localize_delete-level.t @@ -25,7 +25,7 @@ local $Scope::Upper::TestGenerator::test = sub { our @a; -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { @@ -52,7 +52,7 @@ local $Scope::Upper::TestGenerator::test = sub { our %h; -for my $level (0 .. 4) { +for my $level (0 .. 2) { for my $height ($level + 1 .. $level + 2) { my $tests = Scope::Upper::TestGenerator::gen($height, $level); for (@$tests) { diff --git a/t/81-stress-level.t b/t/81-stress-level.t new file mode 100644 index 0000000..5dd5d43 --- /dev/null +++ b/t/81-stress-level.t @@ -0,0 +1,55 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More 'no_plan'; + +use Scope::Upper qw/reap/; + +use lib 't/lib'; +use Scope::Upper::TestGenerator; + +local $Scope::Upper::TestGenerator::call = sub { + my ($height, $level, $i) = @_; + return [ "reap \\&check => $level;\n" ]; +}; + +local $Scope::Upper::TestGenerator::test = sub { + my ($height, $level, $i) = @_; + my $j = $i < $height - $level ? 1 : 'undef'; + return "is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n"; +}; + +our ($x, $y, $testcase); + +sub check { $y = 0 unless defined $y; ++$y } + +{ + no warnings 'redefine'; + *is = sub ($$;$) { + my ($a, $b, $desc) = @_; + if (defined $testcase + and (defined $b) ? (not defined $a or $a != $b) : defined $a) { + diag <