From: Rafael Garcia-Suarez Date: Fri, 11 Mar 2005 17:37:01 +0000 (+0000) Subject: Upgrade to Class::ISA 0.33 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6c6f6710d6bf02abf379042f65b7ea75261b772;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Class::ISA 0.33 p4raw-id: //depot/perl@24026 --- diff --git a/MANIFEST b/MANIFEST index 9c508f3..78baed2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1214,7 +1214,9 @@ lib/CGI/Util.pm Utility functions lib/charnames.pm Character names lib/charnames.t See if character names work lib/Class/ISA.pm Class::ISA -lib/Class/ISA/test.pl See if Class::ISA works +lib/Class/ISA/ChangeLog Changes for Class::ISA +lib/Class/ISA/t/00_about_verbose.t Tests for Class::ISA +lib/Class/ISA/t/01_old_junk.t Tests for Class::ISA lib/Class/Struct.pm Declare struct-like datatypes as Perl classes lib/Class/Struct.t See if Class::Struct works lib/complete.pl A command completion subroutine diff --git a/lib/Class/ISA.pm b/lib/Class/ISA.pm index 38bb6c4..e137191 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 0000000..ac18541 --- /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 0000000..0bbdbc2 --- /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 0000000..aaf03ca --- /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 b09e2a9..0000000 --- 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";