t/testlib.pl

   1 #!perl -T
   2
   3 use 5.010;
   4 use strict;
   5 use warnings;
   6
   7 use Org::Dump;
   8
   9 sub test_parse {
  10     my %args = @_;
  11
  12     my $fe = $args{filter_elements};
  13
  14     subtest $args{name} => sub {
  15         my $orgp = Org::Parser->new();
  16         my $res;
  17         eval {
  18             if ($args{doc}) {
  19                 $res = $orgp->parse($args{doc}, $args{parser_opts});
  20             } elsif ($args{parse_args}) {
  21                 $res = $orgp->parse(@{ $args{parse_args} });
  22             } elsif ($args{parse_file_args}) {
  23                 $res = $orgp->parse_file(@{ $args{parse_file_args} });
  24             } else {
  25                 die "Either doc/parse_args/parse_file_args must be specified";
  26             }
  27         };
  28         my $eval_err = $@;
  29
  30         if ($args{dies}) {
  31             ok($eval_err, "dies") or diag(Org::Dump::dump_element($res));
  32             return;
  33         } else {
  34             ok(!$eval_err, "doesnt die") or diag("died with msg $eval_err");
  35         }
  36
  37         my @elems;
  38         $res->walk(
  39             sub {
  40                 my ($el)   = @_;
  41                 my $eltype = ref($el);
  42                 my $fetype = ref($fe);
  43                 if ($fetype eq 'Regexp') {
  44                     return unless $eltype =~ $args{filter_elements};
  45                 } elsif ($fetype eq 'CODE')  {
  46                     return unless $fe->($el);
  47                 } elsif (!$fetype) {
  48                     return unless $eltype eq $args{filter_elements};
  49                 } else {
  50                     die "BUG: filter_elements cannot be a $fetype";
  51                 }
  52                 push @elems, $el;
  53             }
  54         ) if $fe;
  55
  56         if (defined $args{num}) {
  57             is(scalar(@elems), $args{num}, "num=$args{num}");
  58         }
  59
  60         if ($args{test_after_parse}) {
  61             $args{test_after_parse}->(parser=>$orgp, result=>$res,
  62                                       elements=>\@elems);
  63         }
  64     };
  65 }
  66
  67 1;