"Fossies" - the Fresh Open Source Software Archive

Member "perl-5.32.1/cpan/Pod-Simple/t/00about.t" (18 Dec 2020, 3201 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:

    1 
    2 require 5;
    3 # Time-stamp: "2004-05-23 19:48:32 ADT"
    4 
    5 # Summary of, well, things.
    6 
    7 BEGIN {
    8     if($ENV{PERL_CORE}) {
    9         chdir 't';
   10         @INC = '../lib';
   11     }
   12 }
   13 
   14 use strict;
   15 use Test;
   16 my @modules;
   17 BEGIN {
   18   @modules = qw(
   19 
   20 Pod::Escapes
   21 
   22 Pod::Simple	
   23 Pod::Simple::BlackBox	Pod::Simple::Checker	Pod::Simple::DumpAsText
   24 Pod::Simple::DumpAsXML	Pod::Simple::HTML	Pod::Simple::HTMLBatch
   25 Pod::Simple::HTMLLegacy	Pod::Simple::LinkSection	Pod::Simple::Methody
   26 Pod::Simple::JustPod	Pod::Simple::Progress	Pod::Simple::PullParser
   27 Pod::Simple::PullParserEndToken	Pod::Simple::PullParserStartToken
   28 Pod::Simple::PullParserTextToken	Pod::Simple::PullParserToken
   29 Pod::Simple::RTF	Pod::Simple::Search	Pod::Simple::SimpleTree
   30 Pod::Simple::Text	Pod::Simple::TextContent	Pod::Simple::TiedOutFH
   31 Pod::Simple::Transcode	Pod::Simple::XMLOutStream
   32 
   33   );
   34   plan tests => 2 + @modules;
   35 };
   36 
   37 ok 1;
   38 
   39 #chdir "t" if -e "t";
   40 foreach 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 
  110 print "# Running",
  111   (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
  112   "#\n",
  113 ;
  114 
  115 print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
  116 
  117 print "# \%INC:\n";
  118 foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
  119   print "#   [$x] = [", $INC{$x} || '', "]\n";
  120 }
  121 
  122 ok 1;
  123