whatpm/t/CSS-Parser-1.t

#!/usr/bin/perl
use strict;

use lib qw[/home/wakaba/work/manakai2/lib]; ## TODO: ...

use Test;

BEGIN { plan tests => 2210 }

require Whatpm::CSS::Parser;
require Message::DOM::Window;

require Message::DOM::DOMImplementation;
my $dom = Message::DOM::DOMImplementation->new;

my $DefaultComputed;
my $DefaultComputedText;

for my $file_name (map {"t/$_"} qw(
  css-1.dat
  css-2.dat
  css-3.dat
  css-4.dat
  css-visual.dat
  css-generated.dat
  css-paged.dat
  css-text.dat
  css-font.dat
  css-table.dat
  css-interactive.dat
)) {
  print "# $file_name\n";
  open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";

  my $all_test = {document => {}, test => []};
  my $test;
  my $mode = 'data';
  my $doc_id;
  my $selectors;
  while (<$file>) {
    s/\x0D\x0A/\x0A/;
    if (/^#data$/) {
      undef $test;
      $test->{data} = '';
      push @{$all_test->{test}}, $test;
      $mode = 'data';
    } elsif (/#(csstext|cssom)$/) {
      $test->{$1} = '';
      $mode = $1;
    } elsif (/#(computed(?>text)?) (\S+) (.+)$/) {
      $test->{$1}->{$doc_id = $2}->{$selectors = $3} = '';
      $mode = $1;
    } elsif (/^#html (\S+)$/) {
      undef $test;
      $test->{format} = 'html';
      $test->{data} = '';
      $all_test->{document}->{$1} = $test;
      $mode = 'data';
    } elsif (/^#errors$/) {
      $test->{errors} = [];
      $mode = 'errors';
      $test->{data} =~ s/\x0D?\x0A\z//;
    } elsif (/^#option q$/) {
      $test->{option}->{parse_mode} = 'q';
    } elsif (defined $test->{data} and /^$/) {
      undef $test;
    } else {
      if ({data => 1, cssom => 1, csstext => 1}->{$mode}) {
        $test->{$mode} .= $_;
      } elsif ($mode eq 'computed' or $mode eq 'computedtext') {
        $test->{$mode}->{$doc_id}->{$selectors} .= $_;
      } elsif ($mode eq 'errors') {
        tr/\x0D\x0A//d;
        push @{$test->{errors}}, $_;
      } else {
        die "Line $.: $_";
      }
    }
  }

  for my $data (values %{$all_test->{document}}) {
    if ($data->{format} eq 'html') {
      my $doc = $dom->create_document;
      $doc->manakai_is_html (1);
      $doc->inner_html ($data->{data});
      $data->{document} = $doc;
    } else {
      die "Test data format $data->{format} is not supported";
    }
  }

  for my $test (@{$all_test->{test}}) {
    my ($p, $css_options) = get_parser ($test->{option}->{parse_mode});

    my @actual_error;
    $p->{onerror} = sub {
      my (%opt) = @_;
      my $uri = ${$opt{uri}};
      $uri =~ s[^thismessage:/][];
      push @actual_error, join ';',
          $uri, $opt{token}->{line}, $opt{token}->{column},
          $opt{level},
          $opt{type} .
          (defined $opt{text} ? ';'.$opt{text} : '');
    };

    my $ss = $p->parse_char_string ($test->{data});

    ok ((join "\n", @actual_error), (join "\n", @{$test->{errors} or []}),
        "#result ($test->{data})");

    if (defined $test->{cssom}) {
      my $actual = serialize_cssom ($ss);
      ok $actual, $test->{cssom}, "#cssom ($test->{data})";
    }

    if (defined $test->{csstext}) {
      my $actual = $ss->css_text;
      ok $actual, $test->{csstext}, "#csstext ($test->{data})";
    }

    for my $doc_id (keys %{$test->{computed} or {}}) {
      for my $selectors (keys %{$test->{computed}->{$doc_id}}) {
        my ($window, $style) = get_computed_style
            ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
        ## NOTE: $window is the root object, so that we must keep it 
        ## referenced in this block.
        
        my $actual = serialize_style ($style, '');
        my $expected = $DefaultComputed;
        my $diff = $test->{computed}->{$doc_id}->{$selectors};
        ($actual, $expected) = apply_diff ($actual, $expected, $diff);
        ok $actual, $expected,
            "#computed $doc_id $selectors ($test->{data})";
      }
    }

    for my $doc_id (keys %{$test->{computedtext} or {}}) {
      for my $selectors (keys %{$test->{computedtext}->{$doc_id}}) {
        my ($window, $style) = get_computed_style
            ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
        ## NOTE: $window is the root object, so that we must keep it 
        ## referenced in this block.
        
        my $actual = $style->css_text;
        my $expected = $DefaultComputedText;
        my $diff = $test->{computedtext}->{$doc_id}->{$selectors};
        ($actual, $expected) = apply_diff ($actual, $expected, $diff);
            "#computedtext $doc_id $selectors ($test->{data})";
        ok $actual, $expected,
            "#computedtext $doc_id $selectors ($test->{data})";
      }
    }
  }
}

