summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/B/Debug.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/B/Debug.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/B/Debug.pm19
1 files changed, 17 insertions, 2 deletions
diff --git a/Master/tlpkg/tlperl/lib/B/Debug.pm b/Master/tlpkg/tlperl/lib/B/Debug.pm
index fb8db3ff20b..31b0e2834be 100644
--- a/Master/tlpkg/tlperl/lib/B/Debug.pm
+++ b/Master/tlpkg/tlperl/lib/B/Debug.pm
@@ -1,6 +1,6 @@
package B::Debug;
-our $VERSION = '1.17';
+our $VERSION = '1.18';
use strict;
require 5.006;
@@ -285,11 +285,16 @@ EOT
sub B::AV::debug {
my ($av) = @_;
$av->B::SV::debug;
+ _array_debug($av);
+}
+
+sub _array_debug {
+ my ($av) = @_;
# tied arrays may leave out FETCHSIZE
my (@array) = eval { $av->ARRAY; };
print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
my $fill = eval { scalar(@array) };
- if ($Config{'useithreads'}) {
+ if ($Config{'useithreads'} && class($av) ne 'PADLIST') {
printf <<'EOT', $fill, $av->MAX, $av->OFF;
FILL %d
MAX %d
@@ -353,6 +358,15 @@ sub B::SPECIAL::debug {
print exists $specialsv_name[$i] ? $specialsv_name[$i] : "", "\n";
}
+sub B::PADLIST::debug {
+ my ($padlist) = @_;
+ printf <<'EOT', class($padlist), $$padlist, $padlist->REFCNT;
+%s (0x%x)
+ REFCNT %d
+EOT
+ _array_debug($padlist);
+}
+
sub compile {
my $order = shift;
B::clearsym();
@@ -417,3 +431,4 @@ Copyright (c) 2008, 2010 Reini Urban
Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
=cut
+