Commit | Line | Data |
011f4925 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = '../lib'; |
4 | } |
a6c6f671 |
5 | |
6 | require 5; |
7 | # Time-stamp: "2004-12-29 20:57:15 AST" |
8 | # Summary of, well, things. |
9 | |
10 | use Test; |
11 | BEGIN {plan tests => 2}; |
12 | ok 1; |
13 | |
14 | use Class::ISA (); |
15 | |
16 | #chdir "t" if -e "t"; |
17 | |
18 | { |
19 | my @out; |
20 | push @out, |
21 | "\n\nPerl v", |
22 | defined($^V) ? sprintf('%vd', $^V) : $], |
23 | " under $^O ", |
24 | (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) |
25 | ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), |
26 | (defined $MacPerl::Version) |
27 | ? ("(MacPerl version $MacPerl::Version)") : (), |
28 | "\n" |
29 | ; |
30 | |
31 | # Ugly code to walk the symbol tables: |
32 | my %v; |
33 | my @stack = (''); # start out in %:: |
34 | my $this; |
35 | my $count = 0; |
36 | my $pref; |
37 | while(@stack) { |
38 | $this = shift @stack; |
39 | die "Too many packages?" if ++$count > 1000; |
40 | next if exists $v{$this}; |
41 | next if $this eq 'main'; # %main:: is %:: |
42 | |
43 | #print "Peeking at $this => ${$this . '::VERSION'}\n"; |
44 | |
45 | if(defined ${$this . '::VERSION'} ) { |
46 | $v{$this} = ${$this . '::VERSION'} |
47 | } elsif( |
48 | defined *{$this . '::ISA'} or defined &{$this . '::import'} |
49 | or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) |
50 | # If it has an ISA, an import, or any subs... |
51 | ) { |
52 | # It's a class/module with no version. |
53 | $v{$this} = undef; |
54 | } else { |
55 | # It's probably an unpopulated package. |
56 | ## $v{$this} = '...'; |
57 | } |
58 | |
59 | $pref = length($this) ? "$this\::" : ''; |
60 | push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'}; |
61 | #print "Stack: @stack\n"; |
62 | } |
63 | push @out, " Modules in memory:\n"; |
64 | delete @v{'', '[none]'}; |
65 | foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { |
66 | $indent = ' ' x (2 + ($p =~ tr/:/:/)); |
67 | push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; |
68 | } |
69 | push @out, sprintf "[at %s (local) / %s (GMT)]\n", |
70 | scalar(gmtime), scalar(localtime); |
71 | my $x = join '', @out; |
72 | $x =~ s/^/#/mg; |
73 | print $x; |
74 | } |
75 | |
76 | print "# Running", |
77 | (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", |
78 | "#\n", |
79 | ; |
80 | |
81 | print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; |
82 | |
83 | print "# \%INC:\n"; |
84 | foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { |
85 | print "# [$x] = [", $INC{$x} || '', "]\n"; |
86 | } |
87 | |
88 | ok 1; |
89 | |