cpan/Pod-Simple/t/accept05.t

   1 # Testing extend and accept_codes
   2 BEGIN {
   3     if($ENV{PERL_CORE}) {
   4         chdir 't';
   5         @INC = '../lib';
   6     }
   7 }
   8
   9 use strict;
  10 use warnings;
  11 use Test;
  12 BEGIN { plan tests => 24 };
  13
  14 #use Pod::Simple::Debug (2);
  15
  16 ok 1;
  17
  18 use Pod::Simple::DumpAsXML;
  19 use Pod::Simple::XMLOutStream;
  20 print "# Pod::Simple version $Pod::Simple::VERSION\n";
  21
  22 BEGIN {
  23   require FindBin;
  24   unshift @INC, $FindBin::Bin . '/lib';
  25   require helpers;
  26   helpers->import;
  27 }
  28
  29 my $x = 'Pod::Simple::XMLOutStream';
  30 sub accept_Q    { $_[0]->accept_codes('Q') }
  31 sub accept_prok { $_[0]->accept_codes('prok') }
  32 sub accept_zing_prok { $_[0]->accept_codes('zing:prok') }
  33 sub accept_zing_superprok { $_[0]->accept_codes('z.i_ng:Prok-12') }
  34 sub accept_zing_superduperprok {
  35   $_[0]->accept_codes('A');
  36   $_[0]->accept_codes('z.i_ng:Prok-12');
  37 }
  38
  39
  40 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  41
  42
  43 print "# Some sanity tests...\n";
  44 ok( $x->_out( "=pod\n\nI like pie.\n"),
  45   '<Document><Para>I like pie.</Para></Document>'
  46 );
  47 ok( $x->_out( "=extend N C Y,W\n\nI like pie.\n"),
  48   '<Document><Para>I like pie.</Para></Document>'
  49 );
  50 ok( $x->_out( "=extend N C,F Y,W\n\nI like pie.\n"),
  51   '<Document><Para>I like pie.</Para></Document>'
  52 );
  53 ok( $x->_out( "=extend N C,F,I Y,W\n\nI like pie.\n"),
  54   '<Document><Para>I like pie.</Para></Document>'
  55 );
  56
  57
  58 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  59
  60
  61 print "## OK, actually trying to use an extended code...\n";
  62
  63 print "# extending but not accepted (so hitting fallback)\n";
  64
  65 ok( $x->_out( "=extend N B Y,W\n\nI N<like> pie.\n"),
  66   '<Document><Para>I <B>like</B> pie.</Para></Document>'
  67 );
  68 ok( $x->_out( "=extend N B,I Y,W\n\nI N<like> pie.\n"),
  69   '<Document><Para>I <B><I>like</I></B> pie.</Para></Document>'
  70 );
  71 ok( $x->_out( "=extend N C,B,I Y,W\n\nI N<like> pie.\n"),
  72   '<Document><Para>I <C><B><I>like</I></B></C> pie.</Para></Document>'
  73 );
  74
  75
  76
  77 print "# extending to one-letter accepted (not hitting fallback)\n";
  78
  79 ok( $x->_out( \&accept_Q, "=extend N B Y,Q,A,bzroch\n\nI N<like> pie.\n"),
  80   '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
  81 );
  82 ok( $x->_out( \&accept_Q, "=extend N B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"),
  83   '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
  84 );
  85 ok( $x->_out( \&accept_Q, "=extend N C,B,I Y,Q,A,bzroch\n\nI N<like> pie.\n"),
  86   '<Document><Para>I <Q>like</Q> pie.</Para></Document>'
  87 );
  88
  89
  90
  91 print "# extending to many-letter accepted (not hitting fallback)\n";
  92
  93 ok( $x->_out( \&accept_prok, "=extend N B Y,prok,A,bzroch\n\nI N<like> pie.\n"),
  94   '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
  95 );
  96 ok( $x->_out( \&accept_prok, "=extend N B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"),
  97   '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
  98 );
  99 ok( $x->_out( \&accept_prok, "=extend N C,B,I Y,prok,A,bzroch\n\nI N<like> pie.\n"),
 100   '<Document><Para>I <prok>like</prok> pie.</Para></Document>'
 101 );
 102
 103
 104
 105 print "# extending to :-containing, many-letter accepted (not hitting fallback)\n";
 106
 107 ok( $x->_out( \&accept_zing_prok, "=extend N B Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
 108   '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
 109 );
 110 ok( $x->_out( \&accept_zing_prok, "=extend N B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
 111   '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
 112 );
 113 ok( $x->_out( \&accept_zing_prok, "=extend N C,B,I Y,zing:prok,A,bzroch\n\nI N<like> pie.\n"),
 114   '<Document><Para>I <zing:prok>like</zing:prok> pie.</Para></Document>'
 115 );
 116
 117
 118
 119
 120 print "# extending to _:-0-9-containing, many-letter accepted (not hitting fallback)\n";
 121
 122 ok( $x->_out( \&accept_zing_superprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 123   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 124 );
 125 ok( $x->_out( \&accept_zing_superprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 126   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 127 );
 128 ok( $x->_out( \&accept_zing_superprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 129   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 130 );
 131
 132
 133
 134 print "#\n# Testing acceptance order\n";
 135
 136 ok( $x->_out( \&accept_zing_superduperprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 137   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 138 );
 139 ok( $x->_out( \&accept_zing_superduperprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 140   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 141 );
 142 ok( $x->_out( \&accept_zing_superduperprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N<like> pie.\n"),
 143   '<Document><Para>I <z.i_ng:Prok-12>like</z.i_ng:Prok-12> pie.</Para></Document>'
 144 );
 145
 146
 147
 148 print "# Wrapping up... one for the road...\n";
 149 ok 1;
 150 print "# --- Done with ", __FILE__, " --- \n";
 151