whatpm/t/SWML-Parser.t

#!/usr/bin/perl
use strict;

my $test_dir_name = 't/swml/';

use Test;
BEGIN { plan tests => 1573 }

use Data::Dumper;
$Data::Dumper::Useqq = 1;
sub Data::Dumper::qquote {
  my $s = shift;
  $s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge;
  return q<qq'> . $s . q<'>;
} # Data::Dumper::qquote

use Whatpm::SWML::Parser;
use Whatpm::NanoDOM;
use Whatpm::HTML::Dumper qw/dumptree/;

sub test ($) {
  my $test = shift;

  my $doc = Whatpm::NanoDOM::Document->new;
  my @errors;
  
  $SIG{INT} = sub {
    print scalar dumptree ($doc);
    exit;
  };

  my $onerror = sub {
    my %opt = @_;
    push @errors, join ';',
        $opt{token}->{line} || $opt{line},
        $opt{token}->{column} || $opt{column},
        $opt{type},
        defined $opt{text} ? $opt{text} : '',
        defined $opt{value} ? $opt{value} : '',
        $opt{level};
  };

  my $p = Whatpm::SWML::Parser->new;
  $p->parse_char_string ($test->{data}->[0] => $doc, $onerror);
  my $result = dumptree ($doc);
  
  warn "No #errors section ($test->{data}->[0])" unless $test->{errors};

  @errors = sort {$a cmp $b} @errors;
  @{$test->{errors}->[0]} = sort {$a cmp $b} @{$test->{errors}->[0] ||= []};
  
  ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}),
    'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]);
  
  $test->{document}->[0] .= "\x0A" if length $test->{document}->[0];
  ok $result, $test->{document}->[0],
      'Document tree: ' . Data::Dumper::qquote ($test->{data}->[0]);
} # test

my @FILES = grep {$_} split /\s+/, qq[
  ${test_dir_name}structs-1.dat
  ${test_dir_name}blocks-1.dat
];

require 't/testfiles.pl';
execute_test ($_, {
  data => {is_prefixed => 1},
  errors => {is_list => 1},
  document => {is_prefixed => 1},
}, \&test) for @FILES;

## License: Public Domain.
## $Date: 2008/11/07 04:03:16 $
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			my $test_dir_name = 't/swml/';
5
6			use Test;
7			BEGIN { plan tests => 1573 }
8
9			use Data::Dumper;
10			$Data::Dumper::Useqq = 1;
11			sub Data::Dumper::qquote {
12			my $s = shift;
13			$s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge;
14			return q<qq'> . $s . q<'>;
15			} # Data::Dumper::qquote
16
17			use Whatpm::SWML::Parser;
18			use Whatpm::NanoDOM;
19			use Whatpm::HTML::Dumper qw/dumptree/;
20
21			sub test ($) {
22			my $test = shift;
23
24			my $doc = Whatpm::NanoDOM::Document->new;
25			my @errors;
26
27			$SIG{INT} = sub {
28			print scalar dumptree ($doc);
29			exit;
30			};
31
32			my $onerror = sub {
33			my %opt = @_;
34			push @errors, join ';',
35			$opt{token}->{line} \|\| $opt{line},
36			$opt{token}->{column} \|\| $opt{column},
37			$opt{type},
38			defined $opt{text} ? $opt{text} : '',
39			defined $opt{value} ? $opt{value} : '',
40			$opt{level};
41			};
42
43			my $p = Whatpm::SWML::Parser->new;
44			$p->parse_char_string ($test->{data}->[0] => $doc, $onerror);
45			my $result = dumptree ($doc);
46
47			warn "No #errors section ($test->{data}->[0])" unless $test->{errors};
48
49			@errors = sort {$a cmp $b} @errors;
50			@{$test->{errors}->[0]} = sort {$a cmp $b} @{$test->{errors}->[0] \|\|= []};
51
52			ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}),
53			'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]);
54
55			$test->{document}->[0] .= "\x0A" if length $test->{document}->[0];
56			ok $result, $test->{document}->[0],
57			'Document tree: ' . Data::Dumper::qquote ($test->{data}->[0]);
58			} # test
59
60			my @FILES = grep {$_} split /\s+/, qq[
61			${test_dir_name}structs-1.dat
62	wakaba	1.2	${test_dir_name}blocks-1.dat
63	wakaba	1.1	];
64
65			require 't/testfiles.pl';
66			execute_test ($_, {
67			data => {is_prefixed => 1},
68			errors => {is_list => 1},
69			document => {is_prefixed => 1},
70			}, \&test) for @FILES;
71
72			## License: Public Domain.
73	wakaba	1.2	## $Date: 2008/11/07 04:03:16 $