Upgrade to Class::ISA 0.33

p4raw-id: //depot/perl@24026

5 files changed, 135 insertions, 42 deletions

diff --git a/lib/Class/ISA.pm b/lib/Class/ISA.pm
index 38bb6c47b5..e1371912e2 100644
--- a/lib/Class/ISA.pm
+++ b/lib/Class/ISA.pm
@@ -1,11 +1,11 @@
 #!/usr/local/bin/perl
-# Time-stamp: "2000-05-13 20:03:22 MDT" -*-Perl-*-
+# Time-stamp: "2004-12-29 20:01:02 AST" -*-Perl-*-
 
 package Class::ISA;
 require 5;
 use strict;
 use vars qw($Debug $VERSION);
-$VERSION = 0.32;
+$VERSION = '0.33';
 $Debug = 0 unless defined $Debug;
 
 =head1 NAME
diff --git a/lib/Class/ISA/ChangeLog b/lib/Class/ISA/ChangeLog
new file mode 100644
index 0000000000..ac18541b1e
--- /dev/null
+++ b/lib/Class/ISA/ChangeLog
@@ -0,0 +1,24 @@
+Revision history for Perl extension Class::ISA
+                                        Time-stamp: "2004-12-29 20:00:49 AST"
+
+2004-12-29  Sean M. Burke  sburke@cpan.org
+	
+	* Release 0.33 -- just rebundling.  No code changes.
+	
+	
+2000-05-13  Sean M. Burke  sburke@cpan.org
+
+	* Release 0.32 -- Just noting my new email address.
+
+	
+1999-05-14  Sean M. Burke  sburke@netadventure.net
+
+	* Release 0.31 -- release version.
+
+	No changes in functionality -- just changed the core algorithm to
+	something that should behave the same, but is cleaner and faster.
+
+
+1999-01-23  Sean M. Burke  sburke@netadventure.net
+
+	* Release 0.20 -- first release version.
diff --git a/lib/Class/ISA/t/00_about_verbose.t b/lib/Class/ISA/t/00_about_verbose.t
new file mode 100644
index 0000000000..0bbdbc2f93
--- /dev/null
+++ b/lib/Class/ISA/t/00_about_verbose.t
@@ -0,0 +1,85 @@
+
+require 5;
+# Time-stamp: "2004-12-29 20:57:15 AST"
+# Summary of, well, things.
+
+use Test;
+BEGIN {plan tests => 2};
+ok 1;
+
+use Class::ISA ();
+
+#chdir "t" if -e "t";
+
+{
+  my @out;
+  push @out,
+    "\n\nPerl v",
+    defined($^V) ? sprintf('%vd', $^V) : $],
+    " under $^O ",
+    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
+      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
+    (defined $MacPerl::Version)
+      ? ("(MacPerl version $MacPerl::Version)") : (),
+    "\n"
+  ;
+
+  # Ugly code to walk the symbol tables:
+  my %v;
+  my @stack = ('');  # start out in %::
+  my $this;
+  my $count = 0;
+  my $pref;
+  while(@stack) {
+    $this = shift @stack;
+    die "Too many packages?" if ++$count > 1000;
+    next if exists $v{$this};
+    next if $this eq 'main'; # %main:: is %::
+
+    #print "Peeking at $this => ${$this . '::VERSION'}\n";
+    
+    if(defined ${$this . '::VERSION'} ) {
+      $v{$this} = ${$this . '::VERSION'}
+    } elsif(
+       defined *{$this . '::ISA'} or defined &{$this . '::import'}
+       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
+       # If it has an ISA, an import, or any subs...
+    ) {
+      # It's a class/module with no version.
+      $v{$this} = undef;
+    } else {
+      # It's probably an unpopulated package.
+      ## $v{$this} = '...';
+    }
+    
+    $pref = length($this) ? "$this\::" : '';
+    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
+    #print "Stack: @stack\n";
+  }
+  push @out, " Modules in memory:\n";
+  delete @v{'', '[none]'};
+  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
+    $indent = ' ' x (2 + ($p =~ tr/:/:/));
+    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
+  }
+  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
+    scalar(gmtime), scalar(localtime);
+  my $x = join '', @out;
+  $x =~ s/^/#/mg;
+  print $x;
+}
+
+print "# Running",
+  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
+  "#\n",
+;
+
+print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
+
+print "# \%INC:\n";
+foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
+  print "#   [$x] = [", $INC{$x} || '', "]\n";
+}
+
+ok 1;
+
diff --git a/lib/Class/ISA/t/01_old_junk.t b/lib/Class/ISA/t/01_old_junk.t
new file mode 100644
index 0000000000..aaf03ca924
--- /dev/null
+++ b/lib/Class/ISA/t/01_old_junk.t
@@ -0,0 +1,24 @@
+
+# Time-stamp: "2004-12-29 19:59:33 AST"
+
+BEGIN { $| = 1; print "1..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Class::ISA;
+$loaded = 1;
+print "ok 1\n";
+
+  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
+  @Food::Fish::ISA = qw(Food);
+  @Food::ISA = qw(Matter);
+  @Life::Fungus::ISA = qw(Life);
+  @Chemicals::ISA = qw(Matter);
+  @Life::ISA = qw(Matter);
+  @Matter::ISA = qw();
+
+  use Class::ISA;
+  my @path = Class::ISA::super_path('Food::Fishstick');
+  my $flat_path = join ' ', @path;
+  print "#Food::Fishstick path is:\n# $flat_path\n";
+  print
+   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path ?
+     "ok 2\n" : "fail 2!\n";
diff --git a/lib/Class/ISA/test.pl b/lib/Class/ISA/test.pl
deleted file mode 100644
index b09e2a94a9..0000000000
--- a/lib/Class/ISA/test.pl
+++ /dev/null
@@ -1,40 +0,0 @@
-BEGIN {
-	chdir 't' if -d 't';
-	@INC = '../lib';
-}
-
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..2\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Class::ISA;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
-  @Food::Fish::ISA = qw(Food);
-  @Food::ISA = qw(Matter);
-  @Life::Fungus::ISA = qw(Life);
-  @Chemicals::ISA = qw(Matter);
-  @Life::ISA = qw(Matter);
-  @Matter::ISA = qw();
-
-  use Class::ISA;
-  my @path = Class::ISA::super_path('Food::Fishstick');
-  my $flat_path = join ' ', @path;
-  print "# Food::Fishstick path is:\n# $flat_path\n";
-  print "not " unless
-   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path;
-  print "ok 2\n";