my @longhand;
my @shorthand;
BEGIN {
  @longhand = qw/
    alignment-baseline
    background-attachment background-color background-image
    background-position-x background-position-y
    background-repeat border-bottom-color
    border-bottom-style border-bottom-width border-collapse
    border-left-color
    border-left-style border-left-width border-right-color
    border-right-style border-right-width
    -manakai-border-spacing-x -manakai-border-spacing-y
    border-top-color border-top-style border-top-width bottom
    caption-side clear clip color content counter-increment counter-reset
    cursor direction display dominant-baseline empty-cells float
    font-family font-size font-size-adjust font-stretch
    font-style font-variant font-weight height left
    letter-spacing line-height
    list-style-image list-style-position list-style-type
    margin-bottom margin-left margin-right margin-top marker-offset
    marks max-height max-width min-height min-width opacity -moz-opacity
    orphans outline-color outline-style outline-width overflow-x overflow-y
    padding-bottom padding-left padding-right padding-top
    page page-break-after page-break-before page-break-inside
    position quotes right size table-layout
    text-align text-anchor text-decoration text-indent text-transform
    top unicode-bidi vertical-align visibility white-space width widows
    word-spacing writing-mode z-index
  /;
  @shorthand = qw/
    background background-position
    border border-color border-style border-width border-spacing
    border-top border-right border-bottom border-left
    font list-style margin outline overflow padding
  /;
  $DefaultComputedText = q[  alignment-baseline: auto;
  border-spacing: 0px;
  background: transparent none repeat scroll 0% 0%;
  border: 0px none -manakai-default;
  border-collapse: separate;
  bottom: auto;
  caption-side: top;
  clear: none;
  clip: auto;
  color: -manakai-default;
  content: normal;
  counter-increment: none;
  counter-reset: none;
  cursor: auto;
  direction: ltr;
  display: inline;
  dominant-baseline: auto;
  empty-cells: show;
  float: none;
  font-family: -manakai-default;
  font-size: 16px;
  font-size-adjust: none;
  font-stretch: normal;
  font-style: normal;
  font-variant: normal;
  font-weight: 400;
  height: auto;
  left: auto;
  letter-spacing: normal;
  line-height: normal;
  list-style-image: none;
  list-style-position: outside;
  list-style-type: disc;
  margin: 0px;
  marker-offset: auto;
  marks: none;
  max-height: none;
  max-width: none;
  min-height: 0px;
  min-width: 0px;
  opacity: 1;
  orphans: 2;
  outline: 0px none invert;
  overflow: visible;
  padding: 0px;
  page: auto;
  page-break-after: auto;
  page-break-before: auto;
  page-break-inside: auto;
  position: static;
  quotes: -manakai-default;
  right: auto;
  size: auto;
  table-layout: auto;
  text-align: begin;
  text-anchor: start;
  text-decoration: none;
  text-indent: 0px;
  text-transform: none;
  top: auto;
  unicode-bidi: normal;
  vertical-align: baseline;
  visibility: visible;
  white-space: normal;
  widows: 2;
  width: auto;
  word-spacing: normal;
  writing-mode: lr-tb;
  z-index: auto;
];
  $DefaultComputed = $DefaultComputedText;
  $DefaultComputed =~ s/^  /| /gm;
  $DefaultComputed =~ s/;$//gm;
  $DefaultComputed .= q[| -manakai-border-spacing-x: 0px
| -manakai-border-spacing-y: 0px
| -moz-opacity: 1
| background-attachment: scroll
| background-color: transparent
| background-image: none
| background-position: 0% 0%
| background-position-x: 0%
| background-position-y: 0%
| background-repeat: repeat
| border-top: 0px none -manakai-default
| border-right: 0px none -manakai-default
| border-bottom: 0px none -manakai-default
| border-left: 0px none -manakai-default
| border-bottom-color: -manakai-default
| border-bottom-style: none
| border-bottom-width: 0px
| border-left-color: -manakai-default
| border-left-style: none
| border-left-width: 0px
| border-right-color: -manakai-default
| border-right-style: none
| border-right-width: 0px
| border-top-color: -manakai-default
| border-top-style: none
| border-top-width: 0px
| border-color: -manakai-default
| border-style: none
| border-width: 0px
| float: none
| font: 400 16px -manakai-default
| list-style: disc none outside
| margin-top: 0px
| margin-right: 0px
| margin-bottom: 0px
| margin-left: 0px
| outline-color: invert
| outline-style: none
| outline-width: 0px
| overflow-x: visible
| overflow-y: visible
| padding-bottom: 0px
| padding-left: 0px
| padding-right: 0px
| padding-top: 0px];
}

