r33513 - in /branches/upstream/libforks-perl/current: ./ lib/ lib/forks/ lib/forks/Devel/ lib/forks/shared/ lib/threads/shared/ t/
ra28145-guest at users.alioth.debian.org
ra28145-guest at users.alioth.debian.org
Sat Apr 18 13:17:06 UTC 2009
Author: ra28145-guest
Date: Sat Apr 18 13:16:56 2009
New Revision: 33513
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=33513
Log:
[svn-upgrade] Integrating new upstream version, libforks-perl (0.33)
Added:
branches/upstream/libforks-perl/current/lib/forks/Devel/
branches/upstream/libforks-perl/current/lib/forks/Devel/Symdump.pm
Modified:
branches/upstream/libforks-perl/current/CHANGELOG
branches/upstream/libforks-perl/current/MANIFEST
branches/upstream/libforks-perl/current/META.yml
branches/upstream/libforks-perl/current/Makefile.PL
branches/upstream/libforks-perl/current/README
branches/upstream/libforks-perl/current/SIGNATURE
branches/upstream/libforks-perl/current/lib/forks.pm
branches/upstream/libforks-perl/current/lib/forks/shared.pm
branches/upstream/libforks-perl/current/lib/forks/shared/attributes.pm
branches/upstream/libforks-perl/current/lib/forks/shared/global_filter.pm
branches/upstream/libforks-perl/current/lib/forks/signals.pm
branches/upstream/libforks-perl/current/lib/threads/shared/array.pm
branches/upstream/libforks-perl/current/lib/threads/shared/handle.pm
branches/upstream/libforks-perl/current/lib/threads/shared/hash.pm
branches/upstream/libforks-perl/current/lib/threads/shared/scalar.pm
branches/upstream/libforks-perl/current/t/forks08.t
Modified: branches/upstream/libforks-perl/current/CHANGELOG
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/CHANGELOG?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/CHANGELOG (original)
+++ branches/upstream/libforks-perl/current/CHANGELOG Sat Apr 18 13:16:56 2009
@@ -1,3 +1,22 @@
+0.33 April 8 2009
+ ***** Bug fixes *****
+
+ exit() in child process after fork() in user code no longer causes process hang.
+
+ Address issue with Devel::Symdump and internal typeglob reference changes in Perl 5.10.
+
+ ***** Miscellaneous changes *****
+
+ Removed Devel::Required (used only for forks development) from Makefile.PL required
+ modules.
+
+0.32 March 18 2009
+ ***** Miscellaneous changes *****
+
+ Minor change to forks08.t nanosleep usage when not available, to avoid srror.
+
+ Made time tolerances consistent throughout forks08.t.
+
0.31 March 14 2009
***** Threads API consistency changes *****
Modified: branches/upstream/libforks-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/MANIFEST?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/MANIFEST (original)
+++ branches/upstream/libforks-perl/current/MANIFEST Sat Apr 18 13:16:56 2009
@@ -2,6 +2,7 @@
CREDITS
forks.xs
lib/forks.pm
+lib/forks/Devel/Symdump.pm
lib/forks/shared.pm
lib/forks/shared/attributes.pm
lib/forks/shared/global_filter.pm
Modified: branches/upstream/libforks-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/META.yml?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/META.yml (original)
+++ branches/upstream/libforks-perl/current/META.yml Sat Apr 18 13:16:56 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: forks
-version: 0.31
+version: 0.33
abstract: forks - emulate threads with fork
author:
- Eric Rybski (rybskej at yahoo.com)
@@ -11,7 +11,6 @@
requires:
Acme::Damn: 0
Attribute::Handlers: 0
- Devel::Required: 0.07
Devel::Symdump: 0
File::Spec: 0
if: 0
Modified: branches/upstream/libforks-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/Makefile.PL?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/Makefile.PL (original)
+++ branches/upstream/libforks-perl/current/Makefile.PL Sat Apr 18 13:16:56 2009
@@ -138,7 +138,6 @@
PREREQ_PM => {@extra_prereq,qw(
Acme::Damn 0
Attribute::Handlers 0
- Devel::Required 0.07
Devel::Symdump 0
List::MoreUtils 0.15
File::Spec 0
Modified: branches/upstream/libforks-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/README?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/README (original)
+++ branches/upstream/libforks-perl/current/README Sat Apr 18 13:16:56 2009
@@ -1,7 +1,7 @@
README for forks
Version:
- 0.31
+ 0.33
The forks.pm module is a drop-in replacement for threads.pm. It has the
same syntax as the threads.pm module (it even takes over its namespace) but
@@ -26,7 +26,6 @@
Required Modules:
Acme::Damn (any)
Attribute::Handlers (any)
- Devel::Required (0.07)
Devel::Symdump (any)
File::Spec (any)
if (any)
Modified: branches/upstream/libforks-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/SIGNATURE?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/SIGNATURE (original)
+++ branches/upstream/libforks-perl/current/SIGNATURE Sat Apr 18 13:16:56 2009
@@ -14,25 +14,26 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 980b4d7cabacbd64fa34808db7060e63f0ac56ae CHANGELOG
+SHA1 d6fdbd833e0407ed07fe57dd6d697b57f8b84664 CHANGELOG
SHA1 455b7ebe2265a00e97f133c8cd7ebf56148a573d CREDITS
-SHA1 a28ed85caa44cd411af27ec3617a04e09ce84cfe MANIFEST
+SHA1 c918d4ed8f1acf452740801a33f6885e2c47d28e MANIFEST
SHA1 0a40de91b5f4169eef3ff3ef456a40b79d056e78 MANIFEST.skip
-SHA1 ef4f5db148a93b02beefbdacfa31a5d37b1dd780 META.yml
-SHA1 aa50a0d9500f47423bf1b5c6cfb7156c68f69f0c Makefile.PL
-SHA1 d5b16aa6c132a17e5fe50a893e382d639cdad085 README
+SHA1 696fbeb7ffb81e169e77edc28072e005cf54b288 META.yml
+SHA1 24f37b818f36c8c93acf447c05dbb3804a9368ae Makefile.PL
+SHA1 f7d6225860423f7dd7a81c18828dd2cdf2bfb5f3 README
SHA1 10357d353c270dcdad97a24923845201778e97f7 TODO
SHA1 b8554457d862188bf4bce3639881d99617bc4529 VERSION
SHA1 8b16e73ade400e5915771b8548b5a0649911f840 forks.xs
-SHA1 3f3d7f9ebdade248707202b9d02929dfb772b72b lib/forks.pm
-SHA1 d062fe44b924c88e4540d17ff7983def13361259 lib/forks/shared.pm
-SHA1 8a96b3316f429087c57fa532ef8ef565aa989242 lib/forks/shared/attributes.pm
-SHA1 eb84fb6f728c2e36ddfe33e04c05a30f1cada5c7 lib/forks/shared/global_filter.pm
-SHA1 33e1af2dd95ab16f058451e8945805cb82eea7bf lib/forks/signals.pm
-SHA1 31faa19cccb8e28f2f397591a67a9638469896aa lib/threads/shared/array.pm
-SHA1 fd2feea9bba2217a8db4ed1300d81e93d3c33ae5 lib/threads/shared/handle.pm
-SHA1 77ebc9e094e30dcfa80fd75c22ca46f1c359ab63 lib/threads/shared/hash.pm
-SHA1 b9bd0fd11f3d58ac1e7d64e03c6be27566bb955e lib/threads/shared/scalar.pm
+SHA1 99c811e52702ed51e88a5fa8b8a63c1736a502c2 lib/forks.pm
+SHA1 5652c39f2420041f153dfab66fc4a3fc133a025f lib/forks/Devel/Symdump.pm
+SHA1 74e5732b2bc87cbd2e43f9271f8656a987fced7b lib/forks/shared.pm
+SHA1 e3843abed8c10042e611358c6fd814364ccacbac lib/forks/shared/attributes.pm
+SHA1 c3d1005210cd2e4d7bfa84049265502575e66919 lib/forks/shared/global_filter.pm
+SHA1 7854d750f050dfc7647a51c2089fe531dc9a403c lib/forks/signals.pm
+SHA1 a2086fe848ccd84429b6ea56e16a4089ae537e97 lib/threads/shared/array.pm
+SHA1 d551aa10adbc34a19feb657d98ff06c2151dae0c lib/threads/shared/handle.pm
+SHA1 90e06dddf521d4cd1d9f800b820f93d162e9db9e lib/threads/shared/hash.pm
+SHA1 9af7d904161a969ead1ee6ef165820e8b10c2e82 lib/threads/shared/scalar.pm
SHA1 5663394514567cec7cb9537e7ce6682ffdd8e032 ppport.h
SHA1 e0b161c71a2dba88fa7827c54ab597bf29ba2cdb t/forks00-sigtrap.t
SHA1 aa7a677571cc9789653d489bc7cab8fbc091773d t/forks01.t
@@ -42,7 +43,7 @@
SHA1 5c172556a690f58812039b10a243376ec2b9d6e3 t/forks05.t
SHA1 50af07b5275498fd708b4fb2d0de5e28062b33fd t/forks06.t
SHA1 f8dd4f7c16f7ce96cde23f1953737468fa6bad7f t/forks07.t
-SHA1 32673565fbfdf553dcffe8771b48ae1bfa59c41a t/forks08.t
+SHA1 d8f2a6f3c54cb33e454026e0f4c4576e0ff65dfb t/forks08.t
SHA1 b073b28bc806f47dabe93d69dd7e47dc7fe5ee6d t/forks09.t
SHA1 84f14953836fd57500007907d3a30e9813fdfca3 t/forks10.t
SHA1 d45ee162070db10b691958fa140d8fc297bd3d90 t/forks20.t
@@ -50,7 +51,7 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.8 (Darwin)
-iEYEARECAAYFAkm8HcQACgkQQwn7DcpJEO4kmQCbB8L39PxHHHt6pAC48VYCcxR+
-B6oAnisF5WFKuQ37KjTt5kueVh1uaVBB
-=g81x
+iEYEARECAAYFAkncWl4ACgkQQwn7DcpJEO6znwCfc/hINJZS0wuIngd/oHJ1+l8u
+QpUAoIuKk6VMsLtupu0iKKMO8Q99aWtY
+=kjV9
-----END PGP SIGNATURE-----
Modified: branches/upstream/libforks-perl/current/lib/forks.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks.pm (original)
+++ branches/upstream/libforks-perl/current/lib/forks.pm Sat Apr 18 13:16:56 2009
@@ -1,5 +1,5 @@
package forks; # make sure CPAN picks up on forks.pm
-$VERSION = '0.31';
+$VERSION = '0.33';
# Allow external modules to defer shared variable init at require
@@ -89,7 +89,7 @@
use Scalar::Util qw(reftype blessed refaddr);
use File::Spec;
-use Devel::Symdump;
+use forks::Devel::Symdump; # Perl 5.10.x patch for Devel::Symdump 2.08
use Acme::Damn ();
# Set constant for IPC temp dir
@@ -485,6 +485,12 @@
'fallback' => 1,
;
+# Keep reference to pre-existing exit function
+my $old_core_global_exit;
+BEGIN {
+ $old_core_global_exit = sub { CORE::exit(@_) };
+}
+
# Create new() -> create() equivalence
# Initialize thread server at runtime, in case import was skipped
@@ -529,11 +535,16 @@
# Restore signals blocked during fork
# Reset some important state variables
+# Reset CORE::GLOBAL::exit(); will be redefined in _init_thread
POSIX::sigprocmask(SIG_UNBLOCK, $_fork_block_sigset);
delete $ISATHREAD{$$};
undef( $TID );
undef( $PID );
+ {
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit = $old_core_global_exit;
+ }
} #_fork_post_child
# Overload global fork for best protection against external fork.
@@ -1296,11 +1307,6 @@
$HANDLED_INIT = 1;
} #_init
-my $old_core_global_exit;
-BEGIN {
- $old_core_global_exit = \&CORE::GLOBAL::exit;
-}
-
#---------------------------------------------------------------------------
# Default main thread initialization handler
@@ -1331,16 +1337,8 @@
};
# Make this thread 0
-# Overload global exit to conform to ithreads API.
_init_thread(_run_CLONE_SKIP());
- {
- no warnings 'redefine';
- *CORE::GLOBAL::exit = sub {
- threads::_command( '_toexit',$_[0] );
- defined $_[0] ? CORE::exit($_[0]) : CORE::exit();
- };
- }
} #_init_main
#---------------------------------------------------------------------------
@@ -1503,7 +1501,7 @@
$SHUTTING_DOWN_END = 1;
{
no warnings 'redefine';
- *CORE::GLOBAL::exit = $old_core_global_exit if defined $old_core_global_exit;
+ *CORE::GLOBAL::exit = $old_core_global_exit;
}
_command( '_shutdown',$TID )
if CORE::kill(0, $SHARED) && ($TID > 0 || !$MAIN_ABRT_HANDLED);
@@ -2167,8 +2165,16 @@
}
# Reinitialize random number generator (as we're simulating new interpreter creation)
+# Overload global exit to conform to ithreads API (exits all threads).
srand;
+ {
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit = sub {
+ threads::_command( '_toexit',$_[0] );
+ defined $_[0] ? CORE::exit($_[0]) : CORE::exit();
+ };
+ }
return 1;
} #_init_thread
@@ -3661,7 +3667,7 @@
my %result;
$result{pkg} = ['main',
- grep { $_ !~ /^CORE::|::SUPER$/o } Devel::Symdump->rnew->packages];
+ grep { $_ !~ /^CORE::|::SUPER$/o } forks::Devel::Symdump->rnew->packages];
foreach my $package (@{$result{pkg}}) {
my $code;
if (exists $CLONE_SKIP{$package}) {
@@ -3698,7 +3704,7 @@
# Use that
my $clone = shift || { skip => undef, pkg => ['main',
- grep { $_ !~ /^CORE::|::SUPER$/o } Devel::Symdump->rnew->packages]};
+ grep { $_ !~ /^CORE::|::SUPER$/o } forks::Devel::Symdump->rnew->packages]};
CLONE_LOOP: foreach my $package (@{$clone->{pkg}}) {
my $code;
if (exists( $clone->{skip}{$package} ) && $clone->{skip}{$package}) {
@@ -3747,7 +3753,7 @@
=head1 VERSION
-This documentation describes version 0.31.
+This documentation describes version 0.33.
=head1 SYNOPSIS
@@ -3940,7 +3946,6 @@
Acme::Damn (any)
Attribute::Handlers (any)
- Devel::Required (0.07)
Devel::Symdump (any)
File::Spec (any)
if (any)
@@ -4043,7 +4048,7 @@
Otherwise, you will need to manually tell Perl how to map a control of thread to a
TTY. Two undocumented features exist in the Perl debugger:
-1. Define global variable C<$DB::fork_TTY as the first stem in the subroutine for
+1. Define global variable C<$DB::fork_TTY> as the first stem in the subroutine for
a thread. The value must be a valid TTY name, such as '/dev/pts/1' or '/dev/ttys001';
valid names may vary across platforms. For example:
@@ -4140,6 +4145,12 @@
This behavior conforms to the expected behavior of native Perl threads. The
only subtle difference is that the main thread will be signaled using SIGABRT
to immediately exit.
+
+If you call C<fork()> but do not call <threads->isthread()>, then the child
+process will default to the pre-existing CORE::GLOBAL::exit() or CORE::exit()
+behavior. Note that such processes are exempt from application global
+termination if exit() is called in a thread, so you must manually clean up
+child processes created in this manner before exiting your threaded application.
=head2 END block behavior
Added: branches/upstream/libforks-perl/current/lib/forks/Devel/Symdump.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks/Devel/Symdump.pm?rev=33513&op=file
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks/Devel/Symdump.pm (added)
+++ branches/upstream/libforks-perl/current/lib/forks/Devel/Symdump.pm Sat Apr 18 13:16:56 2009
@@ -1,0 +1,482 @@
+package
+ forks::Devel::Symdump; # hide from PAUSE
+
+use 5.003;
+use Carp ();
+use strict;
+use vars qw($Defaults $VERSION *ENTRY $MAX_RECURSION);
+
+$VERSION = '2.08001';
+$MAX_RECURSION = 97;
+
+$Defaults = {
+ 'RECURS' => 0,
+ 'AUTOLOAD' => {
+ 'packages' => 1,
+ 'scalars' => 1,
+ 'arrays' => 1,
+ 'hashes' => 1,
+ 'functions' => 1,
+ 'ios' => 1,
+ 'unknowns' => 1,
+ },
+ 'SEEN' => {},
+ };
+
+sub rnew {
+ my($class, at packages) = @_;
+ no strict "refs";
+ my $self = bless {%${"$class\::Defaults"}}, $class;
+ $self->{RECURS}++;
+ $self->_doit(@packages);
+}
+
+sub new {
+ my($class, at packages) = @_;
+ no strict "refs";
+ my $self = bless {%${"$class\::Defaults"}}, $class;
+ $self->_doit(@packages);
+}
+
+sub _doit {
+ my($self, at packages) = @_;
+ @packages = ("main") unless @packages;
+ $self->{RESULT} = $self->_symdump(@packages);
+ return $self;
+}
+
+sub _symdump {
+ my($self, at packages) = @_ ;
+ my($key,$val,$num,$pack, at todo,$tmp);
+ my $result = {};
+ foreach $pack (@packages){
+ no strict;
+ while (($key,$val) = each(%{*{"$pack\::"}})) {
+ my $gotone = 0;
+
+ #### perl 5.10.x special case: SCALAR? ####
+ if ($] >= 5.010 && defined $val) {
+ if (ref($val) eq 'GLOB') {
+ $result->{$pack}{SCALARS}{$key}++;
+ $gotone++;
+ next;
+ }
+ }
+
+ local(*ENTRY) = $val;
+ #### SCALAR ####
+ if (defined $val && defined *ENTRY{SCALAR}) {
+ $result->{$pack}{SCALARS}{$key}++;
+ $gotone++;
+ }
+ #### ARRAY ####
+ if (defined $val && defined *ENTRY{ARRAY}) {
+ $result->{$pack}{ARRAYS}{$key}++;
+ $gotone++;
+ }
+ #### HASH ####
+ if (defined $val && defined *ENTRY{HASH} && $key !~ /::/) {
+ $result->{$pack}{HASHES}{$key}++;
+ $gotone++;
+ }
+ #### PACKAGE ####
+ if (defined $val && defined *ENTRY{HASH} && $key =~ /::$/ &&
+ $key ne "main::" && $key ne "<none>::") {
+ my($p) = $pack ne "main" ? "$pack\::" : "";
+ ($p .= $key) =~ s/::$//;
+ $result->{$pack}{PACKAGES}{$p}++;
+ $gotone++;
+ if (++$self->{SEEN}{*$val} > $forks::Devel::Symdump::MAX_RECURSION){
+ next;
+ }
+ push @todo, $p;
+ }
+ #### FUNCTION ####
+ if (defined $val && defined *ENTRY{CODE}) {
+ $result->{$pack}{FUNCTIONS}{$key}++;
+ $gotone++;
+ }
+
+ #### IO #### had to change after 5.003_10
+ if ($] > 5.003_10){
+ if (defined $val && defined *ENTRY{IO}){ # fileno and telldir...
+ $result->{$pack}{IOS}{$key}++;
+ $gotone++;
+ }
+ } else {
+ #### FILEHANDLE ####
+ if (defined fileno(ENTRY)){
+ $result->{$pack}{IOS}{$key}++;
+ $gotone++;
+ } elsif (defined telldir(ENTRY)){
+ #### DIRHANDLE ####
+ $result->{$pack}{IOS}{$key}++;
+ $gotone++;
+ }
+ }
+
+ #### SOMETHING ELSE ####
+ unless ($gotone) {
+ $result->{$pack}{UNKNOWNS}{$key}++;
+ }
+ }
+ }
+
+ return (@todo && $self->{RECURS})
+ ? { %$result, %{$self->_symdump(@todo)} }
+ : $result;
+}
+
+sub _partdump {
+ my($self,$part)=@_;
+ my ($pack, @result);
+ my $prepend = "";
+ foreach $pack (keys %{$self->{RESULT}}){
+ $prepend = "$pack\::" unless $part eq 'PACKAGES';
+ push @result, map {"$prepend$_"} keys %{$self->{RESULT}{$pack}{$part} || {}};
+ }
+ return @result;
+}
+
+# this is needed so we don't try to AUTOLOAD the DESTROY method
+sub DESTROY {}
+
+sub as_string {
+ my $self = shift;
+ my($type, at m);
+ for $type (sort keys %{$self->{'AUTOLOAD'}}) {
+ push @m, $type;
+ push @m, "\t" . join "\n\t", map {
+ s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
+ $_;
+ } sort $self->_partdump(uc $type);
+ }
+ return join "\n", @m;
+}
+
+sub as_HTML {
+ my $self = shift;
+ my($type, at m);
+ push @m, "<TABLE>";
+ for $type (sort keys %{$self->{'AUTOLOAD'}}) {
+ push @m, "<TR><TD valign=top><B>$type</B></TD>";
+ push @m, "<TD>" . join ", ", map {
+ s/([\000-\037\177])/ '^' .
+ pack('c', ord($1) ^ 64)
+ /eg; $_;
+ } sort $self->_partdump(uc $type);
+ push @m, "</TD></TR>";
+ }
+ push @m, "</TABLE>";
+ return join "\n", @m;
+}
+
+sub diff {
+ my($self,$second) = @_;
+ my($type, at m);
+ for $type (sort keys %{$self->{'AUTOLOAD'}}) {
+ my(%first,%second,%all,$symbol);
+ foreach $symbol ($self->_partdump(uc $type)){
+ $first{$symbol}++;
+ $all{$symbol}++;
+ }
+ foreach $symbol ($second->_partdump(uc $type)){
+ $second{$symbol}++;
+ $all{$symbol}++;
+ }
+ my(@typediff);
+ foreach $symbol (sort keys %all){
+ next if $first{$symbol} && $second{$symbol};
+ push @typediff, "- $symbol" unless $second{$symbol};
+ push @typediff, "+ $symbol" unless $first{$symbol};
+ }
+ foreach (@typediff) {
+ s/([\000-\037\177])/ '^' . pack('c', ord($1) ^ 64) /eg;
+ }
+ push @m, $type, @typediff if @typediff;
+ }
+ return join "\n", @m;
+}
+
+sub inh_tree {
+ my($self) = @_;
+ return $self->{INHTREE} if ref $self && defined $self->{INHTREE};
+ my($inherited_by) = {};
+ my($m)="";
+ my(@isa) = grep /\bISA$/, forks::Devel::Symdump->rnew->arrays;
+ my $isa;
+ foreach $isa (sort @isa) {
+ $isa =~ s/::ISA$//;
+ my($isaisa);
+ no strict 'refs';
+ foreach $isaisa (@{"$isa\::ISA"}){
+ $inherited_by->{$isaisa}{$isa}++;
+ }
+ }
+ my $item;
+ foreach $item (sort keys %$inherited_by) {
+ $m .= "$item\n";
+ $m .= _inh_tree($item,$inherited_by);
+ }
+ $self->{INHTREE} = $m if ref $self;
+ $m;
+}
+
+sub _inh_tree {
+ my($package,$href,$depth) = @_;
+ return unless defined $href;
+ $depth ||= 0;
+ $depth++;
+ if ($depth > 100){
+ warn "Deep recursion in ISA\n";
+ return;
+ }
+ my($m) = "";
+ # print "DEBUG: package[$package]depth[$depth]\n";
+ my $i;
+ foreach $i (sort keys %{$href->{$package}}) {
+ $m .= qq{\t} x $depth;
+ $m .= qq{$i\n};
+ $m .= _inh_tree($i,$href,$depth);
+ }
+ $m;
+}
+
+sub isa_tree{
+ my($self) = @_;
+ return $self->{ISATREE} if ref $self && defined $self->{ISATREE};
+ my(@isa) = grep /\bISA$/, forks::Devel::Symdump->rnew->arrays;
+ my($m) = "";
+ my($isa);
+ foreach $isa (sort @isa) {
+ $isa =~ s/::ISA$//;
+ $m .= qq{$isa\n};
+ $m .= _isa_tree($isa)
+ }
+ $self->{ISATREE} = $m if ref $self;
+ $m;
+}
+
+sub _isa_tree{
+ my($package,$depth) = @_;
+ $depth ||= 0;
+ $depth++;
+ if ($depth > 100){
+ warn "Deep recursion in ISA\n";
+ return;
+ }
+ my($m) = "";
+ # print "DEBUG: package[$package]depth[$depth]\n";
+ my $isaisa;
+ no strict 'refs';
+ foreach $isaisa (@{"$package\::ISA"}) {
+ $m .= qq{\t} x $depth;
+ $m .= qq{$isaisa\n};
+ $m .= _isa_tree($isaisa,$depth);
+ }
+ $m;
+}
+
+AUTOLOAD {
+ my($self, at packages) = @_;
+ unless (ref $self) {
+ $self = $self->new(@packages);
+ }
+ no strict "vars";
+ (my $auto = $AUTOLOAD) =~ s/.*:://;
+
+ $auto =~ s/(file|dir)handles/ios/;
+ my $compat = $1;
+
+ unless ($self->{'AUTOLOAD'}{$auto}) {
+ Carp::croak("invalid forks::Devel::Symdump method: $auto()");
+ }
+
+ my @syms = $self->_partdump(uc $auto);
+ if (defined $compat) {
+ no strict 'refs';
+ local $^W; # bleadperl at 26631 introduced an io warning here
+ if ($compat eq "file") {
+ @syms = grep { defined(fileno($_)) } @syms;
+ } else {
+ @syms = grep { defined(telldir($_)) } @syms;
+ }
+ }
+ return @syms; # make sure now it gets context right
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+forks::Devel::Symdump - dump symbol names or the symbol table
+
+=head1 SYNOPSIS
+
+ # Constructor
+ require forks::Devel::Symdump;
+ @packs = qw(some_package another_package);
+ $obj = forks::Devel::Symdump->new(@packs); # no recursion
+ $obj = forks::Devel::Symdump->rnew(@packs); # with recursion
+
+ # Methods
+ @array = $obj->packages;
+ @array = $obj->scalars;
+ @array = $obj->arrays;
+ @array = $obj->hashes;
+ @array = $obj->functions;
+ @array = $obj->filehandles; # deprecated, use ios instead
+ @array = $obj->dirhandles; # deprecated, use ios instead
+ @array = $obj->ios;
+ @array = $obj->unknowns; # only perl version < 5.003 had some
+
+ $string = $obj->as_string;
+ $string = $obj->as_HTML;
+ $string = $obj1->diff($obj2);
+
+ $string = forks::Devel::Symdump->isa_tree; # or $obj->isa_tree
+ $string = forks::Devel::Symdump->inh_tree; # or $obj->inh_tree
+
+ # Methods with autogenerated objects
+ # all of those call new(@packs) internally
+ @array = forks::Devel::Symdump->packages(@packs);
+ @array = forks::Devel::Symdump->scalars(@packs);
+ @array = forks::Devel::Symdump->arrays(@packs);
+ @array = forks::Devel::Symdump->hashes(@packs);
+ @array = forks::Devel::Symdump->functions(@packs);
+ @array = forks::Devel::Symdump->ios(@packs);
+ @array = forks::Devel::Symdump->unknowns(@packs);
+
+=head1 DESCRIPTION
+
+This little package serves to access the symbol table of perl.
+
+=over 4
+
+=item C<forks::Devel::Symdump-E<gt>rnew(@packages)>
+
+returns a symbol table object for all subtrees below @packages.
+Nested Modules are analyzed recursively. If no package is given as
+argument, it defaults to C<main>. That means to get the whole symbol
+table, just do a C<rnew> without arguments.
+
+The global variable $forks::Devel::Symdump::MAX_RECURSION limits the
+recursion to prevent contention. The default value is set to 97, just
+low enough to survive the test suite without a warning about deep
+recursion.
+
+=item C<forks::Devel::Symdump-E<gt>new(@packages)>
+
+does not go into recursion and only analyzes the packages that are
+given as arguments.
+
+=item packages, scalars, arrays, hashes, functions, ios
+
+The methods packages(), scalars(), arrays(), hashes(), functions(),
+ios(), and (for older perls) unknowns() each return an array of fully
+qualified symbols of the specified type in all packages that are held
+within a forks::Devel::Symdump object, but without the leading C<$>, C<@> or
+C<%>. In a scalar context, they will return the number of such
+symbols. Unknown symbols are usually either formats or variables that
+haven't yet got a defined value.
+
+=item as_string
+
+=item as_HTML
+
+As_string() and as_HTML() return a simple string/HTML representations
+of the object.
+
+=item diff
+
+Diff() prints the difference between two forks::Devel::Symdump objects in
+human readable form. The format is similar to the one used by the
+as_string method.
+
+=item isa_tree
+
+=item inh_tree
+
+Isa_tree() and inh_tree() both return a simple string representation
+of the current inheritance tree. The difference between the two
+methods is the direction from which the tree is viewed: top-down or
+bottom-up. As I'm sure, many users will have different expectation
+about what is top and what is bottom, I'll provide an example what
+happens when the Socket module is loaded:
+
+=item % print forks::Devel::Symdump-E<gt>inh_tree
+
+ AutoLoader
+ DynaLoader
+ Socket
+ DynaLoader
+ Socket
+ Exporter
+ Carp
+ Config
+ Socket
+
+The inh_tree method shows on the left hand side a package name and
+indented to the right the packages that use the former.
+
+=item % print forks::Devel::Symdump-E<gt>isa_tree
+
+ Carp
+ Exporter
+ Config
+ Exporter
+ DynaLoader
+ AutoLoader
+ Socket
+ Exporter
+ DynaLoader
+ AutoLoader
+
+The isa_tree method displays from left to right ISA relationships, so
+Socket IS A DynaLoader and DynaLoader IS A AutoLoader. (Actually, they
+were at the time this manpage was written)
+
+=back
+
+You may call both methods, isa_tree() and inh_tree(), with an
+object. If you do that, the object will store the output and retrieve
+it when you call the same method again later. The typical usage would
+be to use them as class methods directly though.
+
+=head1 SUBCLASSING
+
+The design of this package is intentionally primitive and allows it to
+be subclassed easily. An example of a (maybe) useful subclass is
+forks::Devel::Symdump::Export, a package which exports all methods of the
+forks::Devel::Symdump package and turns them into functions.
+
+=head1 AUTHORS
+
+Andreas Koenig F<< <andk at cpan.org> >> and Tom Christiansen
+F<< <tchrist at perl.com> >>. Based on the old F<dumpvar.pl> by Larry
+Wall.
+
+=head1 COPYRIGHT, LICENSE
+
+This is a modified version of Devel::Symdump 2.08. It includes custom patches for
+Perl 5.10 compatibiliy.
+
+Original module is
+
+Copyright (c) 1995, 1997, 2000, 2002, 2005, 2006 Andreas Koenig C<< <andk at cpan.org> >>.
+
+All rights reserved.
+
+This library is free software;
+you may use, redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# End:
Modified: branches/upstream/libforks-perl/current/lib/forks/shared.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks/shared.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks/shared.pm (original)
+++ branches/upstream/libforks-perl/current/lib/forks/shared.pm Sat Apr 18 13:16:56 2009
@@ -1,5 +1,5 @@
package forks::shared; # make sure CPAN picks up on forks::shared.pm
-$VERSION = '0.31';
+$VERSION = '0.33';
use Config ();
Modified: branches/upstream/libforks-perl/current/lib/forks/shared/attributes.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks/shared/attributes.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks/shared/attributes.pm (original)
+++ branches/upstream/libforks-perl/current/lib/forks/shared/attributes.pm Sat Apr 18 13:16:56 2009
@@ -1,6 +1,6 @@
package
forks::shared::attributes; #hide from PAUSE
-$VERSION = '0.31';
+$VERSION = '0.33';
use Attribute::Handlers;
Modified: branches/upstream/libforks-perl/current/lib/forks/shared/global_filter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks/shared/global_filter.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks/shared/global_filter.pm (original)
+++ branches/upstream/libforks-perl/current/lib/forks/shared/global_filter.pm Sat Apr 18 13:16:56 2009
@@ -10,7 +10,7 @@
use List::MoreUtils;
use vars '$VERSION';
-$VERSION = '0.31';
+$VERSION = '0.33';
our @FILTER = ();
my @_dummy = (*ARGVOUT);
Modified: branches/upstream/libforks-perl/current/lib/forks/signals.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/forks/signals.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/forks/signals.pm (original)
+++ branches/upstream/libforks-perl/current/lib/forks/signals.pm Sat Apr 18 13:16:56 2009
@@ -1,6 +1,6 @@
package
forks::signals; #hide from PAUSE
-$VERSION = '0.31';
+$VERSION = '0.33';
use strict;
use warnings;
Modified: branches/upstream/libforks-perl/current/lib/threads/shared/array.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/threads/shared/array.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/threads/shared/array.pm (original)
+++ branches/upstream/libforks-perl/current/lib/threads/shared/array.pm Sat Apr 18 13:16:56 2009
@@ -3,7 +3,7 @@
# Make sure we have version info for this module
# Make sure we do everything by the book from now on
-$VERSION = '0.31';
+$VERSION = '0.33';
use strict;
use Scalar::Util;
Modified: branches/upstream/libforks-perl/current/lib/threads/shared/handle.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/threads/shared/handle.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/threads/shared/handle.pm (original)
+++ branches/upstream/libforks-perl/current/lib/threads/shared/handle.pm Sat Apr 18 13:16:56 2009
@@ -3,7 +3,7 @@
# Make sure we have version info for this module
# Make sure we do everything by the book from now on
-$VERSION = '0.31';
+$VERSION = '0.33';
use strict;
# Satisfy -require-
Modified: branches/upstream/libforks-perl/current/lib/threads/shared/hash.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/threads/shared/hash.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/threads/shared/hash.pm (original)
+++ branches/upstream/libforks-perl/current/lib/threads/shared/hash.pm Sat Apr 18 13:16:56 2009
@@ -3,7 +3,7 @@
# Make sure we have version info for this module
# Make sure we do everything by the book from now on
-$VERSION = '0.31';
+$VERSION = '0.33';
use strict;
use Scalar::Util;
Modified: branches/upstream/libforks-perl/current/lib/threads/shared/scalar.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/lib/threads/shared/scalar.pm?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/lib/threads/shared/scalar.pm (original)
+++ branches/upstream/libforks-perl/current/lib/threads/shared/scalar.pm Sat Apr 18 13:16:56 2009
@@ -3,7 +3,7 @@
# Make sure we have version info for this module
# Make sure we do everything by the book from now on
-$VERSION = '0.31';
+$VERSION = '0.33';
use strict;
use Scalar::Util;
Modified: branches/upstream/libforks-perl/current/t/forks08.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libforks-perl/current/t/forks08.t?rev=33513&op=diff
==============================================================================
--- branches/upstream/libforks-perl/current/t/forks08.t (original)
+++ branches/upstream/libforks-perl/current/t/forks08.t Sat Apr 18 13:16:56 2009
@@ -67,29 +67,29 @@
$time = Time::HiRes::sleep 5;
$t1->join();
$time_int = sprintf("%.0f", $time);
-cmp_ok($time_int, '==', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
+cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
# Check that main thread waits full 5 seconds after CHLD signal
SKIP: {
- skip('usleep not supported on this platform',1) unless &Time::HiRes::d_usleep && defined(my $t = eval { Time::HiRes::usleep(0) }) && !$@;
+ skip('usleep not supported on this platform',1) unless &Time::HiRes::d_usleep && defined(my $t = eval { &Time::HiRes::usleep(0) }) && !$@;
$t1 = threads->new(sub { sleep 1; });
- $time = Time::HiRes::usleep 5000000;
+ $time = &Time::HiRes::usleep(5000000);
$t1->join();
$time_int = sprintf("%.0f", $time / 10**6);
- cmp_ok($time_int, '==', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
+ cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
}
# Check that main thread waits full 5 seconds after CHLD signal
SKIP: {
skip('Time::HiRes::nanosleep function not supported on this platform',1)
- unless &Time::HiRes::d_nanosleep && defined(my $t = eval { Time::HiRes::nanosleep(0) }) && !$@;
+ unless &Time::HiRes::d_nanosleep && defined(my $t = eval { &Time::HiRes::nanosleep(0) }) && !$@;
$t1 = threads->new(sub { sleep 1; });
- $time = Time::HiRes::nanosleep 5000000000;
+ $time = &Time::HiRes::nanosleep(5000000000);
$t1->join();
$time_int = sprintf("%.0f", ($time / 10**9));
- cmp_ok($time_int, '==', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
+ cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
}
@@ -100,7 +100,7 @@
$time = sleep 5;
$t1->join();
$time_int = sprintf("%.0f", $time);
-cmp_ok($time_int, '==', 5,'check that main thread sleeps full 5 seconds after custom CHLD signal');
+cmp_ok($time_int, '>=', 5,'check that main thread sleeps full 5 seconds after custom CHLD signal');
cmp_ok($time_int, '<=', 7,'check that main thread did not sleep too long after CHLD signal'); #clock drift / signal delay tolerance
cmp_ok($cnt, '>=', 1,'check that custom CHLD signal was called');
More information about the Pkg-perl-cvs-commits
mailing list