Skip to content

Commit

Permalink
Localize $Test::Builder::Level before modification.
Browse files Browse the repository at this point in the history
  • Loading branch information
@trwyant
trwyant committed Oct 4, 2023
1 parent a3803c5 commit 450254c
Showing 1 changed file with 15 additions and 15 deletions.
30 changes: 15 additions & 15 deletions inc/My/Module/Test.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -92,7 +92,7 @@ sub cache_count {
$result = PPIx::Regexp->__cache_size();
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is( $result, $expect,
"Should be $expect leftover cache contents" );
}
Expand All @@ -108,7 +108,7 @@ sub klass {
$result = ref $obj || $obj;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( defined $class ) {
my $rslt = isa_ok( $obj, $class )
or diag " Instead, $kind $nav isa $result";
Expand All @@ -129,7 +129,7 @@ sub count {
my $expect = pop @args;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( ARRAY_REF eq ref $parse ) {
$result = @{ $parse };
return is( $result, $expect, "Expect $expect tokens" );
Expand All @@ -151,7 +151,7 @@ sub different {
my ( $left, $right, $name ) = @args;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( ! defined $left && ! defined $right ) {
return ok( undef, $name );
} elsif ( ! defined $left || ! defined $right ) {
Expand All @@ -174,7 +174,7 @@ sub dump_result {
my $got = PPIx::Regexp::Dumper->new( $obj, @args )->string();
# cperl does not seem to like goto &xxx; it throws a deep
# recursion error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is( $got, $expect, $name );
} elsif ( __instance( $result, 'PPIx::Regexp::Tokenizer' ) ||
__instance( $result, 'PPIx::Regexp::Element' ) ) {
Expand All @@ -195,7 +195,7 @@ sub equals {
my ( $left, $right, $name ) = @args;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( ! defined $left && ! defined $right ) {
return ok( 1, $name );
} elsif ( ! defined $left || ! defined $right ) {
Expand Down Expand Up @@ -223,7 +223,7 @@ sub false {
my $class = ref $obj;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( $obj->can( $method ) ) {
$result = $obj->$method( @{ $args } );
my $fmtd = _format_args( $args );
Expand All @@ -240,7 +240,7 @@ sub finis {
$result = PPIx::Regexp::Element->__parent_keys();
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is( $result, 0, 'Should be no leftover objects' );
}

Expand Down Expand Up @@ -308,7 +308,7 @@ sub parse { ## no critic (RequireArgUnpacking)
$opt->{test} or return;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return isa_ok( $parse, 'PPIx::Regexp' );
}

Expand All @@ -325,15 +325,15 @@ sub ppi { ## no critic (RequireArgUnpacking)
}
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return is( $result, $expect, "$kind $nav ppi() content '$safe'" );
}

sub raw_width {
my ( $min, $max, $name ) = @_;
defined $name
or $name = sprintf q<%s '%s'>, ref $obj, $obj->content();
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my @width = $obj->raw_width();
return is( $width[0], $min, "$name raw minimum witdh" ) && is(
$width[1], $max, "$name raw maximum width" );
Expand Down Expand Up @@ -363,7 +363,7 @@ sub tokenize { ## no critic (RequireArgUnpacking)
$result = $parse;
$nav = '';
$opt->{test} or return;
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
return isa_ok( $obj, 'PPIx::Regexp::Tokenizer' );
}

Expand All @@ -374,7 +374,7 @@ sub true { ## no critic (RequireArgUnpacking)
my $class = ref $obj;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( $obj->can( $method ) ) {
$result = $obj->$method( @{ $args } );
my $fmtd = _format_args( $args );
Expand All @@ -394,7 +394,7 @@ sub value { ## no critic (RequireArgUnpacking)
my $class = ref $obj || $obj || $initial_class;
# cperl does not seem to like goto &xxx; it throws a deep recursion
# error if you do it enough times.
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
if ( ! $invocant->can( $method ) ) {
return ok( undef, "$class->$method() exists" );
}
Expand All @@ -418,7 +418,7 @@ sub width {
my ( $min, $max, $name ) = @_;
defined $name
or $name = sprintf q<%s '%s'>, ref $obj, $obj->content();
$Test::Builder::Level = $Test::Builder::Level + 1;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my @width = $obj->width();
return is( $width[0], $min, "$name minimum witdh" ) && is(
$width[1], $max, "$name maximum width" );
Expand Down

0 comments on commit 450254c

Please sign in to comment.