whatpm/t/WebIDL.t

#!/usr/bin/perl
use strict;

my $DEBUG = $ENV{DEBUG};

my $dir_name;
my $test_dir_name;
BEGIN {
  $test_dir_name = 't/';
  $dir_name = 't/webidl/';
}

use Test;
BEGIN { plan tests => 1920 }

require Whatpm::WebIDL;

for my $file_name (grep {$_} split /\s+/, qq[
                      ${dir_name}webidl-defs.dat
                      ${dir_name}webidl-interface.dat
                     ]) {
  open my $file, '<', $file_name
    or die "$0: $file_name: $!";
  print "# $file_name\n";

  my $test;
  my $mode = 'data';
  my $escaped;
  while (<$file>) {
    s/\x0D\x0A/\x0A/;
    if (/^#data$/) {
      undef $test;
      $test->{data} = '';
      $mode = 'data';
      undef $escaped;
    } elsif (/^#data escaped$/) {
      undef $test;
      $test->{data} = '';
      $mode = 'data';
      $escaped = 1;
    } elsif (/^#errors$/) {
      $test->{errors} = [];
      $mode = 'errors';
      $test->{data} =~ s/\x0D?\x0A\z//;       
      $test->{data} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
      $test->{data} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;
      undef $escaped;
    } elsif (/^#document$/) {
      $test->{document} = '';
      $mode = 'document';
      undef $escaped;
    } elsif (/^#document escaped$/) {
      $test->{document} = '';
      $mode = 'document';
      $escaped = 1;
    } elsif (defined $test->{document} and /^$/) {
      $test->{document} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
      $test->{document} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;
      test ($test);
      undef $test;
    } elsif (defined $test->{data} and /^$/) {
      test ($test);
      undef $test;
    } else {
      if ($mode eq 'data' or $mode eq 'document') {
        $test->{$mode} .= $_;
      } elsif ($mode eq 'errors') {
        tr/\x0D\x0A//d;
        push @{$test->{errors}}, $_;
      }
    }
  }
  test ($test);
}

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

  $test->{document} =~ s/^\| //;
  $test->{document} =~ s/[\x0D\x0A]\| /\x0A/g;

  my @errors;

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

  my $p = Whatpm::WebIDL::Parser->new;
  my $idl = $p->parse_char_string ($test->{data}, $onerror);

  if (defined $test->{errors}) {
    $idl->check ($onerror);

    ok join ("\n", sort {$a cmp $b} @errors),
        join ("\n", sort {$a cmp $b} @{$test->{errors}}), $test->{data};
  }

  if (defined $test->{document}) {
    ok $idl->idl_text, $test->{document}, $test->{data};
  }
} # test

## License: Public Domain.
## $Date: 2008/08/02 12:51:52 $
1	#!/usr/bin/perl
2	use strict;
3
4	my $DEBUG = $ENV{DEBUG};
5
6	my $dir_name;
7	my $test_dir_name;
8	BEGIN {
9	$test_dir_name = 't/';
10	$dir_name = 't/webidl/';
11	}
12
13	use Test;
14	BEGIN { plan tests => 1920 }
15
16	require Whatpm::WebIDL;
17
18	for my $file_name (grep {$_} split /\s+/, qq[
19	${dir_name}webidl-defs.dat
20	${dir_name}webidl-interface.dat
21	]) {
22	open my $file, '<', $file_name
23	or die "$0: $file_name: $!";
24	print "# $file_name\n";
25
26	my $test;
27	my $mode = 'data';
28	my $escaped;
29	while (<$file>) {
30	s/\x0D\x0A/\x0A/;
31	if (/^#data$/) {
32	undef $test;
33	$test->{data} = '';
34	$mode = 'data';
35	undef $escaped;
36	} elsif (/^#data escaped$/) {
37	undef $test;
38	$test->{data} = '';
39	$mode = 'data';
40	$escaped = 1;
41	} elsif (/^#errors$/) {
42	$test->{errors} = [];
43	$mode = 'errors';
44	$test->{data} =~ s/\x0D?\x0A\z//;
45	$test->{data} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
46	$test->{data} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;
47	undef $escaped;
48	} elsif (/^#document$/) {
49	$test->{document} = '';
50	$mode = 'document';
51	undef $escaped;
52	} elsif (/^#document escaped$/) {
53	$test->{document} = '';
54	$mode = 'document';
55	$escaped = 1;
56	} elsif (defined $test->{document} and /^$/) {
57	$test->{document} =~ s/\\u([0-9A-Fa-f]{4})/chr hex $1/ge if $escaped;
58	$test->{document} =~ s/\\U([0-9A-Fa-f]{8})/chr hex $1/ge if $escaped;
59	test ($test);
60	undef $test;
61	} elsif (defined $test->{data} and /^$/) {
62	test ($test);
63	undef $test;
64	} else {
65	if ($mode eq 'data' or $mode eq 'document') {
66	$test->{$mode} .= $_;
67	} elsif ($mode eq 'errors') {
68	tr/\x0D\x0A//d;
69	push @{$test->{errors}}, $_;
70	}
71	}
72	}
73	test ($test);
74	}
75
76	sub test ($) {
77	my $test = shift;
78
79	$test->{document} =~ s/^\\| //;
80	$test->{document} =~ s/[\x0D\x0A]\\| /\x0A/g;
81
82	my @errors;
83
84	my $onerror = sub {
85	my %opt = @_;
86	push @errors, join ';',
87	($opt{node} ? $opt{node}->get_user_data ('manakai_source_line') \|\| $opt{line} : $opt{line} . '.' . $opt{column}) .
88	(defined $opt{value} ? ':' . $opt{value} : ''),
89	$opt{type}, $opt{level},
90	(defined $opt{text} ? ($opt{text}) : ());
91	};
92
93	my $p = Whatpm::WebIDL::Parser->new;
94	my $idl = $p->parse_char_string ($test->{data}, $onerror);
95
96	if (defined $test->{errors}) {
97	$idl->check ($onerror);
98
99	ok join ("\n", sort {$a cmp $b} @errors),
100	join ("\n", sort {$a cmp $b} @{$test->{errors}}), $test->{data};
101	}
102
103	if (defined $test->{document}) {
104	ok $idl->idl_text, $test->{document}, $test->{data};
105	}
106	} # test
107
108	## License: Public Domain.
109	## $Date: 2008/08/02 12:51:52 $