sub get_parser ($) {
  my $parse_mode = shift;

  my $p = Whatpm::CSS::Parser->new;

  $p->{prop}->{$_} = 1 for (@longhand, @shorthand);
  $p->{prop_value}->{display}->{$_} = 1 for qw/
    block clip inline inline-block inline-table list-item none
    table table-caption table-cell table-column table-column-group
    table-header-group table-footer-group table-row table-row-group
    compact marker
  /;
  $p->{prop_value}->{position}->{$_} = 1 for qw/
    absolute fixed relative static
  /;
  for (qw/-moz-max-content -moz-min-content -moz-fit-content -moz-available/) {
    $p->{prop_value}->{width}->{$_} = 1;
    $p->{prop_value}->{'min-width'}->{$_} = 1;
    $p->{prop_value}->{'max-width'}->{$_} = 1;
  }
  $p->{prop_value}->{float}->{$_} = 1 for qw/
    left right none
  /;
  $p->{prop_value}->{clear}->{$_} = 1 for qw/
    left right none both
  /;
  $p->{prop_value}->{direction}->{ltr} = 1;
  $p->{prop_value}->{direction}->{rtl} = 1;
  $p->{prop_value}->{marks}->{crop} = 1;
  $p->{prop_value}->{marks}->{cross} = 1;
  $p->{prop_value}->{'unicode-bidi'}->{$_} = 1 for qw/
    normal bidi-override embed
  /;
  for my $prop_name (qw/overflow overflow-x overflow-y/) {
    $p->{prop_value}->{$prop_name}->{$_} = 1 for qw/
      visible hidden scroll auto -webkit-marquee -moz-hidden-unscrollable
    /;
  }
  $p->{prop_value}->{visibility}->{$_} = 1 for qw/
    visible hidden collapse
  /;
  $p->{prop_value}->{'list-style-type'}->{$_} = 1 for qw/
    disc circle square decimal decimal-leading-zero
    lower-roman upper-roman lower-greek lower-latin
    upper-latin armenian georgian lower-alpha upper-alpha none
    hebrew cjk-ideographic hiragana katakana hiragana-iroha
    katakana-iroha
  /;
  $p->{prop_value}->{'list-style-position'}->{outside} = 1;
  $p->{prop_value}->{'list-style-position'}->{inside} = 1;
  $p->{prop_value}->{'page-break-before'}->{$_} = 1 for qw/
    auto always avoid left right
  /;
  $p->{prop_value}->{'page-break-after'}->{$_} = 1 for qw/
    auto always avoid left right
  /;
  $p->{prop_value}->{'page-break-inside'}->{auto} = 1;
  $p->{prop_value}->{'page-break-inside'}->{avoid} = 1;
  $p->{prop_value}->{'background-repeat'}->{$_} = 1 for qw/
    repeat repeat-x repeat-y no-repeat
  /;
  $p->{prop_value}->{'background-attachment'}->{scroll} = 1;
  $p->{prop_value}->{'background-attachment'}->{fixed} = 1;
  $p->{prop_value}->{'font-size'}->{$_} = 1 for qw/
    xx-small x-small small medium large x-large xx-large
    -manakai-xxx-large -webkit-xxx-large
    larger smaller
  /;
  $p->{prop_value}->{'font-style'}->{normal} = 1;
  $p->{prop_value}->{'font-style'}->{italic} = 1;
  $p->{prop_value}->{'font-style'}->{oblique} = 1;
  $p->{prop_value}->{'font-variant'}->{normal} = 1;
  $p->{prop_value}->{'font-variant'}->{'small-caps'} = 1;
  $p->{prop_value}->{'font-stretch'}->{$_} = 1 for
      qw/normal wider narrower ultra-condensed extra-condensed
        condensed semi-condensed semi-expanded expanded
        extra-expanded ultra-expanded/;
  $p->{prop_value}->{'text-align'}->{$_} = 1 for qw/
    left right center justify begin end
  /;
  $p->{prop_value}->{'text-transform'}->{$_} = 1 for qw/
    capitalize uppercase lowercase none
  /;
  $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
    normal pre nowrap pre-line pre-wrap -moz-pre-wrap
  /;
  $p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/
    lr rl tb lr-tb rl-tb tb-rl
  /;
  $p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/
    start middle end
  /;
  $p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/
    auto use-script no-change reset-size ideographic alphabetic
    hanging mathematical central middle text-after-edge text-before-edge
  /;
  $p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/
    auto baseline before-edge text-before-edge middle central
    after-edge text-after-edge ideographic alphabetic hanging
    mathematical
  /;
  $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
    none blink underline overline line-through
  /;
  $p->{prop_value}->{'caption-side'}->{$_} = 1 for qw/
    top bottom left right
  /;
  $p->{prop_value}->{'table-layout'}->{auto} = 1;
  $p->{prop_value}->{'table-layout'}->{fixed} = 1;
  $p->{prop_value}->{'border-collapse'}->{collapse} = 1;
  $p->{prop_value}->{'border-collapse'}->{separate} = 1;
  $p->{prop_value}->{'empty-cells'}->{show} = 1;
  $p->{prop_value}->{'empty-cells'}->{hide} = 1;
  $p->{prop_value}->{cursor}->{$_} = 1 for qw/
    auto crosshair default pointer move e-resize ne-resize nw-resize n-resize
    se-resize sw-resize s-resize w-resize text wait help progress
  /;
  for my $prop (qw/border-top-style border-left-style
                   border-bottom-style border-right-style outline-style/) {
    $p->{prop_value}->{$prop}->{$_} = 1 for qw/
      none hidden dotted dashed solid double groove ridge inset outset
    /;
  }
  for my $prop (qw/color background-color
                   border-bottom-color border-left-color border-right-color
                   border-top-color border-color/) {
    $p->{prop_value}->{$prop}->{transparent} = 1;
    $p->{prop_value}->{$prop}->{flavor} = 1;
    $p->{prop_value}->{$prop}->{'-manakai-default'} = 1;
  }
  $p->{prop_value}->{'outline-color'}->{invert} = 1;
  $p->{prop_value}->{'outline-color'}->{'-manakai-invert-or-currentcolor'} = 1;
  $p->{pseudo_class}->{$_} = 1 for qw/
    active checked disabled empty enabled first-child first-of-type
    focus hover indeterminate last-child last-of-type link only-child
    only-of-type root target visited
    lang nth-child nth-last-child nth-of-type nth-last-of-type not
    -manakai-contains -manakai-current
  /;
  $p->{pseudo_element}->{$_} = 1 for qw/
    after before first-letter first-line
  /;

  my $css_options = {
    prop => $p->{prop},
    prop_value => $p->{prop_value},
    pseudo_class => $p->{pseudo_class},
    pseudo_element => $p->{pseudo_element},
  };

  $p->init;
  if ($parse_mode eq 'q') {
    $p->{unitless_px} = 1;
    $p->{hashless_color} = 1;
  }
  $p->{href} = 'thismessage:/';

  return ($p, $css_options);
} # get_parser

sub serialize_cssom ($) {
  my $ss = shift;

  if (defined $ss) {
    if ($ss->isa ('Message::IF::CSSStyleSheet')) {
      my $v = '';
      for my $rule (@{$ss->css_rules}) {
        my $indent = '';
        $v .= serialize_rule ($rule, $indent);
      }
      return $v;
    } else {
      return '(' . (ref $ss) . ')';
    }
  } else {
    return '(undef)';
  }
} # serialize_cssom

