t/01-constants.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More tests => 20;
   5 use Data::Dumper;
   6
   7 use vars qw($section_1 $section_2 $section_3 $section_4 %options);
   8
   9 use_ok(
  10        "Pod::Constants",
  11        section_1 => \$section_1,
  12        -trim => 1,
  13        section_2 => \$section_2,
  14        section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ },
  15        section_4 => sub { eval },
  16        'command line parameters' => sub {
  17            &Pod::Constants::add_hook
  18                    (
  19                     #-trim => 0,
  20                     '*item' => sub {
  21                         my ($options, $description) =
  22                             m/^(.*?)\n\n(.*)/s;
  23                         my (@options, $longest);
  24                         $longest = "";
  25                         for my $option
  26                             ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) {
  27                             push @options, $option;
  28                             if ( length $option > length $longest) {
  29                                 $longest = $option;
  30                             }
  31                         }
  32                         $longest =~ s/^-*//;
  33                         $options{$longest} =
  34                             {
  35                              options => \@options,
  36                              description => $description,
  37                             };
  38                     }
  39                    )
  40                },
  41       );
  42
  43 # try as hard as we can to get the path to perl
  44 ok($Pod::Constants::VERSION,
  45    "Pod::Constants sets its own VERSION");
  46
  47 BEGIN {
  48     push @INC, "t";
  49 };
  50 # to avoid a warning
  51 if ( 0 ) { $Cheese::foo = $ReEntrancyTest::wohoo = $Cheese::quux; }
  52 eval "use Cheese";
  53
  54 is($section_1, "Down with Pants!\n\n", "no trim from main");
  55 is($section_2, "42", "with trim from main");
  56 is($section_3, "CLANK_EST", "sub");
  57 is($section_4, "touche", "eval");
  58 is($Cheese::foo, "detcepxe", "From module");
  59 is($ReEntrancyTest::wohoo, "Re-entrancy works!", "From module");
  60 is($Cheese::quux, "Blah.", "From module(2)");
  61 like(`$^X -c t/Cheese.pm 2>&1`, qr/syntax OK/, "perl -c module");
  62 like(`$^X -c t/cheese.pl 2>&1`, qr/syntax OK/, "perl -c script");
  63
  64 # test the examples on the man page :)
  65 package Pod::Constants;
  66 Pod::Constants->import (SYNOPSIS => sub {
  67     $main::section_1 = join "\n", map { s/^ //; $_ } split /\n/, $_
  68 });
  69
  70 package main;
  71 open NEWPKG, ">t/TestManPage.pm" or die $!;
  72 # why define your test results when you can read them in from POD?
  73 $section_1 =~ s/myhash\)/myhash %myhash2)/;
  74 $section_1 =~ s/myhash;/myhash, "%myhash\'s value after the above:" => sub { %myhash2 = eval };/;
  75 print NEWPKG "package TestManPage;\n$section_1\n2.818;\n";
  76 close NEWPKG;
  77
  78 use_ok("TestManPage");
  79
  80 is($TestManPage::myvar, 'This string will be loaded into $myvar',
  81    "man page example 1");
  82 is($TestManPage::VERSION, $Pod::Constants::VERSION,
  83    "man page example 2");
  84 ok($TestManPage::VERSION,
  85    "man page example 2 cross-check");
  86 is($TestManPage::myarray[2], 'For example, this is $myarray[2].',
  87    "man page example 3");
  88 my $ok = 0;
  89 while (my ($k, $v) = each %TestManPage::myhash) {
  90     if (exists $TestManPage::myhash2{$k}) { $ok ++ };
  91     if ($v eq $TestManPage::myhash2{$k}) { $ok ++ };
  92 }
  93 is($ok, 4,
  94    "man page example 4");
  95 is(scalar keys %TestManPage::myhash, 2,
  96    "man page example 4 cross-check");
  97 is($TestManPage::html, '<p>This text will be in $html</p>',
  98    "man page example 5");
  99 # supress warnings
 100 $TestManPage::myvar = $TestManPage::html = undef;
 101 @TestManPage::myarray = ();
 102
 103 is($options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook");
 104
 105 =head2 section_1
 106
 107 Down with Pants!
 108
 109 =head2 section_2
 110
 111 42
 112
 113 =head2 section_3
 114
 115 clank_est
 116
 117 =head2 section_4
 118
 119 $section_4 = "touche"
 120
 121 =cut
 122
 123 =head1 command line parameters
 124
 125 the following command line parameters are supported
 126
 127 =item -f, --foo
 128
 129 This does something cool.
 130
 131 =item -h, --help
 132
 133 This also does something pretty cool.
 134
 135 =cut