1 2require 5; 3# Time-stamp: "2004-05-23 19:48:32 ADT" 4 5# Summary of, well, things. 6 7BEGIN { 8 if($ENV{PERL_CORE}) { 9 chdir 't'; 10 @INC = '../lib'; 11 } 12} 13 14use strict; 15use warnings; 16use Test; 17my @modules; 18BEGIN { 19 @modules = qw( 20 21Pod::Escapes 22 23Pod::Simple 24Pod::Simple::BlackBox Pod::Simple::Checker Pod::Simple::DumpAsText 25Pod::Simple::DumpAsXML Pod::Simple::HTML Pod::Simple::HTMLBatch 26Pod::Simple::HTMLLegacy Pod::Simple::LinkSection Pod::Simple::Methody 27Pod::Simple::JustPod Pod::Simple::Progress Pod::Simple::PullParser 28Pod::Simple::PullParserEndToken Pod::Simple::PullParserStartToken 29Pod::Simple::PullParserTextToken Pod::Simple::PullParserToken 30Pod::Simple::RTF Pod::Simple::Search Pod::Simple::SimpleTree 31Pod::Simple::Text Pod::Simple::TextContent Pod::Simple::TiedOutFH 32Pod::Simple::Transcode Pod::Simple::XMLOutStream 33 34 ); 35 plan tests => 2 + @modules; 36}; 37 38ok 1; 39 40#chdir "t" if -e "t"; 41foreach my $m (@modules) { 42 print "# Loading $m ...\n"; 43 eval "require $m;"; 44 unless($@) { ok 1; next } 45 my $e = $@; 46 $e =~ s/\s+$//s; 47 $e =~ s/[\n\r]+/\n# > /; 48 print "# Error while trying to load $m --\n# > $e\n"; 49 ok 0; 50} 51 52{ 53 my @out; 54 push @out, 55 "\n\nPerl v", 56 defined($^V) ? sprintf('%vd', $^V) : $], 57 " under $^O ", 58 (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) 59 ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), 60 (defined $MacPerl::Version) 61 ? ("(MacPerl version $MacPerl::Version)") : (), 62 "\n" 63 ; 64 65 # Ugly code to walk the symbol tables: 66 my %v; 67 my @stack = (''); # start out in %:: 68 my $this; 69 my $count = 0; 70 my $pref; 71 while(@stack) { 72 $this = shift @stack; 73 die "Too many packages?" if ++$count > 1000; 74 next if exists $v{$this}; 75 next if $this eq 'main'; # %main:: is %:: 76 77 #print "Peeking at $this => ${$this . '::VERSION'}\n"; 78 no strict 'refs'; 79 if( defined ${$this . '::VERSION'} ) { 80 $v{$this} = ${$this . '::VERSION'} 81 } elsif( 82 defined *{$this . '::ISA'} or defined &{$this . '::import'} 83 or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) 84 # If it has an ISA, an import, or any subs... 85 ) { 86 # It's a class/module with no version. 87 $v{$this} = undef; 88 } else { 89 # It's probably an unpopulated package. 90 ## $v{$this} = '...'; 91 } 92 93 $pref = length($this) ? "$this\::" : ''; 94 push @stack, map m/^(.+)::$/ ? "$pref$1" : (), 95 do { no strict 'refs'; keys %{$this . '::'} }; 96 #print "Stack: @stack\n"; 97 } 98 push @out, " Modules in memory:\n"; 99 delete @v{'', '[none]'}; 100 foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { 101 my $indent = ' ' x (2 + ($p =~ tr/:/:/)); 102 push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; 103 } 104 push @out, sprintf "[at %s (local) / %s (GMT)]\n", 105 scalar(gmtime), scalar(localtime); 106 my $x = join '', @out; 107 $x =~ s/^/#/mg; 108 print $x; 109} 110 111print "# Running", 112 (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", 113 "#\n", 114; 115 116print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; 117 118print "# \%INC:\n"; 119foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { 120 print "# [$x] = [", $INC{$x} || '', "]\n"; 121} 122 123ok 1; 124 125