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