view release on metacpan or  search on metacpan

t/lib/MarkdownTests.pm  view on Meta::CPAN

use strict;
use warnings;

package # no_index
  MarkdownTests;

use Test::More 0.88;  # done_testing
use Test::Differences;
use Pod::Markdown ();

use Exporter ();
our @ISA = qw(Exporter);
our @EXPORT = (
  qw(
    convert_ok
    hex_escape
    io_string
    eq_or_diff
    slurp_file
    test_parser
    warning
    with_and_without_entities
  ),
  @Test::More::EXPORT
);

sub import {
  my $class = shift;
  Test::More::plan(@_) if @_;
  @_ = ($class);
  strict->import;
  warnings->import;
  goto &Exporter::import;
}

sub hex_escape {
  local $_ = $_[0];
  s/([^\x20-\x7e])/sprintf "\\x{%x}", ord $1/ge;
  return $_;
}

sub diag_xml {
  diag_with('Pod::Simple::DumpAsXML', @_);
}

sub diag_text {
  diag_with('Pod::Simple::DumpAsText', @_);
}

sub diag_with {
  my ($class, $pod) = @_;
  $class =~ /[^a-zA-Z0-9:]/ and die "Invalid class name '$class'";
  eval "require $class" or die $@;
  my $parser = $class->new;
  $parser->output_string(\(my $got));
  $parser->parse_string_document("=pod\n\n$pod\n");
  diag $got;
}

sub hash_string {
  my $h = $_[0];
  return join ', ', map { "$_: $h->{$_}" } sort keys %$h;
}

sub convert_ok {
  local $Test::Builder::Level = $Test::Builder::Level + 1;
  my ($pod, $exp, $desc, %opts) = @_;
  my %attr   = %{ $opts{attr} || {} };
  my $parser = test_parser(%attr);
  my $prefix = $opts{prefix} || '';
  my $podenc = ($opts{encoding} ? "=encoding $opts{encoding}\n\n" : '');

  if( $opts{verbose} ){
    $desc .= " \t" . hex_escape "($pod => $exp)";
    $desc .= join ' ', ' (', hash_string(\%attr), ')' if keys %attr;
    $desc .= " =encoding $opts{encoding}" if $podenc;
  }

  diag_xml($pod)  if $opts{diag_xml};
  diag_text($pod) if $opts{diag_text};

  $opts{init}->($parser) if $opts{init};

  $parser->output_string(\(my $got));
  $parser->parse_string_document("$podenc=pod\n\n$prefix$pod\n\n=cut\n");

  # Chomp both ends.
  for ($got, $exp) {
    s/^\n+//;
    s/\n+$//;
  }