git.maemo.org Git - pkg-perl/blob - deb-src/libpod-simple-perl/libpod-simple-perl-3.07/t/accept01.t

   1 # Testing 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 => 13 };
  12
  13 #use Pod::Simple::Debug (6);
  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_N { $_[0]->accept_codes('N') }
  24
  25 print "# Some sanity tests...\n";
  26 ok( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor
  27   '<Document><Para>I like pie.</Para></Document>'
  28 );
  29 ok( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"),
  30   '<Document><Para>I like pie.</Para></Document>'
  31 );
  32 ok( $x->_out( "=pod\n\nB<foo\t>\n"), # without acceptor
  33   '<Document><Para><B>foo </B></Para></Document>'
  34 );
  35 ok( $x->_out( \&accept_N,  "=pod\n\nB<foo\t>\n"),
  36   '<Document><Para><B>foo </B></Para></Document>'
  37 );
  38
  39 print "# Some real tests...\n";
  40
  41 ok( $x->_out( \&accept_N,  "=pod\n\nN<foo\t>\n"),
  42   '<Document><Para><N>foo </N></Para></Document>'
  43 );
  44 ok( $x->_out( \&accept_N,  "=pod\n\nB<N<foo\t>>\n"),
  45   '<Document><Para><B><N>foo </N></B></Para></Document>'
  46 );
  47 ok( $x->_out( "=pod\n\nB<N<foo\t>>\n") # without the mutor
  48   ne '<Document><Para><B><N>foo </N></B></Para></Document>'
  49   # make sure it DOESN'T pass thru the N<...> when not accepted
  50 );
  51 ok( $x->_out( \&accept_N,  "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"),
  52   '<Document><Para><B>pie<F>zorch</F><N>foo</N><I>pling</I></B></Para></Document>'
  53 );
  54
  55 print "# Tests of nonacceptance...\n";
  56
  57 sub starts_with {
  58   my($large, $small) = @_;
  59   print("# supahstring is undef\n"),
  60    return '' unless defined $large;
  61   print("# supahstring $large is smaller than target-starter $small\n"),
  62    return '' if length($large) < length($small);
  63   if( substr($large, 0, length($small)) eq $small ) {
  64     #print "# Supahstring $large\n#  indeed starts with $small\n";
  65     return 1;
  66   } else {
  67     print "# Supahstring $large\n#  !starts w/ $small\n";
  68     return '';
  69   }
  70 }
  71
  72
  73 ok( starts_with( $x->_out( "=pod\n\nB<N<foo\t>>\n"), # without the mutor
  74   '<Document><Para><B>foo </B></Para>'
  75   # make sure it DOESN'T pass thru the N<...>, when not accepted
  76 ));
  77
  78 ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<foo>I<pling>>\n"), # !mutor
  79   '<Document><Para><B>pie<F>zorch</F>foo<I>pling</I></B></Para>'
  80   # make sure it DOESN'T pass thru the N<...>, when not accepted
  81 ));
  82
  83 ok( starts_with( $x->_out( "=pod\n\nB<pieF<zorch>N<C<foo>>I<pling>>\n"), # !mutor
  84   '<Document><Para><B>pie<F>zorch</F><C>foo</C><I>pling</I></B></Para>'
  85   # make sure it DOESN'T pass thru the N<...>, when not accepted
  86 ));
  87
  88
  89
  90
  91
  92 print "# Wrapping up... one for the road...\n";
  93 ok 1;
  94 print "# --- Done with ", __FILE__, " --- \n";
  95