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}),
      $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 06:03:26 $
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			]) {
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	wakaba	1.2	$opt{type}, $opt{level},
89			(defined $opt{text} ? ($opt{text}) : ());
90	wakaba	1.1	};
91
92			my $p = Whatpm::WebIDL::Parser->new;
93			my $idl = $p->parse_char_string ($test->{data}, $onerror);
94
95			if (defined $test->{errors}) {
96			$idl->check ($onerror);
97
98			ok join ("\n", sort {$a cmp $b} @errors),
99			join ("\n", sort {$a cmp $b} @{$test->{errors}}), $test->{data};
100			}
101
102			if (defined $test->{document}) {
103			ok $idl->idl_text, $test->{document}, $test->{data};
104			}
105			} # test
106
107			## License: Public Domain.
108	wakaba	1.2	## $Date: 2008/08/02 06:03:26 $