Move I18N::LangTags from ext/ to dist/
[perl.git] / dist / I18N-LangTags / t / 01_about_verbose.t
1
2 require 5;
3 # Time-stamp: "2004-03-30 17:02:59 AST"
4
5 # Summary of, well, things.
6
7 use Test;
8 BEGIN {plan tests => 2};
9
10 ok 1;
11
12 use I18N::LangTags;
13 use I18N::LangTags::List;
14 use I18N::LangTags::Detect;
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