dslinux/user/perl/lib/Class/ISA/t 00_about_verbose.t 01_old_junk.t
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:31 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Class/ISA/t
In directory antilope:/tmp/cvs-serv17422/lib/Class/ISA/t
Added Files:
00_about_verbose.t 01_old_junk.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: 00_about_verbose.t ---
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
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;
--- NEW FILE: 01_old_junk.t ---
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
# 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";
More information about the dslinux-commit
mailing list