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