Permalink
Browse files

Update B-Debug to CPAN version 1.26

  [DELTA]

1.26 2017-12-03 rurban
  * Avoid too many -I when calling subprocess (sprout, RT#123816)
  • Loading branch information...
bingos committed Dec 12, 2017
1 parent 2bcf6e5 commit 8bdc12c655eff532a15400c4aec1d1b308f4bf15
Showing with 11 additions and 10 deletions.
  1. +1 −1 Porting/Maintainers.pl
  2. +1 −1 cpan/B-Debug/Debug.pm
  3. +9 −8 cpan/B-Debug/t/debug.t
View
@@ -173,7 +173,7 @@ package Maintainers;
},
'B::Debug' => {
'DISTRIBUTION' => 'RURBAN/B-Debug-1.25.tar.gz',
'DISTRIBUTION' => 'RURBAN/B-Debug-1.26.tar.gz',
'FILES' => q[cpan/B-Debug],
'EXCLUDED' => ['t/pod.t'],
'DEPRECATED' => '5.027003',
View
@@ -1,6 +1,6 @@
package B::Debug;
our $VERSION = '1.25';
our $VERSION = '1.26';
BEGIN { if ($] >= 5.027001) { require deprecate; import deprecate; } }
use strict;
View
@@ -32,17 +32,18 @@ use File::Spec;
my $a;
my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
my $path = join " ", map { qq["-I$_"] } (File::Spec->catfile("blib","lib"), @INC);
local $ENV{PERL5LIB} =
join $Config{path_sep}, File::Spec->catfile("blib","lib"), @INC;
my $redir = $^O =~ /VMS|MSWin32|MacOS/ ? "" : "2>&1";
$a = `$X $path "-MO=Debug" -e 1 $redir`;
$a = `$X "-MO=Debug" -e 1 $redir`;
like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
$a = `$X $path "-MO=Terse" -e 1 $redir`;
$a = `$X "-MO=Terse" -e 1 $redir`;
like($a, qr/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s);
$a = `$X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
$a = `$X "-MO=Terse" -ane "s/foo/bar/" $redir`;
$a =~ s/\(0x[^)]+\)//g;
$a =~ s/\[[^\]]+\]//g;
$a =~ s/-e syntax OK//;
@@ -81,22 +82,22 @@ is($a, $b);
like(B::Debug::_printop(B::main_root), qr/LISTOP\s+\[OP_LEAVE\]/);
like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/);
$a = `$X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
$a = `$X "-MO=Debug" -e "B::main_root->debug" $redir`;
like($a, qr/op_next\s+0x0/m);
$a = `$X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
$a = `$X "-MO=Debug" -e "B::main_start->debug" $redir`;
like($a, qr/\[OP_ENTER\]/m);
# pass missing FETCHSIZE, fixed with 1.06
my $e = q(BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};print $a[1]);
$a = `$X $path "-MO=Debug" -e"$e" $redir`;
$a = `$X "-MO=Debug" -e"$e" $redir`;
unlike($a, qr/locate object method "FETCHSIZE"/m);
# NV assertion with CV, fixed with 1.13
my $tmp = "tmp.pl";
open TMP, ">", $tmp;
print TMP 'my $p=1;$g=2;sub p($){my $i=1;$i+1};print p(0)+$g;';
close TMP;
$a = `$X $path "-MO=Debug" $tmp $redir`;
$a = `$X "-MO=Debug" $tmp $redir`;
ok(! $?);
unlike($a, qr/assertion "SvTYPE(sv) != SVt_PVCV" failed.*function: S_sv_2iuv_common/m);
unlike($a, qr/Use of uninitialized value in print/m);

0 comments on commit 8bdc12c

Please sign in to comment.