X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDB.pm;h=7950f652201aa3c9eb01bb46432dd2c921427330;hb=47a7661deb880b9c5c3ea4517c4908096fdff41f;hp=96e436b7e0faec89335e0cf21b50328d29085bbd;hpb=c95f170b203f0b24696b298b0782f4f4c204d444;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/DB.pm b/lib/DB.pm index 96e436b..7950f65 100644 --- a/lib/DB.pm +++ b/lib/DB.pm @@ -41,7 +41,7 @@ BEGIN { $DB::subname = ''; # currently executing sub (fullly qualified name) $DB::lineno = ''; # current line number - $DB::VERSION = $DB::VERSION = '1.0'; + $DB::VERSION = $DB::VERSION = '1.01'; # initialize private globals to avoid warnings @@ -63,8 +63,7 @@ sub sub { push(@stack, $DB::single); $DB::single &= 1; $DB::single |= 4 if $#stack == $deep; -# print $DB::sub, "\n"; - if ($DB::sub =~ /(?:^|::)DESTROY$/ or not defined wantarray) { + if ($DB::sub eq 'DESTROY' or substr($DB::sub, -9) eq '::DESTROY' or not defined wantarray) { &$DB::sub; $DB::single |= pop(@stack); $DB::ret = undef; @@ -93,6 +92,16 @@ sub DB { $usrctxt = "package $DB::package;"; # this won't let them modify, alas local(*DB::dbline) = "::_<$DB::filename"; + + # we need to check for pseudofiles on Mac OS (these are files + # not attached to a filename, but instead stored in Dev:Pseudo) + # since this is done late, $DB::filename will be "wrong" after + # skippkg + if ($^O eq 'MacOS' && $#DB::dbline < 0) { + $DB::filename = 'Dev:Pseudo'; + *DB::dbline = "::_<$DB::filename"; + } + my ($stop, $action); if (($stop,$action) = split(/\0/,$DB::dbline{$DB::lineno})) { if ($stop eq '1') { @@ -546,8 +555,7 @@ __END__ =head1 NAME -DB - programmatic interface to the Perl debugging API (draft, subject to -change) +DB - programmatic interface to the Perl debugging API =head1 SYNOPSIS