sub serialize_rule ($$) {
  my ($rule, $indent) = @_;
  my $v = '';
  if ($rule->type == $rule->STYLE_RULE) {
    $v .= '| ' . $indent . '<' . $rule->selector_text . ">\n";
    $v .= serialize_style ($rule->style, $indent . '  ');
  } elsif ($rule->type == $rule->MEDIA_RULE) {
    $v .= '| ' . $indent . '@media ' . $rule->media . "\n";
    $v .= serialize_rule ($_, $indent . '  ') for @{$rule->css_rules};
  } elsif ($rule->type == $rule->NAMESPACE_RULE) {
    $v .= '| ' . $indent . '@namespace ';
    my $prefix = $rule->prefix;
    $v .= $prefix . ': ' if length $prefix;
    $v .= '<' . $rule->namespace_uri . ">\n";
  } elsif ($rule->type == $rule->IMPORT_RULE) {
    $v .= '| ' . $indent . '@import <' . $rule->href . '> ' . $rule->media;
    $v .= "\n";
  } elsif ($rule->type == $rule->CHARSET_RULE) {
    $v .= '| ' . $indent . '@charset ' . $rule->encoding . "\n";
  } else {
    die "Rule type @{[$rule->type]} is not supported";
  }
  return $v;
} # serialize_rule

sub get_computed_style ($$$$$$) {
  my ($all_test, $doc_id, $selectors, $dom, $css_options, $ss) = @_;

  my $doc = $all_test->{document}->{$doc_id}->{document};
  unless ($doc) {
    die "Test document $doc_id is not defined";
  }

  my $element = $doc->query_selector ($selectors);
  unless ($element) {
    die "Element $selectors not found in document $doc_id";
  }
  
  my $window = Message::DOM::Window->___new ($dom);
  $window->___set_css_options ($css_options);
  $window->___set_user_style_sheets ([$ss]);
  $window->set_document ($doc);
  
  my $style = $element->manakai_computed_style;
  return ($window, $style);
} # get_computed_style

sub serialize_style ($$) {
  my ($style, $indent) = @_;

  ## TODO: check @$style

  my @v;
  for (map {get_dom_names ($_)} @shorthand, @longhand) {
    my $dom = $_->[1];
    push @v, [$_->[0], $dom, $style->$dom,
              $style->get_property_priority ($_->[0])];
    $v[-1]->[3] = ' !' . $v[-1]->[3] if length $v[-1]->[3];
  }
  return join '', map {"| $indent$_->[0]: $_->[2]$_->[3]\n"}
      sort {$a->[0] cmp $b->[0]} grep {length $_->[2]} @v;
} # serialize_style

sub get_dom_names ($) {
  my $dom_name = $_[0];
  if ($_[0] eq 'float') {
    return ([$_[0] => 'css_float'], [$_[0] => 'style_float']);
  }

  $dom_name =~ tr/-/_/;
  return ([$_[0] => $dom_name]);
} # get_dom_names

