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