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	#!/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	${test_dir_name}blocks-1.dat
63	];
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	## $Date: 2008/11/07 04:03:16 $