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