sub apply_diff ($$$) {
  my ($actual, $expected, $diff) = @_;
  my @actual = split /[\x0D\x0A]+/, $actual;
  my @expected = split /[\x0D\x0A]+/, $expected;
  my @diff = split /[\x0D\x0A]+/, $diff;
  for (@diff) {
    if (s/^-//) {
      push @actual, $_;
    } elsif (s/^\+//) {
      push @expected, $_;
    } else {
      die "Invalid diff line: $_";
    }
  }
  $actual = join "\n", sort {$a cmp $b} @actual;
  $expected = join "\n", sort {$a cmp $b} @expected;
  ($actual, $expected);
} # apply_diff
1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3
4			use lib qw[/home/wakaba/work/manakai2/lib]; ## TODO: ...
5
6			use Test;
7
8	wakaba	1.22	BEGIN { plan tests => 2210 }
9	wakaba	1.1
10			require Whatpm::CSS::Parser;
11			require Message::DOM::Window;
12
13			require Message::DOM::DOMImplementation;
14			my $dom = Message::DOM::DOMImplementation->new;
15
16			my $DefaultComputed;
17			my $DefaultComputedText;
18
19			for my $file_name (map {"t/$_"} qw(
20			css-1.dat
21	wakaba	1.17	css-2.dat
22	wakaba	1.18	css-3.dat
23	wakaba	1.20	css-4.dat
24	wakaba	1.4	css-visual.dat
25	wakaba	1.6	css-generated.dat
26	wakaba	1.9	css-paged.dat
27			css-text.dat
28	wakaba	1.7	css-font.dat
29	wakaba	1.10	css-table.dat
30			css-interactive.dat
31	wakaba	1.1	)) {
32			print "# $file_name\n";
33	wakaba	1.13	open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";
34	wakaba	1.1
35			my $all_test = {document => {}, test => []};
36			my $test;
37			my $mode = 'data';
38			my $doc_id;
39			my $selectors;
40			while (<$file>) {
41			s/\x0D\x0A/\x0A/;
42			if (/^#data$/) {
43			undef $test;
44			$test->{data} = '';
45			push @{$all_test->{test}}, $test;
46			$mode = 'data';
47			} elsif (/#(csstext\|cssom)$/) {
48			$test->{$1} = '';
49			$mode = $1;
50			} elsif (/#(computed(?>text)?) (\S+) (.+)$/) {
51			$test->{$1}->{$doc_id = $2}->{$selectors = $3} = '';
52			$mode = $1;
53			} elsif (/^#html (\S+)$/) {
54			undef $test;
55			$test->{format} = 'html';
56			$test->{data} = '';
57			$all_test->{document}->{$1} = $test;
58			$mode = 'data';
59	wakaba	1.2	} elsif (/^#errors$/) {
60			$test->{errors} = [];
61			$mode = 'errors';
62			$test->{data} =~ s/\x0D?\x0A\z//;
63	wakaba	1.4	} elsif (/^#option q$/) {
64			$test->{option}->{parse_mode} = 'q';
65	wakaba	1.1	} elsif (defined $test->{data} and /^$/) {
66			undef $test;
67			} else {
68			if ({data => 1, cssom => 1, csstext => 1}->{$mode}) {
69			$test->{$mode} .= $_;
70			} elsif ($mode eq 'computed' or $mode eq 'computedtext') {
71			$test->{$mode}->{$doc_id}->{$selectors} .= $_;
72	wakaba	1.2	} elsif ($mode eq 'errors') {
73			tr/\x0D\x0A//d;
74			push @{$test->{errors}}, $_;
75	wakaba	1.1	} else {
76			die "Line $.: $_";
77			}
78			}
79			}
80
81			for my $data (values %{$all_test->{document}}) {
82			if ($data->{format} eq 'html') {
83			my $doc = $dom->create_document;
84			$doc->manakai_is_html (1);
85			$doc->inner_html ($data->{data});
86			$data->{document} = $doc;
87			} else {
88			die "Test data format $data->{format} is not supported";
89			}
90			}
91
92			for my $test (@{$all_test->{test}}) {
93	wakaba	1.4	my ($p, $css_options) = get_parser ($test->{option}->{parse_mode});
94	wakaba	1.1
95	wakaba	1.2	my @actual_error;
96	wakaba	1.1	$p->{onerror} = sub {
97			my (%opt) = @_;
98	wakaba	1.2	my $uri = ${$opt{uri}};
99			$uri =~ s[^thismessage:/][];
100			push @actual_error, join ';',
101			$uri, $opt{token}->{line}, $opt{token}->{column},
102			$opt{level},
103	wakaba	1.22	$opt{type} .
104			(defined $opt{text} ? ';'.$opt{text} : '');
105	wakaba	1.1	};
106
107			my $ss = $p->parse_char_string ($test->{data});
108	wakaba	1.2
109			ok ((join "\n", @actual_error), (join "\n", @{$test->{errors} or []}),
110			"#result ($test->{data})");
111	wakaba	1.1
112			if (defined $test->{cssom}) {
113			my $actual = serialize_cssom ($ss);
114			ok $actual, $test->{cssom}, "#cssom ($test->{data})";
115			}
116
117			if (defined $test->{csstext}) {
118			my $actual = $ss->css_text;
119			ok $actual, $test->{csstext}, "#csstext ($test->{data})";
120			}
121
122			for my $doc_id (keys %{$test->{computed} or {}}) {
123			for my $selectors (keys %{$test->{computed}->{$doc_id}}) {
124			my ($window, $style) = get_computed_style
125			($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
126			## NOTE: $window is the root object, so that we must keep it
127			## referenced in this block.
128
129			my $actual = serialize_style ($style, '');
130			my $expected = $DefaultComputed;
131			my $diff = $test->{computed}->{$doc_id}->{$selectors};
132			($actual, $expected) = apply_diff ($actual, $expected, $diff);
133			ok $actual, $expected,
134			"#computed $doc_id $selectors ($test->{data})";
135			}
136			}
137
138			for my $doc_id (keys %{$test->{computedtext} or {}}) {
139			for my $selectors (keys %{$test->{computedtext}->{$doc_id}}) {
140			my ($window, $style) = get_computed_style
141			($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
142			## NOTE: $window is the root object, so that we must keep it
143			## referenced in this block.
144
145			my $actual = $style->css_text;
146			my $expected = $DefaultComputedText;
147			my $diff = $test->{computedtext}->{$doc_id}->{$selectors};
148			($actual, $expected) = apply_diff ($actual, $expected, $diff);
149			"#computedtext $doc_id $selectors ($test->{data})";
150			ok $actual, $expected,
151			"#computedtext $doc_id $selectors ($test->{data})";
152			}
153			}
154			}
155			}
156
157			my @longhand;
158			my @shorthand;
159			BEGIN {
160			@longhand = qw/
161	wakaba	1.21	alignment-baseline
162	wakaba	1.1	background-attachment background-color background-image
163			background-position-x background-position-y
164			background-repeat border-bottom-color
165			border-bottom-style border-bottom-width border-collapse
166			border-left-color
167			border-left-style border-left-width border-right-color
168			border-right-style border-right-width
169			-manakai-border-spacing-x -manakai-border-spacing-y
170			border-top-color border-top-style border-top-width bottom
171	wakaba	1.15	caption-side clear clip color content counter-increment counter-reset
172	wakaba	1.21	cursor direction display dominant-baseline empty-cells float
173	wakaba	1.16	font-family font-size font-size-adjust font-stretch
174			font-style font-variant font-weight height left
175	wakaba	1.1	letter-spacing line-height
176			list-style-image list-style-position list-style-type
177	wakaba	1.16	margin-bottom margin-left margin-right margin-top marker-offset
178			marks max-height max-width min-height min-width opacity -moz-opacity
179	wakaba	1.11	orphans outline-color outline-style outline-width overflow-x overflow-y
180	wakaba	1.1	padding-bottom padding-left padding-right padding-top
181	wakaba	1.16	page page-break-after page-break-before page-break-inside
182			position quotes right size table-layout
183	wakaba	1.21	text-align text-anchor text-decoration text-indent text-transform
184	wakaba	1.1	top unicode-bidi vertical-align visibility white-space width widows
185	wakaba	1.21	word-spacing writing-mode z-index
186	wakaba	1.1	/;
187			@shorthand = qw/
188			background background-position
189			border border-color border-style border-width border-spacing
190			border-top border-right border-bottom border-left
191	wakaba	1.11	font list-style margin outline overflow padding
192	wakaba	1.1	/;
193	wakaba	1.21	$DefaultComputedText = q[ alignment-baseline: auto;
194			border-spacing: 0px;
195	wakaba	1.1	background: transparent none repeat scroll 0% 0%;
196			border: 0px none -manakai-default;
197			border-collapse: separate;
198			bottom: auto;
199			caption-side: top;
200			clear: none;
201	wakaba	1.15	clip: auto;
202	wakaba	1.1	color: -manakai-default;
203	wakaba	1.13	content: normal;
204	wakaba	1.14	counter-increment: none;
205			counter-reset: none;
206	wakaba	1.1	cursor: auto;
207			direction: ltr;
208			display: inline;
209	wakaba	1.21	dominant-baseline: auto;
210	wakaba	1.1	empty-cells: show;
211			float: none;
212			font-family: -manakai-default;
213			font-size: 16px;
214	wakaba	1.16	font-size-adjust: none;
215			font-stretch: normal;
216	wakaba	1.1	font-style: normal;
217			font-variant: normal;
218			font-weight: 400;
219			height: auto;
220			left: auto;
221			letter-spacing: normal;
222			line-height: normal;
223			list-style-image: none;
224			list-style-position: outside;
225			list-style-type: disc;
226	wakaba	1.5	margin: 0px;
227	wakaba	1.16	marker-offset: auto;
228			marks: none;
229	wakaba	1.1	max-height: none;
230			max-width: none;
231			min-height: 0px;
232			min-width: 0px;
233			opacity: 1;
234			orphans: 2;
235			outline: 0px none invert;
236			overflow: visible;
237	wakaba	1.6	padding: 0px;
238	wakaba	1.16	page: auto;
239	wakaba	1.1	page-break-after: auto;
240			page-break-before: auto;
241			page-break-inside: auto;
242			position: static;
243	wakaba	1.12	quotes: -manakai-default;
244	wakaba	1.1	right: auto;
245	wakaba	1.16	size: auto;
246	wakaba	1.1	table-layout: auto;
247			text-align: begin;
248	wakaba	1.21	text-anchor: start;
249	wakaba	1.1	text-decoration: none;
250			text-indent: 0px;
251			text-transform: none;
252			top: auto;
253			unicode-bidi: normal;
254			vertical-align: baseline;
255			visibility: visible;
256			white-space: normal;
257			widows: 2;
258			width: auto;
259			word-spacing: normal;
260	wakaba	1.21	writing-mode: lr-tb;
261	wakaba	1.1	z-index: auto;
262			];
263			$DefaultComputed = $DefaultComputedText;
264			$DefaultComputed =~ s/^ /\| /gm;
265			$DefaultComputed =~ s/;$//gm;
266			$DefaultComputed .= q[\| -manakai-border-spacing-x: 0px
267			\| -manakai-border-spacing-y: 0px
268			\| -moz-opacity: 1
269			\| background-attachment: scroll
270			\| background-color: transparent
271			\| background-image: none
272	wakaba	1.8	\| background-position: 0% 0%
273	wakaba	1.1	\| background-position-x: 0%
274			\| background-position-y: 0%
275			\| background-repeat: repeat
276			\| border-top: 0px none -manakai-default
277			\| border-right: 0px none -manakai-default
278			\| border-bottom: 0px none -manakai-default
279			\| border-left: 0px none -manakai-default
280			\| border-bottom-color: -manakai-default
281			\| border-bottom-style: none
282			\| border-bottom-width: 0px
283			\| border-left-color: -manakai-default
284			\| border-left-style: none
285			\| border-left-width: 0px
286			\| border-right-color: -manakai-default
287			\| border-right-style: none
288			\| border-right-width: 0px
289			\| border-top-color: -manakai-default
290			\| border-top-style: none
291			\| border-top-width: 0px
292			\| border-color: -manakai-default
293			\| border-style: none
294			\| border-width: 0px
295			\| float: none
296	wakaba	1.7	\| font: 400 16px -manakai-default
297	wakaba	1.6	\| list-style: disc none outside
298	wakaba	1.5	\| margin-top: 0px
299			\| margin-right: 0px
300			\| margin-bottom: 0px
301			\| margin-left: 0px
302	wakaba	1.1	\| outline-color: invert
303			\| outline-style: none
304			\| outline-width: 0px
305	wakaba	1.11	\| overflow-x: visible
306			\| overflow-y: visible
307	wakaba	1.6	\| padding-bottom: 0px
308			\| padding-left: 0px
309			\| padding-right: 0px
310			\| padding-top: 0px];
311	wakaba	1.1	}
312
313	wakaba	1.4	sub get_parser ($) {
314			my $parse_mode = shift;
315
316	wakaba	1.1	my $p = Whatpm::CSS::Parser->new;
317	wakaba	1.4
318	wakaba	1.1	$p->{prop}->{$_} = 1 for (@longhand, @shorthand);
319			$p->{prop_value}->{display}->{$_} = 1 for qw/
320	wakaba	1.15	block clip inline inline-block inline-table list-item none
321	wakaba	1.1	table table-caption table-cell table-column table-column-group
322			table-header-group table-footer-group table-row table-row-group
323	wakaba	1.16	compact marker
324	wakaba	1.1	/;
325			$p->{prop_value}->{position}->{$_} = 1 for qw/
326			absolute fixed relative static
327			/;
328	wakaba	1.23	for (qw/-moz-max-content -moz-min-content -moz-fit-content -moz-available/) {
329			$p->{prop_value}->{width}->{$_} = 1;
330			$p->{prop_value}->{'min-width'}->{$_} = 1;
331			$p->{prop_value}->{'max-width'}->{$_} = 1;
332			}
333	wakaba	1.1	$p->{prop_value}->{float}->{$_} = 1 for qw/
334			left right none
335			/;
336			$p->{prop_value}->{clear}->{$_} = 1 for qw/
337			left right none both
338			/;
339			$p->{prop_value}->{direction}->{ltr} = 1;
340			$p->{prop_value}->{direction}->{rtl} = 1;
341	wakaba	1.16	$p->{prop_value}->{marks}->{crop} = 1;
342			$p->{prop_value}->{marks}->{cross} = 1;
343	wakaba	1.1	$p->{prop_value}->{'unicode-bidi'}->{$_} = 1 for qw/
344			normal bidi-override embed
345			/;
346	wakaba	1.11	for my $prop_name (qw/overflow overflow-x overflow-y/) {
347			$p->{prop_value}->{$prop_name}->{$_} = 1 for qw/
348			visible hidden scroll auto -webkit-marquee -moz-hidden-unscrollable
349			/;
350			}
351	wakaba	1.1	$p->{prop_value}->{visibility}->{$_} = 1 for qw/
352			visible hidden collapse
353			/;
354			$p->{prop_value}->{'list-style-type'}->{$_} = 1 for qw/
355			disc circle square decimal decimal-leading-zero
356			lower-roman upper-roman lower-greek lower-latin
357			upper-latin armenian georgian lower-alpha upper-alpha none
358	wakaba	1.16	hebrew cjk-ideographic hiragana katakana hiragana-iroha
359			katakana-iroha
360	wakaba	1.1	/;
361			$p->{prop_value}->{'list-style-position'}->{outside} = 1;
362			$p->{prop_value}->{'list-style-position'}->{inside} = 1;
363			$p->{prop_value}->{'page-break-before'}->{$_} = 1 for qw/
364			auto always avoid left right
365			/;
366			$p->{prop_value}->{'page-break-after'}->{$_} = 1 for qw/
367			auto always avoid left right
368			/;
369			$p->{prop_value}->{'page-break-inside'}->{auto} = 1;
370			$p->{prop_value}->{'page-break-inside'}->{avoid} = 1;
371			$p->{prop_value}->{'background-repeat'}->{$_} = 1 for qw/
372			repeat repeat-x repeat-y no-repeat
373			/;
374			$p->{prop_value}->{'background-attachment'}->{scroll} = 1;
375			$p->{prop_value}->{'background-attachment'}->{fixed} = 1;
376	wakaba	1.16	$p->{prop_value}->{'font-size'}->{$_} = 1 for qw/
377			xx-small x-small small medium large x-large xx-large
378			-manakai-xxx-large -webkit-xxx-large
379			larger smaller
380			/;
381	wakaba	1.1	$p->{prop_value}->{'font-style'}->{normal} = 1;
382			$p->{prop_value}->{'font-style'}->{italic} = 1;
383			$p->{prop_value}->{'font-style'}->{oblique} = 1;
384			$p->{prop_value}->{'font-variant'}->{normal} = 1;
385			$p->{prop_value}->{'font-variant'}->{'small-caps'} = 1;
386	wakaba	1.16	$p->{prop_value}->{'font-stretch'}->{$_} = 1 for
387			qw/normal wider narrower ultra-condensed extra-condensed
388			condensed semi-condensed semi-expanded expanded
389			extra-expanded ultra-expanded/;
390	wakaba	1.1	$p->{prop_value}->{'text-align'}->{$_} = 1 for qw/
391			left right center justify begin end
392			/;
393			$p->{prop_value}->{'text-transform'}->{$_} = 1 for qw/
394			capitalize uppercase lowercase none
395			/;
396			$p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
397	wakaba	1.18	normal pre nowrap pre-line pre-wrap -moz-pre-wrap
398	wakaba	1.21	/;
399			$p->{prop_value}->{'writing-mode'}->{$_} = 1 for qw/
400			lr rl tb lr-tb rl-tb tb-rl
401			/;
402			$p->{prop_value}->{'text-anchor'}->{$_} = 1 for qw/
403			start middle end
404			/;
405			$p->{prop_value}->{'dominant-baseline'}->{$_} = 1 for qw/
406			auto use-script no-change reset-size ideographic alphabetic
407			hanging mathematical central middle text-after-edge text-before-edge
408			/;
409			$p->{prop_value}->{'alignment-baseline'}->{$_} = 1 for qw/
410			auto baseline before-edge text-before-edge middle central
411			after-edge text-after-edge ideographic alphabetic hanging
412			mathematical
413	wakaba	1.1	/;
414			$p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
415			none blink underline overline line-through
416			/;
417			$p->{prop_value}->{'caption-side'}->{$_} = 1 for qw/
418	wakaba	1.16	top bottom left right
419	wakaba	1.1	/;
420			$p->{prop_value}->{'table-layout'}->{auto} = 1;
421			$p->{prop_value}->{'table-layout'}->{fixed} = 1;
422	wakaba	1.18	$p->{prop_value}->{'border-collapse'}->{collapse} = 1;
423	wakaba	1.1	$p->{prop_value}->{'border-collapse'}->{separate} = 1;
424			$p->{prop_value}->{'empty-cells'}->{show} = 1;
425			$p->{prop_value}->{'empty-cells'}->{hide} = 1;
426			$p->{prop_value}->{cursor}->{$_} = 1 for qw/
427			auto crosshair default pointer move e-resize ne-resize nw-resize n-resize
428			se-resize sw-resize s-resize w-resize text wait help progress
429			/;
430			for my $prop (qw/border-top-style border-left-style
431			border-bottom-style border-right-style outline-style/) {
432			$p->{prop_value}->{$prop}->{$_} = 1 for qw/
433			none hidden dotted dashed solid double groove ridge inset outset
434			/;
435			}
436			for my $prop (qw/color background-color
437			border-bottom-color border-left-color border-right-color
438			border-top-color border-color/) {
439			$p->{prop_value}->{$prop}->{transparent} = 1;
440			$p->{prop_value}->{$prop}->{flavor} = 1;
441			$p->{prop_value}->{$prop}->{'-manakai-default'} = 1;
442			}
443			$p->{prop_value}->{'outline-color'}->{invert} = 1;
444			$p->{prop_value}->{'outline-color'}->{'-manakai-invert-or-currentcolor'} = 1;
445			$p->{pseudo_class}->{$_} = 1 for qw/
446			active checked disabled empty enabled first-child first-of-type
447			focus hover indeterminate last-child last-of-type link only-child
448			only-of-type root target visited
449			lang nth-child nth-last-child nth-of-type nth-last-of-type not
450			-manakai-contains -manakai-current
451			/;
452			$p->{pseudo_element}->{$_} = 1 for qw/
453			after before first-letter first-line
454			/;
455
456			my $css_options = {
457			prop => $p->{prop},
458			prop_value => $p->{prop_value},
459			pseudo_class => $p->{pseudo_class},
460			pseudo_element => $p->{pseudo_element},
461			};
462
463	wakaba	1.19	$p->init;
464			if ($parse_mode eq 'q') {
465			$p->{unitless_px} = 1;
466			$p->{hashless_color} = 1;
467			}
468	wakaba	1.1	$p->{href} = 'thismessage:/';
469
470			return ($p, $css_options);
471			} # get_parser
472
473			sub serialize_cssom ($) {
474			my $ss = shift;
475
476			if (defined $ss) {
477			if ($ss->isa ('Message::IF::CSSStyleSheet')) {
478			my $v = '';
479			for my $rule (@{$ss->css_rules}) {
480			my $indent = '';
481	wakaba	1.17	$v .= serialize_rule ($rule, $indent);
482	wakaba	1.1	}
483			return $v;
484			} else {
485			return '(' . (ref $ss) . ')';
486			}
487			} else {
488			return '(undef)';
489			}
490			} # serialize_cssom
491	wakaba	1.17
492			sub serialize_rule ($$) {
493			my ($rule, $indent) = @_;
494			my $v = '';
495			if ($rule->type == $rule->STYLE_RULE) {
496			$v .= '\| ' . $indent . '<' . $rule->selector_text . ">\n";
497			$v .= serialize_style ($rule->style, $indent . ' ');
498			} elsif ($rule->type == $rule->MEDIA_RULE) {
499			$v .= '\| ' . $indent . '@media ' . $rule->media . "\n";
500			$v .= serialize_rule ($_, $indent . ' ') for @{$rule->css_rules};
501	wakaba	1.18	} elsif ($rule->type == $rule->NAMESPACE_RULE) {
502			$v .= '\| ' . $indent . '@namespace ';
503			my $prefix = $rule->prefix;
504			$v .= $prefix . ': ' if length $prefix;
505			$v .= '<' . $rule->namespace_uri . ">\n";
506	wakaba	1.20	} elsif ($rule->type == $rule->IMPORT_RULE) {
507			$v .= '\| ' . $indent . '@import <' . $rule->href . '> ' . $rule->media;
508			$v .= "\n";
509			} elsif ($rule->type == $rule->CHARSET_RULE) {
510			$v .= '\| ' . $indent . '@charset ' . $rule->encoding . "\n";
511	wakaba	1.17	} else {
512			die "Rule type @{[$rule->type]} is not supported";
513			}
514			return $v;
515			} # serialize_rule
516	wakaba	1.1
517			sub get_computed_style ($$$$$$) {
518			my ($all_test, $doc_id, $selectors, $dom, $css_options, $ss) = @_;
519
520			my $doc = $all_test->{document}->{$doc_id}->{document};
521			unless ($doc) {
522			die "Test document $doc_id is not defined";
523			}
524
525	wakaba	1.6	my $element = $doc->query_selector ($selectors);
526	wakaba	1.1	unless ($element) {
527			die "Element $selectors not found in document $doc_id";
528			}
529
530			my $window = Message::DOM::Window->___new ($dom);
531			$window->___set_css_options ($css_options);
532			$window->___set_user_style_sheets ([$ss]);
533			$window->set_document ($doc);
534
535	wakaba	1.3	my $style = $element->manakai_computed_style;
536	wakaba	1.1	return ($window, $style);
537			} # get_computed_style
538
539			sub serialize_style ($$) {
540			my ($style, $indent) = @_;
541
542			## TODO: check @$style
543
544			my @v;
545			for (map {get_dom_names ($_)} @shorthand, @longhand) {
546			my $dom = $_->[1];
547			push @v, [$_->[0], $dom, $style->$dom,
548			$style->get_property_priority ($_->[0])];
549			$v[-1]->[3] = ' !' . $v[-1]->[3] if length $v[-1]->[3];
550			}
551			return join '', map {"\| $indent$_->[0]: $_->[2]$_->[3]\n"}
552			sort {$a->[0] cmp $b->[0]} grep {length $_->[2]} @v;
553			} # serialize_style
554
555			sub get_dom_names ($) {
556			my $dom_name = $_[0];
557			if ($_[0] eq 'float') {
558			return ([$_[0] => 'css_float'], [$_[0] => 'style_float']);
559			}
560
561			$dom_name =~ tr/-/_/;
562			return ([$_[0] => $dom_name]);
563			} # get_dom_names
564
565			sub apply_diff ($$$) {
566			my ($actual, $expected, $diff) = @_;
567			my @actual = split /[\x0D\x0A]+/, $actual;
568			my @expected = split /[\x0D\x0A]+/, $expected;
569			my @diff = split /[\x0D\x0A]+/, $diff;
570			for (@diff) {
571			if (s/^-//) {
572			push @actual, $_;
573			} elsif (s/^\+//) {
574			push @expected, $_;
575			} else {
576			die "Invalid diff line: $_";
577			}
578			}
579			$actual = join "\n", sort {$a cmp $b} @actual;
580			$expected = join "\n", sort {$a cmp $b} @expected;
581			($actual, $expected);
582			} # apply_diff