/[suikacvs]/markup/html/whatpm/Whatpm/HTML.pm.src
Suika

Diff of /markup/html/whatpm/Whatpm/HTML.pm.src

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.139 by wakaba, Sat May 24 04:26:27 2008 UTC revision 1.177 by wakaba, Sun Sep 14 09:05:54 2008 UTC
# Line 8  use Error qw(:try); Line 8  use Error qw(:try);
8  ## doc.write ('');  ## doc.write ('');
9  ## alert (doc.compatMode);  ## alert (doc.compatMode);
10    
 ## TODO: 1252 parse error (revision 1264)  
 ## TODO: 8859-11 = 874 (revision 1271)  
   
11  require IO::Handle;  require IO::Handle;
12    
13  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
# Line 48  sub MISC_SPECIAL_EL () { 0b1000000000000 Line 45  sub MISC_SPECIAL_EL () { 0b1000000000000
45  sub FOREIGN_EL () { 0b10000000000000000000000000 }  sub FOREIGN_EL () { 0b10000000000000000000000000 }
46  sub FOREIGN_FLOW_CONTENT_EL () { 0b100000000000000000000000000 }  sub FOREIGN_FLOW_CONTENT_EL () { 0b100000000000000000000000000 }
47  sub MML_AXML_EL () { 0b1000000000000000000000000000 }  sub MML_AXML_EL () { 0b1000000000000000000000000000 }
48    sub RUBY_EL () { 0b10000000000000000000000000000 }
49    sub RUBY_COMPONENT_EL () { 0b100000000000000000000000000000 }
50    
51  sub TABLE_ROWS_EL () {  sub TABLE_ROWS_EL () {
52    TABLE_EL |    TABLE_EL |
# Line 55  sub TABLE_ROWS_EL () { Line 54  sub TABLE_ROWS_EL () {
54    TABLE_ROW_GROUP_EL    TABLE_ROW_GROUP_EL
55  }  }
56    
57    ## NOTE: Used in "generate implied end tags" algorithm.
58    ## NOTE: There is a code where a modified version of END_TAG_OPTIONAL_EL
59    ## is used in "generate implied end tags" implementation (search for the
60    ## function mae).
61  sub END_TAG_OPTIONAL_EL () {  sub END_TAG_OPTIONAL_EL () {
62    DD_EL |    DD_EL |
63    DT_EL |    DT_EL |
64    LI_EL |    LI_EL |
65    P_EL    P_EL |
66      RUBY_COMPONENT_EL
67  }  }
68    
69    ## NOTE: Used in </body> and EOF algorithms.
70  sub ALL_END_TAG_OPTIONAL_EL () {  sub ALL_END_TAG_OPTIONAL_EL () {
71    END_TAG_OPTIONAL_EL |    DD_EL |
72      DT_EL |
73      LI_EL |
74      P_EL |
75    
76    BODY_EL |    BODY_EL |
77    HTML_EL |    HTML_EL |
78    TABLE_CELL_EL |    TABLE_CELL_EL |
# Line 99  sub SPECIAL_EL () { Line 108  sub SPECIAL_EL () {
108    ADDRESS_EL |    ADDRESS_EL |
109    BODY_EL |    BODY_EL |
110    DIV_EL |    DIV_EL |
111    END_TAG_OPTIONAL_EL |  
112      DD_EL |
113      DT_EL |
114      LI_EL |
115      P_EL |
116    
117    FORM_EL |    FORM_EL |
118    FRAMESET_EL |    FRAMESET_EL |
119    HEADING_EL |    HEADING_EL |
# Line 173  my $el_category = { Line 187  my $el_category = {
187    param => MISC_SPECIAL_EL,    param => MISC_SPECIAL_EL,
188    plaintext => MISC_SPECIAL_EL,    plaintext => MISC_SPECIAL_EL,
189    pre => MISC_SPECIAL_EL,    pre => MISC_SPECIAL_EL,
190      rp => RUBY_COMPONENT_EL,
191      rt => RUBY_COMPONENT_EL,
192      ruby => RUBY_EL,
193    s => FORMATTING_EL,    s => FORMATTING_EL,
194    script => MISC_SPECIAL_EL,    script => MISC_SPECIAL_EL,
195    select => SELECT_EL,    select => SELECT_EL,
# Line 214  my $el_category_f = { Line 231  my $el_category_f = {
231  };  };
232    
233  my $svg_attr_name = {  my $svg_attr_name = {
234      attributename => 'attributeName',
235    attributetype => 'attributeType',    attributetype => 'attributeType',
236    basefrequency => 'baseFrequency',    basefrequency => 'baseFrequency',
237    baseprofile => 'baseProfile',    baseprofile => 'baseProfile',
# Line 224  my $svg_attr_name = { Line 242  my $svg_attr_name = {
242    diffuseconstant => 'diffuseConstant',    diffuseconstant => 'diffuseConstant',
243    edgemode => 'edgeMode',    edgemode => 'edgeMode',
244    externalresourcesrequired => 'externalResourcesRequired',    externalresourcesrequired => 'externalResourcesRequired',
   fecolormatrix => 'feColorMatrix',  
   fecomposite => 'feComposite',  
   fegaussianblur => 'feGaussianBlur',  
   femorphology => 'feMorphology',  
   fetile => 'feTile',  
245    filterres => 'filterRes',    filterres => 'filterRes',
246    filterunits => 'filterUnits',    filterunits => 'filterUnits',
247    glyphref => 'glyphRef',    glyphref => 'glyphRef',
# Line 262  my $svg_attr_name = { Line 275  my $svg_attr_name = {
275    repeatcount => 'repeatCount',    repeatcount => 'repeatCount',
276    repeatdur => 'repeatDur',    repeatdur => 'repeatDur',
277    requiredextensions => 'requiredExtensions',    requiredextensions => 'requiredExtensions',
278      requiredfeatures => 'requiredFeatures',
279    specularconstant => 'specularConstant',    specularconstant => 'specularConstant',
280    specularexponent => 'specularExponent',    specularexponent => 'specularExponent',
281    spreadmethod => 'spreadMethod',    spreadmethod => 'spreadMethod',
# Line 340  sub parse_byte_string ($$$$;$) { Line 354  sub parse_byte_string ($$$$;$) {
354    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);    return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
355  } # parse_byte_string  } # parse_byte_string
356    
357  sub parse_byte_stream ($$$$;$) {  sub parse_byte_stream ($$$$;$$) {
358      # my ($self, $charset_name, $byte_stream, $doc, $onerror, $get_wrapper) = @_;
359    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
360    my $charset_name = shift;    my $charset_name = shift;
361    my $byte_stream = $_[0];    my $byte_stream = $_[0];
# Line 351  sub parse_byte_stream ($$$$;$) { Line 366  sub parse_byte_stream ($$$$;$) {
366    };    };
367    $self->{parse_error} = $onerror; # updated later by parse_char_string    $self->{parse_error} = $onerror; # updated later by parse_char_string
368    
369      my $get_wrapper = $_[3] || sub ($) {
370        return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
371      };
372    
373    ## HTML5 encoding sniffing algorithm    ## HTML5 encoding sniffing algorithm
374    require Message::Charset::Info;    require Message::Charset::Info;
375    my $charset;    my $charset;
# Line 358  sub parse_byte_stream ($$$$;$) { Line 377  sub parse_byte_stream ($$$$;$) {
377    my ($char_stream, $e_status);    my ($char_stream, $e_status);
378    
379    SNIFFING: {    SNIFFING: {
380        ## NOTE: By setting |allow_fallback| option true when the
381        ## |get_decode_handle| method is invoked, we ignore what the HTML5
382        ## spec requires, i.e. unsupported encoding should be ignored.
383          ## TODO: We should not do this unless the parser is invoked
384          ## in the conformance checking mode, in which this behavior
385          ## would be useful.
386    
387      ## Step 1      ## Step 1
388      if (defined $charset_name) {      if (defined $charset_name) {
389        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
390              ## TODO: Is this ok?  Transfer protocol's parameter should be
391              ## interpreted in its semantics?
392    
393        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
394        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
# Line 385  sub parse_byte_stream ($$$$;$) { Line 412  sub parse_byte_stream ($$$$;$) {
412    
413      ## Step 3      ## Step 3
414      if ($byte_buffer =~ /^\xFE\xFF/) {      if ($byte_buffer =~ /^\xFE\xFF/) {
415        $charset = Message::Charset::Info->get_by_iana_name ('utf-16be');        $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
416        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
417            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
418             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
419        $self->{confident} = 1;        $self->{confident} = 1;
420        last SNIFFING;        last SNIFFING;
421      } elsif ($byte_buffer =~ /^\xFF\xFE/) {      } elsif ($byte_buffer =~ /^\xFF\xFE/) {
422        $charset = Message::Charset::Info->get_by_iana_name ('utf-16le');        $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
423        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
424            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
425             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
426        $self->{confident} = 1;        $self->{confident} = 1;
427        last SNIFFING;        last SNIFFING;
428      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {      } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
429        $charset = Message::Charset::Info->get_by_iana_name ('utf-8');        $charset = Message::Charset::Info->get_by_html_name ('utf-8');
430        ($char_stream, $e_status) = $charset->get_decode_handle        ($char_stream, $e_status) = $charset->get_decode_handle
431            ($byte_stream, allow_error_reporting => 1,            ($byte_stream, allow_error_reporting => 1,
432             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
# Line 418  sub parse_byte_stream ($$$$;$) { Line 445  sub parse_byte_stream ($$$$;$) {
445      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
446          ($byte_buffer);          ($byte_buffer);
447      if (defined $charset_name) {      if (defined $charset_name) {
448        $charset = Message::Charset::Info->get_by_iana_name ($charset_name);        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
449    
450        ## ISSUE: Unsupported encoding is not ignored according to the spec.        ## ISSUE: Unsupported encoding is not ignored according to the spec.
451        require Whatpm::Charset::DecodeHandle;        require Whatpm::Charset::DecodeHandle;
# Line 429  sub parse_byte_stream ($$$$;$) { Line 456  sub parse_byte_stream ($$$$;$) {
456             allow_fallback => 1, byte_buffer => \$byte_buffer);             allow_fallback => 1, byte_buffer => \$byte_buffer);
457        if ($char_stream) {        if ($char_stream) {
458          $buffer->{buffer} = $byte_buffer;          $buffer->{buffer} = $byte_buffer;
459          !!!parse-error (type => 'sniffing:chardet', ## TODO: type name          !!!parse-error (type => 'sniffing:chardet',
460                          value => $charset_name,                          text => $charset_name,
461                          level => $self->{info_level},                          level => $self->{level}->{info},
462                            layer => 'encode',
463                          line => 1, column => 1);                          line => 1, column => 1);
464          $self->{confident} = 0;          $self->{confident} = 0;
465          last SNIFFING;          last SNIFFING;
# Line 440  sub parse_byte_stream ($$$$;$) { Line 468  sub parse_byte_stream ($$$$;$) {
468    
469      ## Step 7: default      ## Step 7: default
470      ## TODO: Make this configurable.      ## TODO: Make this configurable.
471      $charset = Message::Charset::Info->get_by_iana_name ('windows-1252');      $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
472          ## NOTE: We choose |windows-1252| here, since |utf-8| should be          ## NOTE: We choose |windows-1252| here, since |utf-8| should be
473          ## detectable in the step 6.          ## detectable in the step 6.
474      require Whatpm::Charset::DecodeHandle;      require Whatpm::Charset::DecodeHandle;
# Line 452  sub parse_byte_stream ($$$$;$) { Line 480  sub parse_byte_stream ($$$$;$) {
480                                         allow_fallback => 1,                                         allow_fallback => 1,
481                                         byte_buffer => \$byte_buffer);                                         byte_buffer => \$byte_buffer);
482      $buffer->{buffer} = $byte_buffer;      $buffer->{buffer} = $byte_buffer;
483      !!!parse-error (type => 'sniffing:default', ## TODO: type name      !!!parse-error (type => 'sniffing:default',
484                      value => 'windows-1252',                      text => 'windows-1252',
485                      level => $self->{info_level},                      level => $self->{level}->{info},
486                      line => 1, column => 1);                      line => 1, column => 1,
487                        layer => 'encode');
488      $self->{confident} = 0;      $self->{confident} = 0;
489    } # SNIFFING    } # SNIFFING
490    
   $self->{input_encoding} = $charset->get_iana_name;  
491    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {    if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
492      !!!parse-error (type => 'chardecode:fallback', ## TODO: type name      $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
493                      value => $self->{input_encoding},      !!!parse-error (type => 'chardecode:fallback',
494                      level => $self->{unsupported_level},                      #text => $self->{input_encoding},
495                      line => 1, column => 1);                      level => $self->{level}->{uncertain},
496                        line => 1, column => 1,
497                        layer => 'encode');
498    } elsif (not ($e_status &    } elsif (not ($e_status &
499                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                  Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
500      !!!parse-error (type => 'chardecode:no error', ## TODO: type name      $self->{input_encoding} = $charset->get_iana_name;
501                      value => $self->{input_encoding},      !!!parse-error (type => 'chardecode:no error',
502                      level => $self->{unsupported_level},                      text => $self->{input_encoding},
503                      line => 1, column => 1);                      level => $self->{level}->{uncertain},
504                        line => 1, column => 1,
505                        layer => 'encode');
506      } else {
507        $self->{input_encoding} = $charset->get_iana_name;
508    }    }
509    
510    $self->{change_encoding} = sub {    $self->{change_encoding} = sub {
# Line 478  sub parse_byte_stream ($$$$;$) { Line 512  sub parse_byte_stream ($$$$;$) {
512      $charset_name = shift;      $charset_name = shift;
513      my $token = shift;      my $token = shift;
514    
515      $charset = Message::Charset::Info->get_by_iana_name ($charset_name);      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
516      ($char_stream, $e_status) = $charset->get_decode_handle      ($char_stream, $e_status) = $charset->get_decode_handle
517          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,          ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
518           byte_buffer => \ $buffer->{buffer});           byte_buffer => \ $buffer->{buffer});
# Line 487  sub parse_byte_stream ($$$$;$) { Line 521  sub parse_byte_stream ($$$$;$) {
521        ## "Change the encoding" algorithm:        ## "Change the encoding" algorithm:
522    
523        ## Step 1            ## Step 1    
524        if ($charset->{iana_names}->{'utf-16'}) { ## ISSUE: UTF-16BE -> UTF-8? UTF-16LE -> UTF-8?        if ($charset->{category} &
525          $charset = Message::Charset::Info->get_by_iana_name ('utf-8');            Message::Charset::Info::CHARSET_CATEGORY_UTF16 ()) {
526            $charset = Message::Charset::Info->get_by_html_name ('utf-8');
527          ($char_stream, $e_status) = $charset->get_decode_handle          ($char_stream, $e_status) = $charset->get_decode_handle
528              ($byte_stream,              ($byte_stream,
529               byte_buffer => \ $buffer->{buffer});               byte_buffer => \ $buffer->{buffer});
# Line 498  sub parse_byte_stream ($$$$;$) { Line 533  sub parse_byte_stream ($$$$;$) {
533        ## Step 2        ## Step 2
534        if (defined $self->{input_encoding} and        if (defined $self->{input_encoding} and
535            $self->{input_encoding} eq $charset_name) {            $self->{input_encoding} eq $charset_name) {
536          !!!parse-error (type => 'charset label:matching', ## TODO: type          !!!parse-error (type => 'charset label:matching',
537                          value => $charset_name,                          text => $charset_name,
538                          level => $self->{info_level});                          level => $self->{level}->{info});
539          $self->{confident} = 1;          $self->{confident} = 1;
540          return;          return;
541        }        }
542    
543        !!!parse-error (type => 'charset label detected:'.$self->{input_encoding}.        !!!parse-error (type => 'charset label detected',
544            ':'.$charset_name, level => 'w', token => $token);                        text => $self->{input_encoding},
545                          value => $charset_name,
546                          level => $self->{level}->{warn},
547                          token => $token);
548                
549        ## Step 3        ## Step 3
550        # if (can) {        # if (can) {
# Line 522  sub parse_byte_stream ($$$$;$) { Line 560  sub parse_byte_stream ($$$$;$) {
560    
561    my $char_onerror = sub {    my $char_onerror = sub {
562      my (undef, $type, %opt) = @_;      my (undef, $type, %opt) = @_;
563      !!!parse-error (%opt, type => $type,      !!!parse-error (layer => 'encode',
564                      line => $self->{line}, column => $self->{column} + 1);                      line => $self->{line}, column => $self->{column} + 1,
565                        %opt, type => $type);
566      if ($opt{octets}) {      if ($opt{octets}) {
567        ${$opt{octets}} = "\x{FFFD}"; # relacement character        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568      }      }
569    };    };
570    $char_stream->onerror ($char_onerror);  
571      my $wrapped_char_stream = $get_wrapper->($char_stream);
572      $wrapped_char_stream->onerror ($char_onerror);
573    
574    my @args = @_; shift @args; # $s    my @args = @_; shift @args; # $s
575    my $return;    my $return;
576    try {    try {
577      $return = $self->parse_char_stream ($char_stream, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
578    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
579      ## NOTE: Invoked after {change_encoding}.      ## NOTE: Invoked after {change_encoding}.
580    
     $self->{input_encoding} = $charset->get_iana_name;  
581      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
582        !!!parse-error (type => 'chardecode:fallback', ## TODO: type name        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
583                        value => $self->{input_encoding},        !!!parse-error (type => 'chardecode:fallback',
584                        level => $self->{unsupported_level},                        level => $self->{level}->{uncertain},
585                        line => 1, column => 1);                        #text => $self->{input_encoding},
586                          line => 1, column => 1,
587                          layer => 'encode');
588      } elsif (not ($e_status &      } elsif (not ($e_status &
589                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
590        !!!parse-error (type => 'chardecode:no error', ## TODO: type name        $self->{input_encoding} = $charset->get_iana_name;
591                        value => $self->{input_encoding},        !!!parse-error (type => 'chardecode:no error',
592                        level => $self->{unsupported_level},                        text => $self->{input_encoding},
593                        line => 1, column => 1);                        level => $self->{level}->{uncertain},
594                          line => 1, column => 1,
595                          layer => 'encode');
596        } else {
597          $self->{input_encoding} = $charset->get_iana_name;
598      }      }
599      $self->{confident} = 1;      $self->{confident} = 1;
600      $char_stream->onerror ($char_onerror);  
601      $return = $self->parse_char_stream ($char_stream, @args);      $wrapped_char_stream = $get_wrapper->($char_stream);
602        $wrapped_char_stream->onerror ($char_onerror);
603    
604        $return = $self->parse_char_stream ($wrapped_char_stream, @args);
605    };    };
606    return $return;    return $return;
607  } # parse_byte_stream  } # parse_byte_stream
# Line 566  sub parse_byte_stream ($$$$;$) { Line 615  sub parse_byte_stream ($$$$;$) {
615  ## such as |parse_byte_string| in this module, must ensure that it does  ## such as |parse_byte_string| in this module, must ensure that it does
616  ## strip the BOM and never strip any ZWNBSP.  ## strip the BOM and never strip any ZWNBSP.
617    
618  sub parse_char_string ($$$;$) {  sub parse_char_string ($$$;$$) {
619      #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
   require utf8;  
621    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
622    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
623      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
624      if ($_[3]) {
625        $input = $_[3]->($input);
626      }
627    return $self->parse_char_stream ($input, @_[1..$#_]);    return $self->parse_char_stream ($input, @_[1..$#_]);
628  } # parse_char_string  } # parse_char_string
629  *parse_string = \&parse_char_string;  *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
630    
631  sub parse_char_stream ($$$;$) {  sub parse_char_stream ($$$;$) {
632    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
# Line 616  sub parse_char_stream ($$$;$) { Line 669  sub parse_char_stream ($$$;$) {
669        $self->{column} = 0;        $self->{column} = 0;
670      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
671        !!!cp ('j2');        !!!cp ('j2');
672    ## TODO: support for abort/streaming
673        my $next = $input->getc;        my $next = $input->getc;
674        if (defined $next and $next ne "\x0A") {        if (defined $next and $next ne "\x0A") {
675          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
# Line 635  sub parse_char_stream ($$$;$) { Line 689  sub parse_char_stream ($$$;$) {
689               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
690               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
691               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
692    ## ISSUE: U+FDE0-U+FDEF are not excluded
693               {               {
694                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
695                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 647  sub parse_char_stream ($$$;$) { Line 702  sub parse_char_stream ($$$;$) {
702                0x10FFFE => 1, 0x10FFFF => 1,                0x10FFFE => 1, 0x10FFFF => 1,
703               }->{$self->{next_char}}) {               }->{$self->{next_char}}) {
704        !!!cp ('j5');        !!!cp ('j5');
705        !!!parse-error (type => 'control char', level => $self->{must_level});        if ($self->{next_char} < 0x10000) {
706  ## TODO: error type documentation          !!!parse-error (type => 'control char',
707                            text => (sprintf 'U+%04X', $self->{next_char}));
708          } else {
709            !!!parse-error (type => 'control char',
710                            text => (sprintf 'U-%08X', $self->{next_char}));
711          }
712      }      }
713    };    };
714    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
715    $self->{next_char} = -1;    $self->{next_char} = -1;
716    
717      $self->{read_until} = sub {
718        #my ($scalar, $specials_range, $offset) = @_;
719        my $specials_range = $_[1];
720        return 0 if defined $self->{next_next_char};
721        my $count = $input->manakai_read_until
722           ($_[0],
723            qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
724            $_[2]);
725        if ($count) {
726          $self->{column} += $count;
727          $self->{column_prev} += $count;
728          $self->{prev_char} = [-1, -1, -1];
729          $self->{next_char} = -1;
730        }
731        return $count;
732      }; # $self->{read_until}
733    
734    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
735      my (%opt) = @_;      my (%opt) = @_;
736      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 677  sub parse_char_stream ($$$;$) { Line 754  sub parse_char_stream ($$$;$) {
754  sub new ($) {  sub new ($) {
755    my $class = shift;    my $class = shift;
756    my $self = bless {    my $self = bless {
757      must_level => 'm',      level => {must => 'm',
758      should_level => 's',                should => 's',
759      good_level => 'w',                warn => 'w',
760      warn_level => 'w',                info => 'i',
761      info_level => 'i',                uncertain => 'u'},
     unsupported_level => 'u',  
762    }, $class;    }, $class;
763    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
764      $self->{next_char} = -1;      $self->{next_char} = -1;
# Line 712  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 788  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
788  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
789    
790  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
791  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
792  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
793  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
794  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 723  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 799  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
799  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
800  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
801  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
802  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
803  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
804  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
805  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 746  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 822  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
822  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
823  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
824  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
825  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
826    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
827    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
828    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
829    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
830    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
831    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
832    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
833    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
834    ## NOTE: "Entity data state", "entity in attribute value state", and
835    ## "consume a character reference" algorithm are jointly implemented
836    ## using the following six states:
837    sub ENTITY_STATE () { 44 }
838    sub ENTITY_HASH_STATE () { 45 }
839    sub NCR_NUM_STATE () { 46 }
840    sub HEXREF_X_STATE () { 47 }
841    sub HEXREF_HEX_STATE () { 48 }
842    sub ENTITY_NAME_STATE () { 49 }
843    
844  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
845  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 799  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 892  sub IN_COLUMN_GROUP_IM () { 0b10 }
892  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
893    my $self = shift;    my $self = shift;
894    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
895      #$self->{state_keyword}; # initialized when used
896      #$self->{entity__value}; # initialized when used
897      #$self->{entity__match}; # initialized when used
898    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
899    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
900    undef $self->{current_attribute};    undef $self->{current_attribute};
901    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
902    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
903    delete $self->{self_closing};    delete $self->{self_closing};
   $self->{char} = [];  
904    # $self->{next_char}    # $self->{next_char}
905    !!!next-input-character;    !!!next-input-character;
906    $self->{token} = [];    $self->{token} = [];
# Line 829  sub _initialize_tokenizer ($) { Line 924  sub _initialize_tokenizer ($) {
924  ##     |->{self_closing}| is used to save the value of |$self->{self_closing}|  ##     |->{self_closing}| is used to save the value of |$self->{self_closing}|
925  ##     while the token is pushed back to the stack.  ##     while the token is pushed back to the stack.
926    
 ## ISSUE: "When a DOCTYPE token is created, its  
 ## <i>self-closing flag</i> must be unset (its other state is that it  
 ## be set), and its attributes list must be empty.": Wrong subject?  
   
927  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
928    
929  ## Before each step, UA MAY check to see if either one of the scripts in  ## Before each step, UA MAY check to see if either one of the scripts in
# Line 841  sub _initialize_tokenizer ($) { Line 932  sub _initialize_tokenizer ($) {
932  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
933  ## and removed from the list.  ## and removed from the list.
934    
935  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
936  ## documents and not to user agents and conformance checkers,  ## (This requirement was dropped from HTML5 spec, unfortunately.)
 ## contains some requirements that are not detected by the  
 ## parsing algorithm:  
 ## - Some requirements on character encoding declarations. ## TODO  
 ## - "Elements MUST NOT contain content that their content model disallows."  
 ##   ... Some are parse error, some are not (will be reported by c.c.).  
 ## - Polytheistic slash SHOULD NOT be used. (Applied only to atheists.) ## TODO  
 ## - Text (in elements, attributes, and comments) SHOULD NOT contain  
 ##   control characters other than space characters. ## TODO: (what is control character? C0, C1 and DEL?  Unicode control character?)  
   
 ## TODO: HTML5 poses authors two SHOULD-level requirements that cannot  
 ## be detected by the HTML5 parsing algorithm:  
 ## - Text,  
937    
938  sub _get_next_token ($) {  sub _get_next_token ($) {
939    my $self = shift;    my $self = shift;
# Line 878  sub _get_next_token ($) { Line 957  sub _get_next_token ($) {
957          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
958              not $self->{escape}) {              not $self->{escape}) {
959            !!!cp (1);            !!!cp (1);
960            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
961              ## "entity data state".  In this implementation, the tokenizer
962              ## is switched to the |ENTITY_STATE|, which is an implementation
963              ## of the "consume a character reference" algorithm.
964              $self->{entity_additional} = -1;
965              $self->{prev_state} = DATA_STATE;
966              $self->{state} = ENTITY_STATE;
967            !!!next-input-character;            !!!next-input-character;
968            redo A;            redo A;
969          } else {          } else {
# Line 942  sub _get_next_token ($) { Line 1027  sub _get_next_token ($) {
1027                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1028                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1029                    };                    };
1030          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1031    
1032        ## Stay in the data state        ## Stay in the data state
1033        !!!next-input-character;        !!!next-input-character;
1034    
1035        !!!emit ($token);        !!!emit ($token);
1036    
1037        redo A;        redo A;
     } elsif ($self->{state} == ENTITY_DATA_STATE) {  
       ## (cannot happen in CDATA state)  
   
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev});  
         
       my $token = $self->_tokenize_attempt_to_consume_an_entity (0, -1);  
   
       $self->{state} = DATA_STATE;  
       # next-input-character is already done  
   
       unless (defined $token) {  
         !!!cp (13);  
         !!!emit ({type => CHARACTER_TOKEN, data => '&',  
                   line => $l, column => $c,  
                  });  
       } else {  
         !!!cp (14);  
         !!!emit ($token);  
       }  
   
       redo A;  
1038      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1039        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1040          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 1065  sub _get_next_token ($) { Line 1131  sub _get_next_token ($) {
1131          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1132        }        }
1133      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1134          ## NOTE: The "close tag open state" in the spec is implemented as
1135          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1136    
1137        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1138        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1139          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1140              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1141            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1142            my @next_char;            ## Reconsume.
1143            TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            redo A;
             push @next_char, $self->{next_char};  
             my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);  
             my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;  
             if ($self->{next_char} == $c or $self->{next_char} == $C) {  
               !!!cp (24);  
               !!!next-input-character;  
               next TAGNAME;  
             } else {  
               !!!cp (25);  
               $self->{next_char} = shift @next_char; # reconsume  
               !!!back-next-input-character (@next_char);  
               $self->{state} = DATA_STATE;  
   
               !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                         line => $l, column => $c,  
                        });  
     
               redo A;  
             }  
           }  
           push @next_char, $self->{next_char};  
         
           unless ($self->{next_char} == 0x0009 or # HT  
                   $self->{next_char} == 0x000A or # LF  
                   $self->{next_char} == 0x000B or # VT  
                   $self->{next_char} == 0x000C or # FF  
                   $self->{next_char} == 0x0020 or # SP  
                   $self->{next_char} == 0x003E or # >  
                   $self->{next_char} == 0x002F or # /  
                   $self->{next_char} == -1) {  
             !!!cp (26);  
             $self->{next_char} = shift @next_char; # reconsume  
             !!!back-next-input-character (@next_char);  
             $self->{state} = DATA_STATE;  
             !!!emit ({type => CHARACTER_TOKEN, data => '</',  
                       line => $l, column => $c,  
                      });  
             redo A;  
           } else {  
             !!!cp (27);  
             $self->{next_char} = shift @next_char;  
             !!!back-next-input-character (@next_char);  
             # and consume...  
           }  
1144          } else {          } else {
1145            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1146              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1147            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1148            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1149              ## Reconsume.
1150            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1151                      line => $l, column => $c,                      line => $l, column => $c,
1152                     });                     });
1153            redo A;            redo A;
1154          }          }
1155        }        }
1156          
1157        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1158            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1159          !!!cp (29);          !!!cp (29);
# Line 1174  sub _get_next_token ($) { Line 1200  sub _get_next_token ($) {
1200                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1201                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1202                                   };                                   };
1203          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1204          redo A;          ## Although the "anything else" case of the spec not explicitly
1205            ## states that the next input character is to be reconsumed,
1206            ## it will be included to the |data| of the comment token
1207            ## generated from the bogus end tag, as defined in the
1208            ## "bogus comment state" entry.
1209            redo A;
1210          }
1211        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1212          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1213          if (length $ch) {
1214            my $CH = $ch;
1215            $ch =~ tr/a-z/A-Z/;
1216            my $nch = chr $self->{next_char};
1217            if ($nch eq $ch or $nch eq $CH) {
1218              !!!cp (24);
1219              ## Stay in the state.
1220              $self->{state_keyword} .= $nch;
1221              !!!next-input-character;
1222              redo A;
1223            } else {
1224              !!!cp (25);
1225              $self->{state} = DATA_STATE;
1226              ## Reconsume.
1227              !!!emit ({type => CHARACTER_TOKEN,
1228                        data => '</' . $self->{state_keyword},
1229                        line => $self->{line_prev},
1230                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1231                       });
1232              redo A;
1233            }
1234          } else { # after "<{tag-name}"
1235            unless ({
1236                     0x0009 => 1, # HT
1237                     0x000A => 1, # LF
1238                     0x000B => 1, # VT
1239                     0x000C => 1, # FF
1240                     0x0020 => 1, # SP
1241                     0x003E => 1, # >
1242                     0x002F => 1, # /
1243                     -1 => 1, # EOF
1244                    }->{$self->{next_char}}) {
1245              !!!cp (26);
1246              ## Reconsume.
1247              $self->{state} = DATA_STATE;
1248              !!!emit ({type => CHARACTER_TOKEN,
1249                        data => '</' . $self->{state_keyword},
1250                        line => $self->{line_prev},
1251                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1252                       });
1253              redo A;
1254            } else {
1255              !!!cp (27);
1256              $self->{current_token}
1257                  = {type => END_TAG_TOKEN,
1258                     tag_name => $self->{last_emitted_start_tag_name},
1259                     line => $self->{line_prev},
1260                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1261              $self->{state} = TAG_NAME_STATE;
1262              ## Reconsume.
1263              redo A;
1264            }
1265        }        }
1266      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1267        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1345  sub _get_next_token ($) { Line 1431  sub _get_next_token ($) {
1431          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
1432              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
1433            !!!cp (57);            !!!cp (57);
1434            !!!parse-error (type => 'duplicate attribute:'.$self->{current_attribute}->{name}, line => $self->{current_attribute}->{line}, column => $self->{current_attribute}->{column});            !!!parse-error (type => 'duplicate attribute', text => $self->{current_attribute}->{name}, line => $self->{current_attribute}->{line}, column => $self->{current_attribute}->{column});
1435            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
1436          } else {          } else {
1437            !!!cp (58);            !!!cp (58);
# Line 1516  sub _get_next_token ($) { Line 1602  sub _get_next_token ($) {
1602    
1603          redo A;          redo A;
1604        } else {        } else {
1605          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1606                $self->{next_char} == 0x0027) { # '
1607              !!!cp (78);
1608              !!!parse-error (type => 'bad attribute name');
1609            } else {
1610              !!!cp (82);
1611            }
1612          $self->{current_attribute}          $self->{current_attribute}
1613              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1614                 value => '',                 value => '',
# Line 1551  sub _get_next_token ($) { Line 1643  sub _get_next_token ($) {
1643          !!!next-input-character;          !!!next-input-character;
1644          redo A;          redo A;
1645        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1646            !!!parse-error (type => 'empty unquoted attribute value');
1647          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1648            !!!cp (87);            !!!cp (87);
1649            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1615  sub _get_next_token ($) { Line 1708  sub _get_next_token ($) {
1708          redo A;          redo A;
1709        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1710          !!!cp (96);          !!!cp (96);
1711          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1712          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1713            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1714            ## implementation of the "consume a character reference" algorithm.
1715            $self->{prev_state} = $self->{state};
1716            $self->{entity_additional} = 0x0022; # "
1717            $self->{state} = ENTITY_STATE;
1718          !!!next-input-character;          !!!next-input-character;
1719          redo A;          redo A;
1720        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1645  sub _get_next_token ($) { Line 1743  sub _get_next_token ($) {
1743        } else {        } else {
1744          !!!cp (100);          !!!cp (100);
1745          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1746            $self->{read_until}->($self->{current_attribute}->{value},
1747                                  q["&],
1748                                  length $self->{current_attribute}->{value});
1749    
1750          ## Stay in the state          ## Stay in the state
1751          !!!next-input-character;          !!!next-input-character;
1752          redo A;          redo A;
# Line 1657  sub _get_next_token ($) { Line 1759  sub _get_next_token ($) {
1759          redo A;          redo A;
1760        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1761          !!!cp (102);          !!!cp (102);
1762          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1763          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1764            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1765            ## implementation of the "consume a character reference" algorithm.
1766            $self->{entity_additional} = 0x0027; # '
1767            $self->{prev_state} = $self->{state};
1768            $self->{state} = ENTITY_STATE;
1769          !!!next-input-character;          !!!next-input-character;
1770          redo A;          redo A;
1771        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1687  sub _get_next_token ($) { Line 1794  sub _get_next_token ($) {
1794        } else {        } else {
1795          !!!cp (106);          !!!cp (106);
1796          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1797            $self->{read_until}->($self->{current_attribute}->{value},
1798                                  q['&],
1799                                  length $self->{current_attribute}->{value});
1800    
1801          ## Stay in the state          ## Stay in the state
1802          !!!next-input-character;          !!!next-input-character;
1803          redo A;          redo A;
# Line 1703  sub _get_next_token ($) { Line 1814  sub _get_next_token ($) {
1814          redo A;          redo A;
1815        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1816          !!!cp (108);          !!!cp (108);
1817          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1818          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1819            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1820            ## implementation of the "consume a character reference" algorithm.
1821            $self->{entity_additional} = -1;
1822            $self->{prev_state} = $self->{state};
1823            $self->{state} = ENTITY_STATE;
1824          !!!next-input-character;          !!!next-input-character;
1825          redo A;          redo A;
1826        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1764  sub _get_next_token ($) { Line 1880  sub _get_next_token ($) {
1880            !!!cp (116);            !!!cp (116);
1881          }          }
1882          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1883            $self->{read_until}->($self->{current_attribute}->{value},
1884                                  q["'=& >],
1885                                  length $self->{current_attribute}->{value});
1886    
1887          ## Stay in the state          ## Stay in the state
1888          !!!next-input-character;          !!!next-input-character;
1889          redo A;          redo A;
1890        }        }
     } elsif ($self->{state} == ENTITY_IN_ATTRIBUTE_VALUE_STATE) {  
       my $token = $self->_tokenize_attempt_to_consume_an_entity  
           (1,  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE ? 0x0022 : # "  
            $self->{last_attribute_value_state}  
              == ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE ? 0x0027 : # '  
            -1);  
   
       unless (defined $token) {  
         !!!cp (117);  
         $self->{current_attribute}->{value} .= '&';  
       } else {  
         !!!cp (118);  
         $self->{current_attribute}->{value} .= $token->{data};  
         $self->{current_attribute}->{has_reference} = $token->{has_reference};  
         ## ISSUE: spec says "append the returned character token to the current attribute's value"  
       }  
   
       $self->{state} = $self->{last_attribute_value_state};  
       # next-input-character is already done  
       redo A;  
1891      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1892        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1893            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1827  sub _get_next_token ($) { Line 1925  sub _get_next_token ($) {
1925          $self->{state} = SELF_CLOSING_START_TAG_STATE;          $self->{state} = SELF_CLOSING_START_TAG_STATE;
1926          !!!next-input-character;          !!!next-input-character;
1927          redo A;          redo A;
1928          } elsif ($self->{next_char} == -1) {
1929            !!!parse-error (type => 'unclosed tag');
1930            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1931              !!!cp (122.3);
1932              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1933            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1934              if ($self->{current_token}->{attributes}) {
1935                !!!cp (122.1);
1936                !!!parse-error (type => 'end tag attribute');
1937              } else {
1938                ## NOTE: This state should never be reached.
1939                !!!cp (122.2);
1940              }
1941            } else {
1942              die "$0: $self->{current_token}->{type}: Unknown token type";
1943            }
1944            $self->{state} = DATA_STATE;
1945            ## Reconsume.
1946            !!!emit ($self->{current_token}); # start tag or end tag
1947            redo A;
1948        } else {        } else {
1949          !!!cp ('124.1');          !!!cp ('124.1');
1950          !!!parse-error (type => 'no space between attributes');          !!!parse-error (type => 'no space between attributes');
# Line 1859  sub _get_next_token ($) { Line 1977  sub _get_next_token ($) {
1977          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
1978    
1979          redo A;          redo A;
1980          } elsif ($self->{next_char} == -1) {
1981            !!!parse-error (type => 'unclosed tag');
1982            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1983              !!!cp (124.7);
1984              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1985            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1986              if ($self->{current_token}->{attributes}) {
1987                !!!cp (124.5);
1988                !!!parse-error (type => 'end tag attribute');
1989              } else {
1990                ## NOTE: This state should never be reached.
1991                !!!cp (124.6);
1992              }
1993            } else {
1994              die "$0: $self->{current_token}->{type}: Unknown token type";
1995            }
1996            $self->{state} = DATA_STATE;
1997            ## Reconsume.
1998            !!!emit ($self->{current_token}); # start tag or end tag
1999            redo A;
2000        } else {        } else {
2001          !!!cp ('124.4');          !!!cp ('124.4');
2002          !!!parse-error (type => 'nestc');          !!!parse-error (type => 'nestc');
# Line 1869  sub _get_next_token ($) { Line 2007  sub _get_next_token ($) {
2007        }        }
2008      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2009        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
         
       ## NOTE: Set by the previous state  
       #my $token = {type => COMMENT_TOKEN, data => ''};  
   
       BC: {  
         if ($self->{next_char} == 0x003E) { # >  
           !!!cp (124);  
           $self->{state} = DATA_STATE;  
           !!!next-input-character;  
   
           !!!emit ($self->{current_token}); # comment  
2010    
2011            redo A;        ## NOTE: Unlike spec's "bogus comment state", this implementation
2012          } elsif ($self->{next_char} == -1) {        ## consumes characters one-by-one basis.
2013            !!!cp (125);        
2014            $self->{state} = DATA_STATE;        if ($self->{next_char} == 0x003E) { # >
2015            ## reconsume          !!!cp (124);
2016            $self->{state} = DATA_STATE;
2017            !!!next-input-character;
2018    
2019            !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
2020            redo A;
2021          } elsif ($self->{next_char} == -1) {
2022            !!!cp (125);
2023            $self->{state} = DATA_STATE;
2024            ## reconsume
2025    
2026            redo A;          !!!emit ($self->{current_token}); # comment
2027          } else {          redo A;
2028            !!!cp (126);        } else {
2029            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (126);
2030            !!!next-input-character;          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2031            redo BC;          $self->{read_until}->($self->{current_token}->{data},
2032          }                                q[>],
2033        } # BC                                length $self->{current_token}->{data});
2034    
2035        die "$0: _get_next_token: unexpected case [BC]";          ## Stay in the state.
2036            !!!next-input-character;
2037            redo A;
2038          }
2039      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2040        ## (only happen if PCDATA state)        ## (only happen if PCDATA state)
   
       my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1);  
   
       my @next_char;  
       push @next_char, $self->{next_char};  
2041                
2042        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2043            !!!cp (133);
2044            $self->{state} = MD_HYPHEN_STATE;
2045          !!!next-input-character;          !!!next-input-character;
2046          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x002D) { # -  
           !!!cp (127);  
           $self->{current_token} = {type => COMMENT_TOKEN, data => '',  
                                     line => $l, column => $c,  
                                    };  
           $self->{state} = COMMENT_START_STATE;  
           !!!next-input-character;  
           redo A;  
         } else {  
           !!!cp (128);  
         }  
2047        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2048                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2049            ## ASCII case-insensitive.
2050            !!!cp (130);
2051            $self->{state} = MD_DOCTYPE_STATE;
2052            $self->{state_keyword} = chr $self->{next_char};
2053          !!!next-input-character;          !!!next-input-character;
2054          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x004F or # O  
             $self->{next_char} == 0x006F) { # o  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0043 or # C  
               $self->{next_char} == 0x0063) { # c  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0054 or # T  
                 $self->{next_char} == 0x0074) { # t  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0059 or # Y  
                   $self->{next_char} == 0x0079) { # y  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0050 or # P  
                     $self->{next_char} == 0x0070) { # p  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x0045 or # E  
                       $self->{next_char} == 0x0065) { # e  
                     !!!cp (129);  
                     ## TODO: What a stupid code this is!  
                     $self->{state} = DOCTYPE_STATE;  
                     $self->{current_token} = {type => DOCTYPE_TOKEN,  
                                               quirks => 1,  
                                               line => $l, column => $c,  
                                              };  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (130);  
                   }  
                 } else {  
                   !!!cp (131);  
                 }  
               } else {  
                 !!!cp (132);  
               }  
             } else {  
               !!!cp (133);  
             }  
           } else {  
             !!!cp (134);  
           }  
         } else {  
           !!!cp (135);  
         }  
2055        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2056                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2057                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2058            !!!cp (135.4);                
2059            $self->{state} = MD_CDATA_STATE;
2060            $self->{state_keyword} = '[';
2061          !!!next-input-character;          !!!next-input-character;
2062          push @next_char, $self->{next_char};          redo A;
         if ($self->{next_char} == 0x0043) { # C  
           !!!next-input-character;  
           push @next_char, $self->{next_char};  
           if ($self->{next_char} == 0x0044) { # D  
             !!!next-input-character;  
             push @next_char, $self->{next_char};  
             if ($self->{next_char} == 0x0041) { # A  
               !!!next-input-character;  
               push @next_char, $self->{next_char};  
               if ($self->{next_char} == 0x0054) { # T  
                 !!!next-input-character;  
                 push @next_char, $self->{next_char};  
                 if ($self->{next_char} == 0x0041) { # A  
                   !!!next-input-character;  
                   push @next_char, $self->{next_char};  
                   if ($self->{next_char} == 0x005B) { # [  
                     !!!cp (135.1);  
                     $self->{state} = CDATA_BLOCK_STATE;  
                     !!!next-input-character;  
                     redo A;  
                   } else {  
                     !!!cp (135.2);  
                   }  
                 } else {  
                   !!!cp (135.3);  
                 }  
               } else {  
                 !!!cp (135.4);                  
               }  
             } else {  
               !!!cp (135.5);  
             }  
           } else {  
             !!!cp (135.6);  
           }  
         } else {  
           !!!cp (135.7);  
         }  
2063        } else {        } else {
2064          !!!cp (136);          !!!cp (136);
2065        }        }
2066    
2067        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2068        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2069        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2070          ## Reconsume.
2071        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2072        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2073                                  line => $l, column => $c,                                  line => $self->{line_prev},
2074                                    column => $self->{column_prev} - 1,
2075                                 };                                 };
2076        redo A;        redo A;
2077              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2078        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2079        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?          !!!cp (127);
2080            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2081                                      line => $self->{line_prev},
2082                                      column => $self->{column_prev} - 2,
2083                                     };
2084            $self->{state} = COMMENT_START_STATE;
2085            !!!next-input-character;
2086            redo A;
2087          } else {
2088            !!!cp (128);
2089            !!!parse-error (type => 'bogus comment',
2090                            line => $self->{line_prev},
2091                            column => $self->{column_prev} - 2);
2092            $self->{state} = BOGUS_COMMENT_STATE;
2093            ## Reconsume.
2094            $self->{current_token} = {type => COMMENT_TOKEN,
2095                                      data => '-',
2096                                      line => $self->{line_prev},
2097                                      column => $self->{column_prev} - 2,
2098                                     };
2099            redo A;
2100          }
2101        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2102          ## ASCII case-insensitive.
2103          if ($self->{next_char} == [
2104                undef,
2105                0x004F, # O
2106                0x0043, # C
2107                0x0054, # T
2108                0x0059, # Y
2109                0x0050, # P
2110              ]->[length $self->{state_keyword}] or
2111              $self->{next_char} == [
2112                undef,
2113                0x006F, # o
2114                0x0063, # c
2115                0x0074, # t
2116                0x0079, # y
2117                0x0070, # p
2118              ]->[length $self->{state_keyword}]) {
2119            !!!cp (131);
2120            ## Stay in the state.
2121            $self->{state_keyword} .= chr $self->{next_char};
2122            !!!next-input-character;
2123            redo A;
2124          } elsif ((length $self->{state_keyword}) == 6 and
2125                   ($self->{next_char} == 0x0045 or # E
2126                    $self->{next_char} == 0x0065)) { # e
2127            !!!cp (129);
2128            $self->{state} = DOCTYPE_STATE;
2129            $self->{current_token} = {type => DOCTYPE_TOKEN,
2130                                      quirks => 1,
2131                                      line => $self->{line_prev},
2132                                      column => $self->{column_prev} - 7,
2133                                     };
2134            !!!next-input-character;
2135            redo A;
2136          } else {
2137            !!!cp (132);        
2138            !!!parse-error (type => 'bogus comment',
2139                            line => $self->{line_prev},
2140                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2141            $self->{state} = BOGUS_COMMENT_STATE;
2142            ## Reconsume.
2143            $self->{current_token} = {type => COMMENT_TOKEN,
2144                                      data => $self->{state_keyword},
2145                                      line => $self->{line_prev},
2146                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2147                                     };
2148            redo A;
2149          }
2150        } elsif ($self->{state} == MD_CDATA_STATE) {
2151          if ($self->{next_char} == {
2152                '[' => 0x0043, # C
2153                '[C' => 0x0044, # D
2154                '[CD' => 0x0041, # A
2155                '[CDA' => 0x0054, # T
2156                '[CDAT' => 0x0041, # A
2157              }->{$self->{state_keyword}}) {
2158            !!!cp (135.1);
2159            ## Stay in the state.
2160            $self->{state_keyword} .= chr $self->{next_char};
2161            !!!next-input-character;
2162            redo A;
2163          } elsif ($self->{state_keyword} eq '[CDATA' and
2164                   $self->{next_char} == 0x005B) { # [
2165            !!!cp (135.2);
2166            $self->{current_token} = {type => CHARACTER_TOKEN,
2167                                      data => '',
2168                                      line => $self->{line_prev},
2169                                      column => $self->{column_prev} - 7};
2170            $self->{state} = CDATA_SECTION_STATE;
2171            !!!next-input-character;
2172            redo A;
2173          } else {
2174            !!!cp (135.3);
2175            !!!parse-error (type => 'bogus comment',
2176                            line => $self->{line_prev},
2177                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2178            $self->{state} = BOGUS_COMMENT_STATE;
2179            ## Reconsume.
2180            $self->{current_token} = {type => COMMENT_TOKEN,
2181                                      data => $self->{state_keyword},
2182                                      line => $self->{line_prev},
2183                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2184                                     };
2185            redo A;
2186          }
2187      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2188        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2189          !!!cp (137);          !!!cp (137);
# Line 2114  sub _get_next_token ($) { Line 2266  sub _get_next_token ($) {
2266        } else {        } else {
2267          !!!cp (147);          !!!cp (147);
2268          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2269            $self->{read_until}->($self->{current_token}->{data},
2270                                  q[-],
2271                                  length $self->{current_token}->{data});
2272    
2273          ## Stay in the state          ## Stay in the state
2274          !!!next-input-character;          !!!next-input-character;
2275          redo A;          redo A;
# Line 2298  sub _get_next_token ($) { Line 2454  sub _get_next_token ($) {
2454          redo A;          redo A;
2455        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2456                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2457            $self->{state} = PUBLIC_STATE;
2458            $self->{state_keyword} = chr $self->{next_char};
2459          !!!next-input-character;          !!!next-input-character;
2460          if ($self->{next_char} == 0x0055 or # U          redo A;
             $self->{next_char} == 0x0075) { # u  
           !!!next-input-character;  
           if ($self->{next_char} == 0x0042 or # B  
               $self->{next_char} == 0x0062) { # b  
             !!!next-input-character;  
             if ($self->{next_char} == 0x004C or # L  
                 $self->{next_char} == 0x006C) { # l  
               !!!next-input-character;  
               if ($self->{next_char} == 0x0049 or # I  
                   $self->{next_char} == 0x0069) { # i  
                 !!!next-input-character;  
                 if ($self->{next_char} == 0x0043 or # C  
                     $self->{next_char} == 0x0063) { # c  
                   !!!cp (168);  
                   $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;  
                   !!!next-input-character;  
                   redo A;  
                 } else {  
                   !!!cp (169);  
                 }  
               } else {  
                 !!!cp (170);  
               }  
             } else {  
               !!!cp (171);  
             }  
           } else {  
             !!!cp (172);  
           }  
         } else {  
           !!!cp (173);  
         }  
   
         #  
2461        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2462                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2463            $self->{state} = SYSTEM_STATE;
2464            $self->{state_keyword} = chr $self->{next_char};
2465          !!!next-input-character;          !!!next-input-character;
2466          if ($self->{next_char} == 0x0059 or # Y          redo A;
             $self->{next_char} == 0x0079) { # y  
           !!!next-input-character;  
           if ($self->{next_char} == 0x0053 or # S  
               $self->{next_char} == 0x0073) { # s  
             !!!next-input-character;  
             if ($self->{next_char} == 0x0054 or # T  
                 $self->{next_char} == 0x0074) { # t  
               !!!next-input-character;  
               if ($self->{next_char} == 0x0045 or # E  
                   $self->{next_char} == 0x0065) { # e  
                 !!!next-input-character;  
                 if ($self->{next_char} == 0x004D or # M  
                     $self->{next_char} == 0x006D) { # m  
                   !!!cp (174);  
                   $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;  
                   !!!next-input-character;  
                   redo A;  
                 } else {  
                   !!!cp (175);  
                 }  
               } else {  
                 !!!cp (176);  
               }  
             } else {  
               !!!cp (177);  
             }  
           } else {  
             !!!cp (178);  
           }  
         } else {  
           !!!cp (179);  
         }  
   
         #  
2467        } else {        } else {
2468          !!!cp (180);          !!!cp (180);
2469            !!!parse-error (type => 'string after DOCTYPE name');
2470            $self->{current_token}->{quirks} = 1;
2471    
2472            $self->{state} = BOGUS_DOCTYPE_STATE;
2473          !!!next-input-character;          !!!next-input-character;
2474          #          redo A;
2475        }        }
2476        } elsif ($self->{state} == PUBLIC_STATE) {
2477          ## ASCII case-insensitive
2478          if ($self->{next_char} == [
2479                undef,
2480                0x0055, # U
2481                0x0042, # B
2482                0x004C, # L
2483                0x0049, # I
2484              ]->[length $self->{state_keyword}] or
2485              $self->{next_char} == [
2486                undef,
2487                0x0075, # u
2488                0x0062, # b
2489                0x006C, # l
2490                0x0069, # i
2491              ]->[length $self->{state_keyword}]) {
2492            !!!cp (175);
2493            ## Stay in the state.
2494            $self->{state_keyword} .= chr $self->{next_char};
2495            !!!next-input-character;
2496            redo A;
2497          } elsif ((length $self->{state_keyword}) == 5 and
2498                   ($self->{next_char} == 0x0043 or # C
2499                    $self->{next_char} == 0x0063)) { # c
2500            !!!cp (168);
2501            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2502            !!!next-input-character;
2503            redo A;
2504          } else {
2505            !!!cp (169);
2506            !!!parse-error (type => 'string after DOCTYPE name',
2507                            line => $self->{line_prev},
2508                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2509            $self->{current_token}->{quirks} = 1;
2510    
2511        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2512        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2513            redo A;
2514          }
2515        } elsif ($self->{state} == SYSTEM_STATE) {
2516          ## ASCII case-insensitive
2517          if ($self->{next_char} == [
2518                undef,
2519                0x0059, # Y
2520                0x0053, # S
2521                0x0054, # T
2522                0x0045, # E
2523              ]->[length $self->{state_keyword}] or
2524              $self->{next_char} == [
2525                undef,
2526                0x0079, # y
2527                0x0073, # s
2528                0x0074, # t
2529                0x0065, # e
2530              ]->[length $self->{state_keyword}]) {
2531            !!!cp (170);
2532            ## Stay in the state.
2533            $self->{state_keyword} .= chr $self->{next_char};
2534            !!!next-input-character;
2535            redo A;
2536          } elsif ((length $self->{state_keyword}) == 5 and
2537                   ($self->{next_char} == 0x004D or # M
2538                    $self->{next_char} == 0x006D)) { # m
2539            !!!cp (171);
2540            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2541            !!!next-input-character;
2542            redo A;
2543          } else {
2544            !!!cp (172);
2545            !!!parse-error (type => 'string after DOCTYPE name',
2546                            line => $self->{line_prev},
2547                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2548            $self->{current_token}->{quirks} = 1;
2549    
2550        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2551        # next-input-character is already done          ## Reconsume.
2552        redo A;          redo A;
2553          }
2554      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2555        if ({        if ({
2556              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
# Line 2468  sub _get_next_token ($) { Line 2635  sub _get_next_token ($) {
2635          !!!cp (190);          !!!cp (190);
2636          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2637              .= chr $self->{next_char};              .= chr $self->{next_char};
2638            $self->{read_until}->($self->{current_token}->{public_identifier},
2639                                  q[">],
2640                                  length $self->{current_token}->{public_identifier});
2641    
2642          ## Stay in the state          ## Stay in the state
2643          !!!next-input-character;          !!!next-input-character;
2644          redo A;          redo A;
# Line 2504  sub _get_next_token ($) { Line 2675  sub _get_next_token ($) {
2675          !!!cp (194);          !!!cp (194);
2676          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2677              .= chr $self->{next_char};              .= chr $self->{next_char};
2678            $self->{read_until}->($self->{current_token}->{public_identifier},
2679                                  q['>],
2680                                  length $self->{current_token}->{public_identifier});
2681    
2682          ## Stay in the state          ## Stay in the state
2683          !!!next-input-character;          !!!next-input-character;
2684          redo A;          redo A;
# Line 2616  sub _get_next_token ($) { Line 2791  sub _get_next_token ($) {
2791          redo A;          redo A;
2792        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
2793          !!!cp (208);          !!!cp (208);
2794          !!!parse-error (type => 'unclosed PUBLIC literal');          !!!parse-error (type => 'unclosed SYSTEM literal');
2795    
2796          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2797          !!!next-input-character;          !!!next-input-character;
# Line 2640  sub _get_next_token ($) { Line 2815  sub _get_next_token ($) {
2815          !!!cp (210);          !!!cp (210);
2816          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2817              .= chr $self->{next_char};              .= chr $self->{next_char};
2818            $self->{read_until}->($self->{current_token}->{system_identifier},
2819                                  q[">],
2820                                  length $self->{current_token}->{system_identifier});
2821    
2822          ## Stay in the state          ## Stay in the state
2823          !!!next-input-character;          !!!next-input-character;
2824          redo A;          redo A;
# Line 2652  sub _get_next_token ($) { Line 2831  sub _get_next_token ($) {
2831          redo A;          redo A;
2832        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
2833          !!!cp (212);          !!!cp (212);
2834          !!!parse-error (type => 'unclosed PUBLIC literal');          !!!parse-error (type => 'unclosed SYSTEM literal');
2835    
2836          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2837          !!!next-input-character;          !!!next-input-character;
# Line 2676  sub _get_next_token ($) { Line 2855  sub _get_next_token ($) {
2855          !!!cp (214);          !!!cp (214);
2856          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2857              .= chr $self->{next_char};              .= chr $self->{next_char};
2858            $self->{read_until}->($self->{current_token}->{system_identifier},
2859                                  q['>],
2860                                  length $self->{current_token}->{system_identifier});
2861    
2862          ## Stay in the state          ## Stay in the state
2863          !!!next-input-character;          !!!next-input-character;
2864          redo A;          redo A;
# Line 2700  sub _get_next_token ($) { Line 2883  sub _get_next_token ($) {
2883        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
2884          !!!cp (217);          !!!cp (217);
2885          !!!parse-error (type => 'unclosed DOCTYPE');          !!!parse-error (type => 'unclosed DOCTYPE');
   
2886          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2887          ## reconsume          ## reconsume
2888    
# Line 2737  sub _get_next_token ($) { Line 2919  sub _get_next_token ($) {
2919          redo A;          redo A;
2920        } else {        } else {
2921          !!!cp (221);          !!!cp (221);
2922            my $s = '';
2923            $self->{read_until}->($s, q[>], 0);
2924    
2925          ## Stay in the state          ## Stay in the state
2926          !!!next-input-character;          !!!next-input-character;
2927          redo A;          redo A;
2928        }        }
2929      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2930        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2931          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2932          ## and |CDATA_SECTION_MSE2_STATE|.
2933                
2934        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2935            !!!cp (221.1);
2936        CS: while ($self->{next_char} != -1) {          $self->{state} = CDATA_SECTION_MSE1_STATE;
         if ($self->{next_char} == 0x005D) { # ]  
           !!!next-input-character;  
           if ($self->{next_char} == 0x005D) { # ]  
             !!!next-input-character;  
             MDC: {  
               if ($self->{next_char} == 0x003E) { # >  
                 !!!cp (221.1);  
                 !!!next-input-character;  
                 last CS;  
               } elsif ($self->{next_char} == 0x005D) { # ]  
                 !!!cp (221.2);  
                 $s .= ']';  
                 !!!next-input-character;  
                 redo MDC;  
               } else {  
                 !!!cp (221.3);  
                 $s .= ']]';  
                 #  
               }  
             } # MDC  
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
         } else {  
           !!!cp (221.5);  
           #  
         }  
         $s .= chr $self->{next_char};  
2937          !!!next-input-character;          !!!next-input-character;
2938        } # CS          redo A;
2939          } elsif ($self->{next_char} == -1) {
2940            $self->{state} = DATA_STATE;
2941            !!!next-input-character;
2942            if (length $self->{current_token}->{data}) { # character
2943              !!!cp (221.2);
2944              !!!emit ($self->{current_token}); # character
2945            } else {
2946              !!!cp (221.3);
2947              ## No token to emit. $self->{current_token} is discarded.
2948            }        
2949            redo A;
2950          } else {
2951            !!!cp (221.4);
2952            $self->{current_token}->{data} .= chr $self->{next_char};
2953            $self->{read_until}->($self->{current_token}->{data},
2954                                  q<]>,
2955                                  length $self->{current_token}->{data});
2956    
2957        $self->{state} = DATA_STATE;          ## Stay in the state.
2958        ## next-input-character done or EOF, which is reconsumed.          !!!next-input-character;
2959            redo A;
2960          }
2961    
2962        if (length $s) {        ## ISSUE: "text tokens" in spec.
2963        } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2964          if ($self->{next_char} == 0x005D) { # ]
2965            !!!cp (221.5);
2966            $self->{state} = CDATA_SECTION_MSE2_STATE;
2967            !!!next-input-character;
2968            redo A;
2969          } else {
2970          !!!cp (221.6);          !!!cp (221.6);
2971          !!!emit ({type => CHARACTER_TOKEN, data => $s,          $self->{current_token}->{data} .= ']';
2972                    line => $l, column => $c});          $self->{state} = CDATA_SECTION_STATE;
2973            ## Reconsume.
2974            redo A;
2975          }
2976        } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2977          if ($self->{next_char} == 0x003E) { # >
2978            $self->{state} = DATA_STATE;
2979            !!!next-input-character;
2980            if (length $self->{current_token}->{data}) { # character
2981              !!!cp (221.7);
2982              !!!emit ($self->{current_token}); # character
2983            } else {
2984              !!!cp (221.8);
2985              ## No token to emit. $self->{current_token} is discarded.
2986            }
2987            redo A;
2988          } elsif ($self->{next_char} == 0x005D) { # ]
2989            !!!cp (221.9); # character
2990            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2991            ## Stay in the state.
2992            !!!next-input-character;
2993            redo A;
2994        } else {        } else {
2995          !!!cp (221.7);          !!!cp (221.11);
2996            $self->{current_token}->{data} .= ']]'; # character
2997            $self->{state} = CDATA_SECTION_STATE;
2998            ## Reconsume.
2999            redo A;
3000          }
3001        } elsif ($self->{state} == ENTITY_STATE) {
3002          if ({
3003            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
3004            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
3005            $self->{entity_additional} => 1,
3006          }->{$self->{next_char}}) {
3007            !!!cp (1001);
3008            ## Don't consume
3009            ## No error
3010            ## Return nothing.
3011            #
3012          } elsif ($self->{next_char} == 0x0023) { # #
3013            !!!cp (999);
3014            $self->{state} = ENTITY_HASH_STATE;
3015            $self->{state_keyword} = '#';
3016            !!!next-input-character;
3017            redo A;
3018          } elsif ((0x0041 <= $self->{next_char} and
3019                    $self->{next_char} <= 0x005A) or # A..Z
3020                   (0x0061 <= $self->{next_char} and
3021                    $self->{next_char} <= 0x007A)) { # a..z
3022            !!!cp (998);
3023            require Whatpm::_NamedEntityList;
3024            $self->{state} = ENTITY_NAME_STATE;
3025            $self->{state_keyword} = chr $self->{next_char};
3026            $self->{entity__value} = $self->{state_keyword};
3027            $self->{entity__match} = 0;
3028            !!!next-input-character;
3029            redo A;
3030          } else {
3031            !!!cp (1027);
3032            !!!parse-error (type => 'bare ero');
3033            ## Return nothing.
3034            #
3035        }        }
3036    
3037        redo A;        ## NOTE: No character is consumed by the "consume a character
3038          ## reference" algorithm.  In other word, there is an "&" character
3039        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3040        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3041      } else {        ## process of the tokenizer.
3042        die "$0: $self->{state}: Unknown state";  
3043      }        if ($self->{prev_state} == DATA_STATE) {
3044    } # A            !!!cp (997);
3045            $self->{state} = $self->{prev_state};
3046    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3047  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3048                      line => $self->{line_prev},
3049  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3050    my ($self, $in_attr, $additional) = @_;                   });
3051            redo A;
3052    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3053            !!!cp (996);
3054            $self->{current_attribute}->{value} .= '&';
3055            $self->{state} = $self->{prev_state};
3056            ## Reconsume.
3057            redo A;
3058          }
3059        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3060          if ($self->{next_char} == 0x0078 or # x
3061              $self->{next_char} == 0x0058) { # X
3062            !!!cp (995);
3063            $self->{state} = HEXREF_X_STATE;
3064            $self->{state_keyword} .= chr $self->{next_char};
3065            !!!next-input-character;
3066            redo A;
3067          } elsif (0x0030 <= $self->{next_char} and
3068                   $self->{next_char} <= 0x0039) { # 0..9
3069            !!!cp (994);
3070            $self->{state} = NCR_NUM_STATE;
3071            $self->{state_keyword} = $self->{next_char} - 0x0030;
3072            !!!next-input-character;
3073            redo A;
3074          } else {
3075            !!!parse-error (type => 'bare nero',
3076                            line => $self->{line_prev},
3077                            column => $self->{column_prev} - 1);
3078    
3079    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3080         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3081         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3082         $additional => 1,  
3083        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3084      !!!cp (1001);            !!!cp (1019);
3085      ## Don't consume            $self->{state} = $self->{prev_state};
3086      ## No error            ## Reconsume.
3087      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3088    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3089      !!!next-input-character;                      line => $self->{line_prev},
3090      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3091          $self->{next_char} == 0x0058) { # X                     });
3092        my $code;            redo A;
       X: {  
         my $x_char = $self->{next_char};  
         !!!next-input-character;  
         if (0x0030 <= $self->{next_char} and  
             $self->{next_char} <= 0x0039) { # 0..9  
           !!!cp (1002);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0030;  
           redo X;  
         } elsif (0x0061 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0066) { # a..f  
           !!!cp (1003);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0060 + 9;  
           redo X;  
         } elsif (0x0041 <= $self->{next_char} and  
                  $self->{next_char} <= 0x0046) { # A..F  
           !!!cp (1004);  
           $code ||= 0;  
           $code *= 0x10;  
           $code += $self->{next_char} - 0x0040 + 9;  
           redo X;  
         } elsif (not defined $code) { # no hexadecimal digit  
           !!!cp (1005);  
           !!!parse-error (type => 'bare hcro', line => $l, column => $c);  
           !!!back-next-input-character ($x_char, $self->{next_char});  
           $self->{next_char} = 0x0023; # #  
           return undef;  
         } elsif ($self->{next_char} == 0x003B) { # ;  
           !!!cp (1006);  
           !!!next-input-character;  
3093          } else {          } else {
3094            !!!cp (1007);            !!!cp (993);
3095            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3096              $self->{state} = $self->{prev_state};
3097              ## Reconsume.
3098              redo A;
3099          }          }
3100          }
3101          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3102            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3103            !!!parse-error (type => (sprintf 'invalid character reference:U+%04X', $code), line => $l, column => $c);            $self->{next_char} <= 0x0039) { # 0..9
           $code = 0xFFFD;  
         } elsif ($code > 0x10FFFF) {  
           !!!cp (1009);  
           !!!parse-error (type => (sprintf 'invalid character reference:U-%08X', $code), line => $l, column => $c);  
           $code = 0xFFFD;  
         } elsif ($code == 0x000D) {  
           !!!cp (1010);  
           !!!parse-error (type => 'CR character reference', line => $l, column => $c);  
           $code = 0x000A;  
         } elsif (0x80 <= $code and $code <= 0x9F) {  
           !!!cp (1011);  
           !!!parse-error (type => (sprintf 'C1 character reference:U+%04X', $code), line => $l, column => $c);  
           $code = $c1_entity_char->{$code};  
         }  
   
         return {type => CHARACTER_TOKEN, data => chr $code,  
                 has_reference => 1,  
                 line => $l, column => $c,  
                };  
       } # X  
     } elsif (0x0030 <= $self->{next_char} and  
              $self->{next_char} <= 0x0039) { # 0..9  
       my $code = $self->{next_char} - 0x0030;  
       !!!next-input-character;  
         
       while (0x0030 <= $self->{next_char} and  
                 $self->{next_char} <= 0x0039) { # 0..9  
3104          !!!cp (1012);          !!!cp (1012);
3105          $code *= 10;          $self->{state_keyword} *= 10;
3106          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3107                    
3108            ## Stay in the state.
3109          !!!next-input-character;          !!!next-input-character;
3110        }          redo A;
3111          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3112          !!!cp (1013);          !!!cp (1013);
3113          !!!next-input-character;          !!!next-input-character;
3114            #
3115        } else {        } else {
3116          !!!cp (1014);          !!!cp (1014);
3117          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3118            ## Reconsume.
3119            #
3120        }        }
3121    
3122          my $code = $self->{state_keyword};
3123          my $l = $self->{line_prev};
3124          my $c = $self->{column_prev};
3125        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3126          !!!cp (1015);          !!!cp (1015);
3127          !!!parse-error (type => (sprintf 'invalid character reference:U+%04X', $code), line => $l, column => $c);          !!!parse-error (type => 'invalid character reference',
3128                            text => (sprintf 'U+%04X', $code),
3129                            line => $l, column => $c);
3130          $code = 0xFFFD;          $code = 0xFFFD;
3131        } elsif ($code > 0x10FFFF) {        } elsif ($code > 0x10FFFF) {
3132          !!!cp (1016);          !!!cp (1016);
3133          !!!parse-error (type => (sprintf 'invalid character reference:U-%08X', $code), line => $l, column => $c);          !!!parse-error (type => 'invalid character reference',
3134                            text => (sprintf 'U-%08X', $code),
3135                            line => $l, column => $c);
3136          $code = 0xFFFD;          $code = 0xFFFD;
3137        } elsif ($code == 0x000D) {        } elsif ($code == 0x000D) {
3138          !!!cp (1017);          !!!cp (1017);
3139          !!!parse-error (type => 'CR character reference', line => $l, column => $c);          !!!parse-error (type => 'CR character reference',
3140                            line => $l, column => $c);
3141          $code = 0x000A;          $code = 0x000A;
3142        } elsif (0x80 <= $code and $code <= 0x9F) {        } elsif (0x80 <= $code and $code <= 0x9F) {
3143          !!!cp (1018);          !!!cp (1018);
3144          !!!parse-error (type => (sprintf 'C1 character reference:U+%04X', $code), line => $l, column => $c);          !!!parse-error (type => 'C1 character reference',
3145                            text => (sprintf 'U+%04X', $code),
3146                            line => $l, column => $c);
3147          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3148        }        }
3149          
3150        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3151                line => $l, column => $c,          !!!cp (992);
3152               };          $self->{state} = $self->{prev_state};
3153      } else {          ## Reconsume.
3154        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3155        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3156        !!!back-next-input-character ($self->{next_char});                   });
3157        $self->{next_char} = 0x0023; # #          redo A;
3158        return undef;        } else {
3159      }          !!!cp (991);
3160    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3161              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3162             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3163              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3164      my $entity_name = chr $self->{next_char};          redo A;
3165      !!!next-input-character;        }
3166        } elsif ($self->{state} == HEXREF_X_STATE) {
3167      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3168      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3169      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3170      our $EntityChar;          # 0..9, A..F, a..f
3171            !!!cp (990);
3172      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3173             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3174             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3175               $self->{next_char} <= 0x005A) or # x          redo A;
3176              (0x0061 <= $self->{next_char} and # a        } else {
3177               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3178              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3179               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3180              $self->{next_char} == 0x003B)) { # ;  
3181        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3182        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3183          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3184            !!!cp (1020);  
3185            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3186            $match = 1;            !!!cp (1005);
3187            !!!next-input-character;            $self->{state} = $self->{prev_state};
3188            last;            ## Reconsume.
3189              !!!emit ({type => CHARACTER_TOKEN,
3190                        data => '&' . $self->{state_keyword},
3191                        line => $self->{line_prev},
3192                        column => $self->{column_prev} - length $self->{state_keyword},
3193                       });
3194              redo A;
3195            } else {
3196              !!!cp (989);
3197              $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3198              $self->{state} = $self->{prev_state};
3199              ## Reconsume.
3200              redo A;
3201            }
3202          }
3203        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3204          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3205            # 0..9
3206            !!!cp (1002);
3207            $self->{state_keyword} *= 0x10;
3208            $self->{state_keyword} += $self->{next_char} - 0x0030;
3209            ## Stay in the state.
3210            !!!next-input-character;
3211            redo A;
3212          } elsif (0x0061 <= $self->{next_char} and
3213                   $self->{next_char} <= 0x0066) { # a..f
3214            !!!cp (1003);
3215            $self->{state_keyword} *= 0x10;
3216            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3217            ## Stay in the state.
3218            !!!next-input-character;
3219            redo A;
3220          } elsif (0x0041 <= $self->{next_char} and
3221                   $self->{next_char} <= 0x0046) { # A..F
3222            !!!cp (1004);
3223            $self->{state_keyword} *= 0x10;
3224            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3225            ## Stay in the state.
3226            !!!next-input-character;
3227            redo A;
3228          } elsif ($self->{next_char} == 0x003B) { # ;
3229            !!!cp (1006);
3230            !!!next-input-character;
3231            #
3232          } else {
3233            !!!cp (1007);
3234            !!!parse-error (type => 'no refc',
3235                            line => $self->{line},
3236                            column => $self->{column});
3237            ## Reconsume.
3238            #
3239          }
3240    
3241          my $code = $self->{state_keyword};
3242          my $l = $self->{line_prev};
3243          my $c = $self->{column_prev};
3244          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3245            !!!cp (1008);
3246            !!!parse-error (type => 'invalid character reference',
3247                            text => (sprintf 'U+%04X', $code),
3248                            line => $l, column => $c);
3249            $code = 0xFFFD;
3250          } elsif ($code > 0x10FFFF) {
3251            !!!cp (1009);
3252            !!!parse-error (type => 'invalid character reference',
3253                            text => (sprintf 'U-%08X', $code),
3254                            line => $l, column => $c);
3255            $code = 0xFFFD;
3256          } elsif ($code == 0x000D) {
3257            !!!cp (1010);
3258            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3259            $code = 0x000A;
3260          } elsif (0x80 <= $code and $code <= 0x9F) {
3261            !!!cp (1011);
3262            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3263            $code = $c1_entity_char->{$code};
3264          }
3265    
3266          if ($self->{prev_state} == DATA_STATE) {
3267            !!!cp (988);
3268            $self->{state} = $self->{prev_state};
3269            ## Reconsume.
3270            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3271                      line => $l, column => $c,
3272                     });
3273            redo A;
3274          } else {
3275            !!!cp (987);
3276            $self->{current_attribute}->{value} .= chr $code;
3277            $self->{current_attribute}->{has_reference} = 1;
3278            $self->{state} = $self->{prev_state};
3279            ## Reconsume.
3280            redo A;
3281          }
3282        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3283          if (length $self->{state_keyword} < 30 and
3284              ## NOTE: Some number greater than the maximum length of entity name
3285              ((0x0041 <= $self->{next_char} and # a
3286                $self->{next_char} <= 0x005A) or # x
3287               (0x0061 <= $self->{next_char} and # a
3288                $self->{next_char} <= 0x007A) or # z
3289               (0x0030 <= $self->{next_char} and # 0
3290                $self->{next_char} <= 0x0039) or # 9
3291               $self->{next_char} == 0x003B)) { # ;
3292            our $EntityChar;
3293            $self->{state_keyword} .= chr $self->{next_char};
3294            if (defined $EntityChar->{$self->{state_keyword}}) {
3295              if ($self->{next_char} == 0x003B) { # ;
3296                !!!cp (1020);
3297                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3298                $self->{entity__match} = 1;
3299                !!!next-input-character;
3300                #
3301              } else {
3302                !!!cp (1021);
3303                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3304                $self->{entity__match} = -1;
3305                ## Stay in the state.
3306                !!!next-input-character;
3307                redo A;
3308              }
3309          } else {          } else {
3310            !!!cp (1021);            !!!cp (1022);
3311            $value = $EntityChar->{$entity_name};            $self->{entity__value} .= chr $self->{next_char};
3312            $match = -1;            $self->{entity__match} *= 2;
3313              ## Stay in the state.
3314            !!!next-input-character;            !!!next-input-character;
3315              redo A;
3316            }
3317          }
3318    
3319          my $data;
3320          my $has_ref;
3321          if ($self->{entity__match} > 0) {
3322            !!!cp (1023);
3323            $data = $self->{entity__value};
3324            $has_ref = 1;
3325            #
3326          } elsif ($self->{entity__match} < 0) {
3327            !!!parse-error (type => 'no refc');
3328            if ($self->{prev_state} != DATA_STATE and # in attribute
3329                $self->{entity__match} < -1) {
3330              !!!cp (1024);
3331              $data = '&' . $self->{state_keyword};
3332              #
3333            } else {
3334              !!!cp (1025);
3335              $data = $self->{entity__value};
3336              $has_ref = 1;
3337              #
3338          }          }
3339        } else {        } else {
3340          !!!cp (1022);          !!!cp (1026);
3341          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3342          $match *= 2;                          line => $self->{line_prev},
3343          !!!next-input-character;                          column => $self->{column_prev} - length $self->{state_keyword});
3344            $data = '&' . $self->{state_keyword};
3345            #
3346        }        }
3347      }    
3348              ## NOTE: In these cases, when a character reference is found,
3349      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3350        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3351        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3352                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3353               };        ## as string, either literal string when no character reference or
3354      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3355        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3356        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3357          !!!cp (1024);  
3358          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3359                  line => $l, column => $c,          !!!cp (986);
3360                 };          $self->{state} = $self->{prev_state};
3361        } else {          ## Reconsume.
3362          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3363          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3364                  line => $l, column => $c,                    line => $self->{line_prev},
3365                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3366                     });
3367            redo A;
3368          } else {
3369            !!!cp (985);
3370            $self->{current_attribute}->{value} .= $data;
3371            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3372            $self->{state} = $self->{prev_state};
3373            ## Reconsume.
3374            redo A;
3375        }        }
3376      } else {      } else {
3377        !!!cp (1026);        die "$0: $self->{state}: Unknown state";
       !!!parse-error (type => 'bare ero', line => $l, column => $c);  
       ## NOTE: "No characters are consumed" in the spec.  
       return {type => CHARACTER_TOKEN, data => '&'.$value,  
               line => $l, column => $c,  
              };  
3378      }      }
3379    } else {    } # A  
3380      !!!cp (1027);  
3381      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3382      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3383    
3384  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3385    my $self = shift;    my $self = shift;
# Line 3017  sub _initialize_tree_constructor ($) { Line 3388  sub _initialize_tree_constructor ($) {
3388    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
3389    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
3390    $self->{document}->manakai_is_html (1); # MUST    $self->{document}->manakai_is_html (1); # MUST
3391      $self->{document}->set_user_data (manakai_source_line => 1);
3392      $self->{document}->set_user_data (manakai_source_column => 1);
3393  } # _initialize_tree_constructor  } # _initialize_tree_constructor
3394    
3395  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 3071  sub _tree_construction_initial ($) { Line 3444  sub _tree_construction_initial ($) {
3444        ## language.        ## language.
3445        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3446        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3447        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3448        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3449            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3450          !!!cp ('t1');          !!!cp ('t1');
3451          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3452        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3453          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3454          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3455          } elsif (defined $token->{public_identifier}) {
3456            if ($token->{public_identifier} eq 'XSLT-compat') {
3457              !!!cp ('t1.2');
3458              !!!parse-error (type => 'XSLT-compat', token => $token,
3459                              level => $self->{level}->{should});
3460            } else {
3461              !!!parse-error (type => 'not HTML5', token => $token);
3462            }
3463        } else {        } else {
3464          !!!cp ('t3');          !!!cp ('t3');
3465            #
3466        }        }
3467                
3468        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 3103  sub _tree_construction_initial ($) { Line 3483  sub _tree_construction_initial ($) {
3483        } elsif (defined $token->{public_identifier}) {        } elsif (defined $token->{public_identifier}) {
3484          my $pubid = $token->{public_identifier};          my $pubid = $token->{public_identifier};
3485          $pubid =~ tr/a-z/A-z/;          $pubid =~ tr/a-z/A-z/;
3486          if ({          my $prefix = [
3487            "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,            "+//SILMARIL//DTD HTML PRO V0R11 19970101//",
3488            "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,            "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//",
3489            "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,            "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//",
3490            "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,            "-//IETF//DTD HTML 2.0 LEVEL 1//",
3491            "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,            "-//IETF//DTD HTML 2.0 LEVEL 2//",
3492            "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//",
3493            "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//",
3494            "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT//",
3495            "-//IETF//DTD HTML 2.0//EN" => 1,            "-//IETF//DTD HTML 2.0//",
3496            "-//IETF//DTD HTML 2.1E//EN" => 1,            "-//IETF//DTD HTML 2.1E//",
3497            "-//IETF//DTD HTML 3.0//EN" => 1,            "-//IETF//DTD HTML 3.0//",
3498            "-//IETF//DTD HTML 3.0//EN//" => 1,            "-//IETF//DTD HTML 3.2 FINAL//",
3499            "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,            "-//IETF//DTD HTML 3.2//",
3500            "-//IETF//DTD HTML 3.2//EN" => 1,            "-//IETF//DTD HTML 3//",
3501            "-//IETF//DTD HTML 3//EN" => 1,            "-//IETF//DTD HTML LEVEL 0//",
3502            "-//IETF//DTD HTML LEVEL 0//EN" => 1,            "-//IETF//DTD HTML LEVEL 1//",
3503            "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,            "-//IETF//DTD HTML LEVEL 2//",
3504            "-//IETF//DTD HTML LEVEL 1//EN" => 1,            "-//IETF//DTD HTML LEVEL 3//",
3505            "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,            "-//IETF//DTD HTML STRICT LEVEL 0//",
3506            "-//IETF//DTD HTML LEVEL 2//EN" => 1,            "-//IETF//DTD HTML STRICT LEVEL 1//",
3507            "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,            "-//IETF//DTD HTML STRICT LEVEL 2//",
3508            "-//IETF//DTD HTML LEVEL 3//EN" => 1,            "-//IETF//DTD HTML STRICT LEVEL 3//",
3509            "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,            "-//IETF//DTD HTML STRICT//",
3510            "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,            "-//IETF//DTD HTML//",
3511            "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,            "-//METRIUS//DTD METRIUS PRESENTATIONAL//",
3512            "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//",
3513            "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//",
3514            "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//",
3515            "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//",
3516            "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//",
3517            "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//",
3518            "-//IETF//DTD HTML STRICT//EN" => 1,            "-//NETSCAPE COMM. CORP.//DTD HTML//",
3519            "-//IETF//DTD HTML STRICT//EN//2.0" => 1,            "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//",
3520            "-//IETF//DTD HTML STRICT//EN//3.0" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//",
3521            "-//IETF//DTD HTML//EN" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//",
3522            "-//IETF//DTD HTML//EN//2.0" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED RELAXED 1.0//",
3523            "-//IETF//DTD HTML//EN//3.0" => 1,            "-//SOFTQUAD SOFTWARE//DTD HOTMETAL PRO 6.0::19990601::EXTENSIONS TO HTML 4.0//",
3524            "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,            "-//SOFTQUAD//DTD HOTMETAL PRO 4.0::19971010::EXTENSIONS TO HTML 4.0//",
3525            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,            "-//SPYGLASS//DTD HTML 2.0 EXTENDED//",
3526            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,            "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//",
3527            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//",
3528            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//",
3529            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,            "-//W3C//DTD HTML 3 1995-03-24//",
3530            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,            "-//W3C//DTD HTML 3.2 DRAFT//",
3531            "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,            "-//W3C//DTD HTML 3.2 FINAL//",
3532            "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,            "-//W3C//DTD HTML 3.2//",
3533            "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,            "-//W3C//DTD HTML 3.2S DRAFT//",
3534            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,            "-//W3C//DTD HTML 4.0 FRAMESET//",
3535            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED RELAXED 1.0//EN" => 1,            "-//W3C//DTD HTML 4.0 TRANSITIONAL//",
3536            "-//SOFTQUAD SOFTWARE//DTD HOTMETAL PRO 6.0::19990601::EXTENSIONS TO HTML 4.0//EN" => 1,            "-//W3C//DTD HTML EXPERIMETNAL 19960712//",
3537            "-//SOFTQUAD//DTD HOTMETAL PRO 4.0::19971010::EXTENSIONS TO HTML 4.0//EN" => 1,            "-//W3C//DTD HTML EXPERIMENTAL 970421//",
3538            "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,            "-//W3C//DTD W3 HTML//",
3539            "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,            "-//W3O//DTD W3 HTML 3.0//",
3540            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,            "-//WEBTECHS//DTD MOZILLA HTML 2.0//",
3541            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,            "-//WEBTECHS//DTD MOZILLA HTML//",
3542            "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,          ]; # $prefix
3543            "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,          my $match;
3544            "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,          for (@$prefix) {
3545            "-//W3C//DTD HTML 3.2//EN" => 1,            if (substr ($prefix, 0, length $_) eq $_) {
3546            "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,              $match = 1;
3547            "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,              last;
3548            "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,            }
3549            "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,          }
3550            "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,          if ($match or
3551            "-//W3C//DTD W3 HTML//EN" => 1,              $pubid eq "-//W3O//DTD W3 HTML STRICT 3.0//EN//" or
3552            "-//W3O//DTD W3 HTML 3.0//EN" => 1,              $pubid eq "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" or
3553            "-//W3O//DTD W3 HTML 3.0//EN//" => 1,              $pubid eq "HTML") {
           "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,  
           "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,  
           "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,  
           "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,  
           "HTML" => 1,  
         }->{$pubid}) {  
3554            !!!cp ('t5');            !!!cp ('t5');
3555            $self->{document}->manakai_compat_mode ('quirks');            $self->{document}->manakai_compat_mode ('quirks');
3556          } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or          } elsif ($pubid =~ m[^-//W3C//DTD HTML 4.01 FRAMESET//] or
3557                   $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {                   $pubid =~ m[^-//W3C//DTD HTML 4.01 TRANSITIONAL//]) {
3558            if (defined $token->{system_identifier}) {            if (defined $token->{system_identifier}) {
3559              !!!cp ('t6');              !!!cp ('t6');
3560              $self->{document}->manakai_compat_mode ('quirks');              $self->{document}->manakai_compat_mode ('quirks');
# Line 3188  sub _tree_construction_initial ($) { Line 3562  sub _tree_construction_initial ($) {
3562              !!!cp ('t7');              !!!cp ('t7');
3563              $self->{document}->manakai_compat_mode ('limited quirks');              $self->{document}->manakai_compat_mode ('limited quirks');
3564            }            }
3565          } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 FRAMESET//EN" or          } elsif ($pubid =~ m[^-//W3C//DTD XHTML 1.0 FRAMESET//] or
3566                   $pubid eq "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN") {                   $pubid =~ m[^-//W3C//DTD XHTML 1.0 TRANSITIONAL//]) {
3567            !!!cp ('t8');            !!!cp ('t8');
3568            $self->{document}->manakai_compat_mode ('limited quirks');            $self->{document}->manakai_compat_mode ('limited quirks');
3569          } else {          } else {
# Line 3202  sub _tree_construction_initial ($) { Line 3576  sub _tree_construction_initial ($) {
3576          my $sysid = $token->{system_identifier};          my $sysid = $token->{system_identifier};
3577          $sysid =~ tr/A-Z/a-z/;          $sysid =~ tr/A-Z/a-z/;
3578          if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {          if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
3579            ## TODO: Check the spec: PUBLIC "(limited quirks)" "(quirks)"            ## NOTE: Ensure that |PUBLIC "(limited quirks)" "(quirks)"| is
3580              ## marked as quirks.
3581            $self->{document}->manakai_compat_mode ('quirks');            $self->{document}->manakai_compat_mode ('quirks');
3582            !!!cp ('t11');            !!!cp ('t11');
3583          } else {          } else {
# Line 3374  sub _reset_insertion_mode ($) { Line 3749  sub _reset_insertion_mode ($) {
3749        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
3750          $last = 1;          $last = 1;
3751          if (defined $self->{inner_html_node}) {          if (defined $self->{inner_html_node}) {
3752            if ($self->{inner_html_node}->[1] & TABLE_CELL_EL) {            !!!cp ('t28');
3753              !!!cp ('t27');            $node = $self->{inner_html_node};
3754              #          } else {
3755            } else {            die "_reset_insertion_mode: t27";
             !!!cp ('t28');  
             $node = $self->{inner_html_node};  
           }  
3756          }          }
3757        }        }
3758              
3759      ## Step 4..14        ## Step 4..14
3760      my $new_mode;        my $new_mode;
3761      if ($node->[1] & FOREIGN_EL) {        if ($node->[1] & FOREIGN_EL) {
3762        ## NOTE: Strictly spaking, the line below only applies to MathML and          !!!cp ('t28.1');
3763        ## SVG elements.  Currently the HTML syntax supports only MathML and          ## NOTE: Strictly spaking, the line below only applies to MathML and
3764        ## SVG elements as foreigners.          ## SVG elements.  Currently the HTML syntax supports only MathML and
3765        $new_mode = $self->{insertion_mode} | IN_FOREIGN_CONTENT_IM;          ## SVG elements as foreigners.
3766        ## ISSUE: What is set as the secondary insertion mode?          $new_mode = IN_BODY_IM | IN_FOREIGN_CONTENT_IM;
3767      } else {        } elsif ($node->[1] & TABLE_CELL_EL) {
3768        $new_mode = {          if ($last) {
3769              !!!cp ('t28.2');
3770              #
3771            } else {
3772              !!!cp ('t28.3');
3773              $new_mode = IN_CELL_IM;
3774            }
3775          } else {
3776            !!!cp ('t28.4');
3777            $new_mode = {
3778                        select => IN_SELECT_IM,                        select => IN_SELECT_IM,
3779                        ## NOTE: |option| and |optgroup| do not set                        ## NOTE: |option| and |optgroup| do not set
3780                        ## insertion mode to "in select" by themselves.                        ## insertion mode to "in select" by themselves.
                       td => IN_CELL_IM,  
                       th => IN_CELL_IM,  
3781                        tr => IN_ROW_IM,                        tr => IN_ROW_IM,
3782                        tbody => IN_TABLE_BODY_IM,                        tbody => IN_TABLE_BODY_IM,
3783                        thead => IN_TABLE_BODY_IM,                        thead => IN_TABLE_BODY_IM,
# Line 3410  sub _reset_insertion_mode ($) { Line 3789  sub _reset_insertion_mode ($) {
3789                        body => IN_BODY_IM,                        body => IN_BODY_IM,
3790                        frameset => IN_FRAMESET_IM,                        frameset => IN_FRAMESET_IM,
3791                       }->{$node->[0]->manakai_local_name};                       }->{$node->[0]->manakai_local_name};
3792      }        }
3793      $self->{insertion_mode} = $new_mode and return if defined $new_mode;        $self->{insertion_mode} = $new_mode and return if defined $new_mode;
3794                
3795        ## Step 15        ## Step 15
3796        if ($node->[1] & HTML_EL) {        if ($node->[1] & HTML_EL) {
# Line 3585  sub _tree_construction_main ($) { Line 3964  sub _tree_construction_main ($) {
3964        ## NOTE: An end-of-file token.        ## NOTE: An end-of-file token.
3965        if ($content_model_flag == CDATA_CONTENT_MODEL) {        if ($content_model_flag == CDATA_CONTENT_MODEL) {
3966          !!!cp ('t43');          !!!cp ('t43');
3967          !!!parse-error (type => 'in CDATA:#'.$token->{type}, token => $token);          !!!parse-error (type => 'in CDATA:#eof', token => $token);
3968        } elsif ($content_model_flag == RCDATA_CONTENT_MODEL) {        } elsif ($content_model_flag == RCDATA_CONTENT_MODEL) {
3969          !!!cp ('t44');          !!!cp ('t44');
3970          !!!parse-error (type => 'in RCDATA:#'.$token->{type}, token => $token);          !!!parse-error (type => 'in RCDATA:#eof', token => $token);
3971        } else {        } else {
3972          die "$0: $content_model_flag in parse_rcdata";          die "$0: $content_model_flag in parse_rcdata";
3973        }        }
# Line 3625  sub _tree_construction_main ($) { Line 4004  sub _tree_construction_main ($) {
4004        ## Ignore the token        ## Ignore the token
4005      } else {      } else {
4006        !!!cp ('t48');        !!!cp ('t48');
4007        !!!parse-error (type => 'in CDATA:#'.$token->{type}, token => $token);        !!!parse-error (type => 'in CDATA:#eof', token => $token);
4008        ## ISSUE: And ignore?        ## ISSUE: And ignore?
4009        ## TODO: mark as "already executed"        ## TODO: mark as "already executed"
4010      }      }
# Line 3676  sub _tree_construction_main ($) { Line 4055  sub _tree_construction_main ($) {
4055        } # AFE        } # AFE
4056        unless (defined $formatting_element) {        unless (defined $formatting_element) {
4057          !!!cp ('t53');          !!!cp ('t53');
4058          !!!parse-error (type => 'unmatched end tag:'.$tag_name, token => $end_tag_token);          !!!parse-error (type => 'unmatched end tag', text => $tag_name, token => $end_tag_token);
4059          ## Ignore the token          ## Ignore the token
4060          !!!next-token;          !!!next-token;
4061          return;          return;
# Line 3693  sub _tree_construction_main ($) { Line 4072  sub _tree_construction_main ($) {
4072              last INSCOPE;              last INSCOPE;
4073            } else { # in open elements but not in scope            } else { # in open elements but not in scope
4074              !!!cp ('t55');              !!!cp ('t55');
4075              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name},              !!!parse-error (type => 'unmatched end tag',
4076                                text => $token->{tag_name},
4077                              token => $end_tag_token);                              token => $end_tag_token);
4078              ## Ignore the token              ## Ignore the token
4079              !!!next-token;              !!!next-token;
# Line 3706  sub _tree_construction_main ($) { Line 4086  sub _tree_construction_main ($) {
4086        } # INSCOPE        } # INSCOPE
4087        unless (defined $formatting_element_i_in_open) {        unless (defined $formatting_element_i_in_open) {
4088          !!!cp ('t57');          !!!cp ('t57');
4089          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name},          !!!parse-error (type => 'unmatched end tag',
4090                            text => $token->{tag_name},
4091                          token => $end_tag_token);                          token => $end_tag_token);
4092          pop @$active_formatting_elements; # $formatting_element          pop @$active_formatting_elements; # $formatting_element
4093          !!!next-token; ## TODO: ok?          !!!next-token; ## TODO: ok?
# Line 3715  sub _tree_construction_main ($) { Line 4096  sub _tree_construction_main ($) {
4096        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
4097          !!!cp ('t58');          !!!cp ('t58');
4098          !!!parse-error (type => 'not closed',          !!!parse-error (type => 'not closed',
4099                          value => $self->{open_elements}->[-1]->[0]                          text => $self->{open_elements}->[-1]->[0]
4100                              ->manakai_local_name,                              ->manakai_local_name,
4101                          token => $end_tag_token);                          token => $end_tag_token);
4102        }        }
# Line 3924  sub _tree_construction_main ($) { Line 4305  sub _tree_construction_main ($) {
4305    B: while (1) {    B: while (1) {
4306      if ($token->{type} == DOCTYPE_TOKEN) {      if ($token->{type} == DOCTYPE_TOKEN) {
4307        !!!cp ('t73');        !!!cp ('t73');
4308        !!!parse-error (type => 'DOCTYPE in the middle', token => $token);        !!!parse-error (type => 'in html:#DOCTYPE', token => $token);
4309        ## Ignore the token        ## Ignore the token
4310        ## Stay in the phase        ## Stay in the phase
4311        !!!next-token;        !!!next-token;
# Line 3933  sub _tree_construction_main ($) { Line 4314  sub _tree_construction_main ($) {
4314               $token->{tag_name} eq 'html') {               $token->{tag_name} eq 'html') {
4315        if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {        if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
4316          !!!cp ('t79');          !!!cp ('t79');
4317          !!!parse-error (type => 'after html:html', token => $token);          !!!parse-error (type => 'after html', text => 'html', token => $token);
4318          $self->{insertion_mode} = AFTER_BODY_IM;          $self->{insertion_mode} = AFTER_BODY_IM;
4319        } elsif ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {        } elsif ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {
4320          !!!cp ('t80');          !!!cp ('t80');
4321          !!!parse-error (type => 'after html:html', token => $token);          !!!parse-error (type => 'after html', text => 'html', token => $token);
4322          $self->{insertion_mode} = AFTER_FRAMESET_IM;          $self->{insertion_mode} = AFTER_FRAMESET_IM;
4323        } else {        } else {
4324          !!!cp ('t81');          !!!cp ('t81');
# Line 3988  sub _tree_construction_main ($) { Line 4369  sub _tree_construction_main ($) {
4369            #            #
4370          } elsif ({          } elsif ({
4371                    b => 1, big => 1, blockquote => 1, body => 1, br => 1,                    b => 1, big => 1, blockquote => 1, body => 1, br => 1,
4372                    center => 1, code => 1, dd => 1, div => 1, dl => 1, em => 1,                    center => 1, code => 1, dd => 1, div => 1, dl => 1, dt => 1,
4373                    embed => 1, font => 1, h1 => 1, h2 => 1, h3 => 1, ## No h4!                    em => 1, embed => 1, font => 1, h1 => 1, h2 => 1, h3 => 1,
4374                    h5 => 1, h6 => 1, head => 1, hr => 1, i => 1, img => 1,                    h4 => 1, h5 => 1, h6 => 1, head => 1, hr => 1, i => 1,
4375                    li => 1, menu => 1, meta => 1, nobr => 1, p => 1, pre => 1,                    img => 1, li => 1, listing => 1, menu => 1, meta => 1,
4376                    ruby => 1, s => 1, small => 1, span => 1, strong => 1,                    nobr => 1, ol => 1, p => 1, pre => 1, ruby => 1, s => 1,
4377                    sub => 1, sup => 1, table => 1, tt => 1, u => 1, ul => 1,                    small => 1, span => 1, strong => 1, strike => 1, sub => 1,
4378                    var => 1,                    sup => 1, table => 1, tt => 1, u => 1, ul => 1, var => 1,
4379                   }->{$token->{tag_name}}) {                   }->{$token->{tag_name}}) {
4380            !!!cp ('t87.2');            !!!cp ('t87.2');
4381            !!!parse-error (type => 'not closed',            !!!parse-error (type => 'not closed',
4382                            value => $self->{open_elements}->[-1]->[0]                            text => $self->{open_elements}->[-1]->[0]
4383                                ->manakai_local_name,                                ->manakai_local_name,
4384                            token => $token);                            token => $token);
4385    
# Line 4074  sub _tree_construction_main ($) { Line 4455  sub _tree_construction_main ($) {
4455          !!!cp ('t87.5');          !!!cp ('t87.5');
4456          #          #
4457        } elsif ($token->{type} == END_OF_FILE_TOKEN) {        } elsif ($token->{type} == END_OF_FILE_TOKEN) {
         ## NOTE: "using the rules for secondary insertion mode" then "continue"  
4458          !!!cp ('t87.6');          !!!cp ('t87.6');
4459          #          !!!parse-error (type => 'not closed',
4460          ## TODO: ...                          text => $self->{open_elements}->[-1]->[0]
4461                                ->manakai_local_name,
4462                            token => $token);
4463    
4464            pop @{$self->{open_elements}}
4465                while $self->{open_elements}->[-1]->[1] & FOREIGN_EL;
4466    
4467            $self->{insertion_mode} &= ~ IN_FOREIGN_CONTENT_IM;
4468            ## Reprocess.
4469            next B;
4470        } else {        } else {
4471          die "$0: $token->{type}: Unknown token type";                  die "$0: $token->{type}: Unknown token type";        
4472        }        }
# Line 4089  sub _tree_construction_main ($) { Line 4478  sub _tree_construction_main ($) {
4478            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {            unless ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4479              !!!cp ('t88.2');              !!!cp ('t88.2');
4480              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);              $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4481                #
4482            } else {            } else {
4483              !!!cp ('t88.1');              !!!cp ('t88.1');
4484              ## Ignore the token.              ## Ignore the token.
4485              !!!next-token;              #
             next B;  
4486            }            }
4487            unless (length $token->{data}) {            unless (length $token->{data}) {
4488              !!!cp ('t88');              !!!cp ('t88');
4489              !!!next-token;              !!!next-token;
4490              next B;              next B;
4491            }            }
4492    ## TODO: set $token->{column} appropriately
4493          }          }
4494    
4495          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {          if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
# Line 4118  sub _tree_construction_main ($) { Line 4508  sub _tree_construction_main ($) {
4508            !!!cp ('t90');            !!!cp ('t90');
4509            ## As if </noscript>            ## As if </noscript>
4510            pop @{$self->{open_elements}};            pop @{$self->{open_elements}};
4511            !!!parse-error (type => 'in noscript:#character', token => $token);            !!!parse-error (type => 'in noscript:#text', token => $token);
4512                        
4513            ## Reprocess in the "in head" insertion mode...            ## Reprocess in the "in head" insertion mode...
4514            ## As if </head>            ## As if </head>
# Line 4155  sub _tree_construction_main ($) { Line 4545  sub _tree_construction_main ($) {
4545              next B;              next B;
4546            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4547              !!!cp ('t93.2');              !!!cp ('t93.2');
4548              !!!parse-error (type => 'after head:head', token => $token); ## TODO: error type              !!!parse-error (type => 'after head', text => 'head',
4549                                token => $token);
4550              ## Ignore the token              ## Ignore the token
4551              !!!nack ('t93.3');              !!!nack ('t93.3');
4552              !!!next-token;              !!!next-token;
4553              next B;              next B;
4554            } else {            } else {
4555              !!!cp ('t95');              !!!cp ('t95');
4556              !!!parse-error (type => 'in head:head', token => $token); # or in head noscript              !!!parse-error (type => 'in head:head',
4557                                token => $token); # or in head noscript
4558              ## Ignore the token              ## Ignore the token
4559              !!!nack ('t95.1');              !!!nack ('t95.1');
4560              !!!next-token;              !!!next-token;
# Line 4187  sub _tree_construction_main ($) { Line 4579  sub _tree_construction_main ($) {
4579                  !!!cp ('t98');                  !!!cp ('t98');
4580                  ## As if </noscript>                  ## As if </noscript>
4581                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4582                  !!!parse-error (type => 'in noscript:base', token => $token);                  !!!parse-error (type => 'in noscript', text => 'base',
4583                                    token => $token);
4584                                
4585                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4586                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
# Line 4198  sub _tree_construction_main ($) { Line 4591  sub _tree_construction_main ($) {
4591                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4592                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4593                  !!!cp ('t100');                  !!!cp ('t100');
4594                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4595                                    text => $token->{tag_name}, token => $token);
4596                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4597                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4598                } else {                } else {
# Line 4215  sub _tree_construction_main ($) { Line 4609  sub _tree_construction_main ($) {
4609                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4610                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4611                  !!!cp ('t102');                  !!!cp ('t102');
4612                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4613                                    text => $token->{tag_name}, token => $token);
4614                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4615                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4616                } else {                } else {
# Line 4232  sub _tree_construction_main ($) { Line 4627  sub _tree_construction_main ($) {
4627                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4628                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4629                  !!!cp ('t104');                  !!!cp ('t104');
4630                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4631                                    text => $token->{tag_name}, token => $token);
4632                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4633                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4634                } else {                } else {
# Line 4256  sub _tree_construction_main ($) { Line 4652  sub _tree_construction_main ($) {
4652                                                 ->{has_reference});                                                 ->{has_reference});
4653                  } elsif ($token->{attributes}->{content}) {                  } elsif ($token->{attributes}->{content}) {
4654                    if ($token->{attributes}->{content}->{value}                    if ($token->{attributes}->{content}->{value}
4655                        =~ /\A[^;]*;[\x09-\x0D\x20]*[Cc][Hh][Aa][Rr][Ss][Ee][Tt]                        =~ /[Cc][Hh][Aa][Rr][Ss][Ee][Tt]
4656                            [\x09-\x0D\x20]*=                            [\x09-\x0D\x20]*=
4657                            [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|                            [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
4658                            ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {                            ([^"'\x09-\x0D\x20][^\x09-\x0D\x20\x3B]*))/x) {
4659                      !!!cp ('t107');                      !!!cp ('t107');
4660                      ## NOTE: Whether the encoding is supported or not is handled                      ## NOTE: Whether the encoding is supported or not is handled
4661                      ## in the {change_encoding} callback.                      ## in the {change_encoding} callback.
# Line 4301  sub _tree_construction_main ($) { Line 4697  sub _tree_construction_main ($) {
4697                  !!!cp ('t111');                  !!!cp ('t111');
4698                  ## As if </noscript>                  ## As if </noscript>
4699                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4700                  !!!parse-error (type => 'in noscript:title', token => $token);                  !!!parse-error (type => 'in noscript', text => 'title',
4701                                    token => $token);
4702                                
4703                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4704                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4705                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4706                  !!!cp ('t112');                  !!!cp ('t112');
4707                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4708                                    text => $token->{tag_name}, token => $token);
4709                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4710                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4711                } else {                } else {
# Line 4321  sub _tree_construction_main ($) { Line 4719  sub _tree_construction_main ($) {
4719                pop @{$self->{open_elements}} # <head>                pop @{$self->{open_elements}} # <head>
4720                    if $self->{insertion_mode} == AFTER_HEAD_IM;                    if $self->{insertion_mode} == AFTER_HEAD_IM;
4721                next B;                next B;
4722              } elsif ($token->{tag_name} eq 'style') {              } elsif ($token->{tag_name} eq 'style' or
4723                         $token->{tag_name} eq 'noframes') {
4724                ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and                ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
4725                ## insertion mode IN_HEAD_IM)                ## insertion mode IN_HEAD_IM)
4726                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4727                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4728                  !!!cp ('t114');                  !!!cp ('t114');
4729                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4730                                    text => $token->{tag_name}, token => $token);
4731                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4732                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4733                } else {                } else {
# Line 4348  sub _tree_construction_main ($) { Line 4748  sub _tree_construction_main ($) {
4748                  next B;                  next B;
4749                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4750                  !!!cp ('t117');                  !!!cp ('t117');
4751                  !!!parse-error (type => 'in noscript:noscript', token => $token);                  !!!parse-error (type => 'in noscript', text => 'noscript',
4752                                    token => $token);
4753                  ## Ignore the token                  ## Ignore the token
4754                  !!!nack ('t117.1');                  !!!nack ('t117.1');
4755                  !!!next-token;                  !!!next-token;
# Line 4362  sub _tree_construction_main ($) { Line 4763  sub _tree_construction_main ($) {
4763                  !!!cp ('t119');                  !!!cp ('t119');
4764                  ## As if </noscript>                  ## As if </noscript>
4765                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4766                  !!!parse-error (type => 'in noscript:script', token => $token);                  !!!parse-error (type => 'in noscript', text => 'script',
4767                                    token => $token);
4768                                
4769                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4770                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4771                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4772                  !!!cp ('t120');                  !!!cp ('t120');
4773                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4774                                    text => $token->{tag_name}, token => $token);
4775                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4776                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4777                } else {                } else {
# Line 4386  sub _tree_construction_main ($) { Line 4789  sub _tree_construction_main ($) {
4789                  !!!cp ('t122');                  !!!cp ('t122');
4790                  ## As if </noscript>                  ## As if </noscript>
4791                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4792                  !!!parse-error (type => 'in noscript:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'in noscript',
4793                                    text => $token->{tag_name}, token => $token);
4794                                    
4795                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4796                  ## As if </head>                  ## As if </head>
# Line 4425  sub _tree_construction_main ($) { Line 4829  sub _tree_construction_main ($) {
4829                !!!cp ('t129');                !!!cp ('t129');
4830                ## As if </noscript>                ## As if </noscript>
4831                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
4832                !!!parse-error (type => 'in noscript:/'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'in noscript:/',
4833                                  text => $token->{tag_name}, token => $token);
4834                                
4835                ## Reprocess in the "in head" insertion mode...                ## Reprocess in the "in head" insertion mode...
4836                ## As if </head>                ## As if </head>
# Line 4468  sub _tree_construction_main ($) { Line 4873  sub _tree_construction_main ($) {
4873                  !!!cp ('t133');                  !!!cp ('t133');
4874                  ## As if </noscript>                  ## As if </noscript>
4875                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4876                  !!!parse-error (type => 'in noscript:/head', token => $token);                  !!!parse-error (type => 'in noscript:/',
4877                                    text => 'head', token => $token);
4878                                    
4879                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4880                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
# Line 4483  sub _tree_construction_main ($) { Line 4889  sub _tree_construction_main ($) {
4889                  next B;                  next B;
4890                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4891                  !!!cp ('t134.1');                  !!!cp ('t134.1');
4892                  !!!parse-error (type => 'unmatched end tag:head', token => $token);                  !!!parse-error (type => 'unmatched end tag', text => 'head',
4893                                    token => $token);
4894                  ## Ignore the token                  ## Ignore the token
4895                  !!!next-token;                  !!!next-token;
4896                  next B;                  next B;
# Line 4500  sub _tree_construction_main ($) { Line 4907  sub _tree_construction_main ($) {
4907                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM or                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM or
4908                         $self->{insertion_mode} == AFTER_HEAD_IM) {                         $self->{insertion_mode} == AFTER_HEAD_IM) {
4909                  !!!cp ('t137');                  !!!cp ('t137');
4910                  !!!parse-error (type => 'unmatched end tag:noscript', token => $token);                  !!!parse-error (type => 'unmatched end tag',
4911                                    text => 'noscript', token => $token);
4912                  ## Ignore the token ## ISSUE: An issue in the spec.                  ## Ignore the token ## ISSUE: An issue in the spec.
4913                  !!!next-token;                  !!!next-token;
4914                  next B;                  next B;
# Line 4515  sub _tree_construction_main ($) { Line 4923  sub _tree_construction_main ($) {
4923                    $self->{insertion_mode} == IN_HEAD_IM or                    $self->{insertion_mode} == IN_HEAD_IM or
4924                    $self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                    $self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4925                  !!!cp ('t140');                  !!!cp ('t140');
4926                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
4927                                    text => $token->{tag_name}, token => $token);
4928                  ## Ignore the token                  ## Ignore the token
4929                  !!!next-token;                  !!!next-token;
4930                  next B;                  next B;
4931                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4932                  !!!cp ('t140.1');                  !!!cp ('t140.1');
4933                  !!!parse-error (type => 'unmatched end tag:' . $token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
4934                                    text => $token->{tag_name}, token => $token);
4935                  ## Ignore the token                  ## Ignore the token
4936                  !!!next-token;                  !!!next-token;
4937                  next B;                  next B;
# Line 4530  sub _tree_construction_main ($) { Line 4940  sub _tree_construction_main ($) {
4940                }                }
4941              } elsif ($token->{tag_name} eq 'p') {              } elsif ($token->{tag_name} eq 'p') {
4942                !!!cp ('t142');                !!!cp ('t142');
4943                !!!parse-error (type => 'unmatched end tag:p', token => $token);                !!!parse-error (type => 'unmatched end tag',
4944                                  text => $token->{tag_name}, token => $token);
4945                ## Ignore the token                ## Ignore the token
4946                !!!next-token;                !!!next-token;
4947                next B;                next B;
# Line 4553  sub _tree_construction_main ($) { Line 4964  sub _tree_construction_main ($) {
4964                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4965                  !!!cp ('t143.3');                  !!!cp ('t143.3');
4966                  ## ISSUE: Two parse errors for <head><noscript></br>                  ## ISSUE: Two parse errors for <head><noscript></br>
4967                  !!!parse-error (type => 'unmatched end tag:br', token => $token);                  !!!parse-error (type => 'unmatched end tag',
4968                                    text => 'br', token => $token);
4969                  ## As if </noscript>                  ## As if </noscript>
4970                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4971                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
# Line 4572  sub _tree_construction_main ($) { Line 4984  sub _tree_construction_main ($) {
4984                }                }
4985    
4986                ## ISSUE: does not agree with IE7 - it doesn't ignore </br>.                ## ISSUE: does not agree with IE7 - it doesn't ignore </br>.
4987                !!!parse-error (type => 'unmatched end tag:br', token => $token);                !!!parse-error (type => 'unmatched end tag',
4988                                  text => 'br', token => $token);
4989                ## Ignore the token                ## Ignore the token
4990                !!!next-token;                !!!next-token;
4991                next B;                next B;
4992              } else {              } else {
4993                !!!cp ('t145');                !!!cp ('t145');
4994                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
4995                                  text => $token->{tag_name}, token => $token);
4996                ## Ignore the token                ## Ignore the token
4997                !!!next-token;                !!!next-token;
4998                next B;                next B;
# Line 4588  sub _tree_construction_main ($) { Line 5002  sub _tree_construction_main ($) {
5002                !!!cp ('t146');                !!!cp ('t146');
5003                ## As if </noscript>                ## As if </noscript>
5004                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
5005                !!!parse-error (type => 'in noscript:/'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'in noscript:/',
5006                                  text => $token->{tag_name}, token => $token);
5007                                
5008                ## Reprocess in the "in head" insertion mode...                ## Reprocess in the "in head" insertion mode...
5009                ## As if </head>                ## As if </head>
# Line 4604  sub _tree_construction_main ($) { Line 5019  sub _tree_construction_main ($) {
5019              } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {              } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {
5020  ## ISSUE: This case cannot be reached?  ## ISSUE: This case cannot be reached?
5021                !!!cp ('t148');                !!!cp ('t148');
5022                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
5023                                  text => $token->{tag_name}, token => $token);
5024                ## Ignore the token ## ISSUE: An issue in the spec.                ## Ignore the token ## ISSUE: An issue in the spec.
5025                !!!next-token;                !!!next-token;
5026                next B;                next B;
# Line 4715  sub _tree_construction_main ($) { Line 5131  sub _tree_construction_main ($) {
5131    
5132                  !!!cp ('t153');                  !!!cp ('t153');
5133                  !!!parse-error (type => 'start tag not allowed',                  !!!parse-error (type => 'start tag not allowed',
5134                      value => $token->{tag_name}, token => $token);                      text => $token->{tag_name}, token => $token);
5135                  ## Ignore the token                  ## Ignore the token
5136                  !!!nack ('t153.1');                  !!!nack ('t153.1');
5137                  !!!next-token;                  !!!next-token;
5138                  next B;                  next B;
5139                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {
5140                  !!!parse-error (type => 'not closed:caption', token => $token);                  !!!parse-error (type => 'not closed', text => 'caption',
5141                                    token => $token);
5142                                    
5143                  ## NOTE: As if </caption>.                  ## NOTE: As if </caption>.
5144                  ## have a table element in table scope                  ## have a table element in table scope
# Line 4741  sub _tree_construction_main ($) { Line 5158  sub _tree_construction_main ($) {
5158    
5159                    !!!cp ('t157');                    !!!cp ('t157');
5160                    !!!parse-error (type => 'start tag not allowed',                    !!!parse-error (type => 'start tag not allowed',
5161                                    value => $token->{tag_name}, token => $token);                                    text => $token->{tag_name}, token => $token);
5162                    ## Ignore the token                    ## Ignore the token
5163                    !!!nack ('t157.1');                    !!!nack ('t157.1');
5164                    !!!next-token;                    !!!next-token;
# Line 4758  sub _tree_construction_main ($) { Line 5175  sub _tree_construction_main ($) {
5175                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5176                    !!!cp ('t159');                    !!!cp ('t159');
5177                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5178                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5179                                        ->manakai_local_name,                                        ->manakai_local_name,
5180                                    token => $token);                                    token => $token);
5181                  } else {                  } else {
# Line 4800  sub _tree_construction_main ($) { Line 5217  sub _tree_construction_main ($) {
5217                  } # INSCOPE                  } # INSCOPE
5218                    unless (defined $i) {                    unless (defined $i) {
5219                      !!!cp ('t165');                      !!!cp ('t165');
5220                      !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                      !!!parse-error (type => 'unmatched end tag',
5221                                        text => $token->{tag_name},
5222                                        token => $token);
5223                      ## Ignore the token                      ## Ignore the token
5224                      !!!next-token;                      !!!next-token;
5225                      next B;                      next B;
# Line 4817  sub _tree_construction_main ($) { Line 5236  sub _tree_construction_main ($) {
5236                          ne $token->{tag_name}) {                          ne $token->{tag_name}) {
5237                    !!!cp ('t167');                    !!!cp ('t167');
5238                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5239                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5240                                        ->manakai_local_name,                                        ->manakai_local_name,
5241                                    token => $token);                                    token => $token);
5242                  } else {                  } else {
# Line 4834  sub _tree_construction_main ($) { Line 5253  sub _tree_construction_main ($) {
5253                  next B;                  next B;
5254                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {
5255                  !!!cp ('t169');                  !!!cp ('t169');
5256                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5257                                    text => $token->{tag_name}, token => $token);
5258                  ## Ignore the token                  ## Ignore the token
5259                  !!!next-token;                  !!!next-token;
5260                  next B;                  next B;
# Line 4861  sub _tree_construction_main ($) { Line 5281  sub _tree_construction_main ($) {
5281    
5282                    !!!cp ('t173');                    !!!cp ('t173');
5283                    !!!parse-error (type => 'unmatched end tag',                    !!!parse-error (type => 'unmatched end tag',
5284                                    value => $token->{tag_name}, token => $token);                                    text => $token->{tag_name}, token => $token);
5285                    ## Ignore the token                    ## Ignore the token
5286                    !!!next-token;                    !!!next-token;
5287                    next B;                    next B;
# Line 4877  sub _tree_construction_main ($) { Line 5297  sub _tree_construction_main ($) {
5297                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5298                    !!!cp ('t175');                    !!!cp ('t175');
5299                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5300                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5301                                        ->manakai_local_name,                                        ->manakai_local_name,
5302                                    token => $token);                                    token => $token);
5303                  } else {                  } else {
# Line 4894  sub _tree_construction_main ($) { Line 5314  sub _tree_construction_main ($) {
5314                  next B;                  next B;
5315                } elsif ($self->{insertion_mode} == IN_CELL_IM) {                } elsif ($self->{insertion_mode} == IN_CELL_IM) {
5316                  !!!cp ('t177');                  !!!cp ('t177');
5317                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5318                                    text => $token->{tag_name}, token => $token);
5319                  ## Ignore the token                  ## Ignore the token
5320                  !!!next-token;                  !!!next-token;
5321                  next B;                  next B;
# Line 4937  sub _tree_construction_main ($) { Line 5358  sub _tree_construction_main ($) {
5358    
5359                  !!!cp ('t182');                  !!!cp ('t182');
5360                  !!!parse-error (type => 'unmatched end tag',                  !!!parse-error (type => 'unmatched end tag',
5361                      value => $token->{tag_name}, token => $token);                      text => $token->{tag_name}, token => $token);
5362                  ## Ignore the token                  ## Ignore the token
5363                  !!!next-token;                  !!!next-token;
5364                  next B;                  next B;
5365                } # INSCOPE                } # INSCOPE
5366              } elsif ($token->{tag_name} eq 'table' and              } elsif ($token->{tag_name} eq 'table' and
5367                       $self->{insertion_mode} == IN_CAPTION_IM) {                       $self->{insertion_mode} == IN_CAPTION_IM) {
5368                !!!parse-error (type => 'not closed:caption', token => $token);                !!!parse-error (type => 'not closed', text => 'caption',
5369                                  token => $token);
5370    
5371                ## As if </caption>                ## As if </caption>
5372                ## have a table element in table scope                ## have a table element in table scope
# Line 4962  sub _tree_construction_main ($) { Line 5384  sub _tree_construction_main ($) {
5384                } # INSCOPE                } # INSCOPE
5385                unless (defined $i) {                unless (defined $i) {
5386                  !!!cp ('t186');                  !!!cp ('t186');
5387                  !!!parse-error (type => 'unmatched end tag:caption', token => $token);                  !!!parse-error (type => 'unmatched end tag',
5388                                    text => 'caption', token => $token);
5389                  ## Ignore the token                  ## Ignore the token
5390                  !!!next-token;                  !!!next-token;
5391                  next B;                  next B;
# Line 4977  sub _tree_construction_main ($) { Line 5400  sub _tree_construction_main ($) {
5400                unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5401                  !!!cp ('t188');                  !!!cp ('t188');
5402                  !!!parse-error (type => 'not closed',                  !!!parse-error (type => 'not closed',
5403                                  value => $self->{open_elements}->[-1]->[0]                                  text => $self->{open_elements}->[-1]->[0]
5404                                      ->manakai_local_name,                                      ->manakai_local_name,
5405                                  token => $token);                                  token => $token);
5406                } else {                } else {
# Line 4997  sub _tree_construction_main ($) { Line 5420  sub _tree_construction_main ($) {
5420                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
5421                if ($self->{insertion_mode} & BODY_TABLE_IMS) {                if ($self->{insertion_mode} & BODY_TABLE_IMS) {
5422                  !!!cp ('t190');                  !!!cp ('t190');
5423                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5424                                    text => $token->{tag_name}, token => $token);
5425                  ## Ignore the token                  ## Ignore the token
5426                  !!!next-token;                  !!!next-token;
5427                  next B;                  next B;
# Line 5011  sub _tree_construction_main ($) { Line 5435  sub _tree_construction_main ($) {
5435                       }->{$token->{tag_name}} and                       }->{$token->{tag_name}} and
5436                       $self->{insertion_mode} == IN_CAPTION_IM) {                       $self->{insertion_mode} == IN_CAPTION_IM) {
5437                !!!cp ('t192');                !!!cp ('t192');
5438                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
5439                                  text => $token->{tag_name}, token => $token);
5440                ## Ignore the token                ## Ignore the token
5441                !!!next-token;                !!!next-token;
5442                next B;                next B;
# Line 5051  sub _tree_construction_main ($) { Line 5476  sub _tree_construction_main ($) {
5476            }            }
5477          }          }
5478    
5479              !!!parse-error (type => 'in table:#character', token => $token);          !!!parse-error (type => 'in table:#text', token => $token);
5480    
5481              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
5482              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
# Line 5102  sub _tree_construction_main ($) { Line 5527  sub _tree_construction_main ($) {
5527          !!!next-token;          !!!next-token;
5528          next B;          next B;
5529        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
5530              if ({          if ({
5531                   tr => ($self->{insertion_mode} != IN_ROW_IM),               tr => ($self->{insertion_mode} != IN_ROW_IM),
5532                   th => 1, td => 1,               th => 1, td => 1,
5533                  }->{$token->{tag_name}}) {              }->{$token->{tag_name}}) {
5534                if ($self->{insertion_mode} == IN_TABLE_IM) {            if ($self->{insertion_mode} == IN_TABLE_IM) {
5535                  ## Clear back to table context              ## Clear back to table context
5536                  while (not ($self->{open_elements}->[-1]->[1]              while (not ($self->{open_elements}->[-1]->[1]
5537                                  & TABLE_SCOPING_EL)) {                              & TABLE_SCOPING_EL)) {
5538                    !!!cp ('t201');                !!!cp ('t201');
5539                    pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
5540                  }              }
5541                                
5542                  !!!insert-element ('tbody',, $token);              !!!insert-element ('tbody',, $token);
5543                  $self->{insertion_mode} = IN_TABLE_BODY_IM;              $self->{insertion_mode} = IN_TABLE_BODY_IM;
5544                  ## reprocess in the "in table body" insertion mode...              ## reprocess in the "in table body" insertion mode...
5545                }            }
5546              
5547                if ($self->{insertion_mode} == IN_TABLE_BODY_IM) {            if ($self->{insertion_mode} == IN_TABLE_BODY_IM) {
5548                  unless ($token->{tag_name} eq 'tr') {              unless ($token->{tag_name} eq 'tr') {
5549                    !!!cp ('t202');                !!!cp ('t202');
5550                    !!!parse-error (type => 'missing start tag:tr', token => $token);                !!!parse-error (type => 'missing start tag:tr', token => $token);
5551                  }              }
5552                                    
5553                  ## Clear back to table body context              ## Clear back to table body context
5554                  while (not ($self->{open_elements}->[-1]->[1]              while (not ($self->{open_elements}->[-1]->[1]
5555                                  & TABLE_ROWS_SCOPING_EL)) {                              & TABLE_ROWS_SCOPING_EL)) {
5556                    !!!cp ('t203');                !!!cp ('t203');
5557                    ## ISSUE: Can this case be reached?                ## ISSUE: Can this case be reached?
5558                    pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
5559                  }              }
5560                                    
5561                  $self->{insertion_mode} = IN_ROW_IM;                  $self->{insertion_mode} = IN_ROW_IM;
5562                  if ($token->{tag_name} eq 'tr') {                  if ($token->{tag_name} eq 'tr') {
# Line 5187  sub _tree_construction_main ($) { Line 5612  sub _tree_construction_main ($) {
5612                  unless (defined $i) {                  unless (defined $i) {
5613                    !!!cp ('t210');                    !!!cp ('t210');
5614  ## TODO: This type is wrong.  ## TODO: This type is wrong.
5615                    !!!parse-error (type => 'unmacthed end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmacthed end tag',
5616                                      text => $token->{tag_name}, token => $token);
5617                    ## Ignore the token                    ## Ignore the token
5618                    !!!nack ('t210.1');                    !!!nack ('t210.1');
5619                    !!!next-token;                    !!!next-token;
# Line 5231  sub _tree_construction_main ($) { Line 5657  sub _tree_construction_main ($) {
5657                  } # INSCOPE                  } # INSCOPE
5658                  unless (defined $i) {                  unless (defined $i) {
5659                    !!!cp ('t216');                    !!!cp ('t216');
5660  ## TODO: This erorr type ios wrong.  ## TODO: This erorr type is wrong.
5661                    !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5662                                      text => $token->{tag_name}, token => $token);
5663                    ## Ignore the token                    ## Ignore the token
5664                    !!!nack ('t216.1');                    !!!nack ('t216.1');
5665                    !!!next-token;                    !!!next-token;
# Line 5307  sub _tree_construction_main ($) { Line 5734  sub _tree_construction_main ($) {
5734                }                }
5735              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
5736                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
5737                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
5738                                    ->manakai_local_name,                                    ->manakai_local_name,
5739                                token => $token);                                token => $token);
5740    
# Line 5328  sub _tree_construction_main ($) { Line 5755  sub _tree_construction_main ($) {
5755                unless (defined $i) {                unless (defined $i) {
5756                  !!!cp ('t223');                  !!!cp ('t223');
5757  ## TODO: The following is wrong, maybe.  ## TODO: The following is wrong, maybe.
5758                  !!!parse-error (type => 'unmatched end tag:table', token => $token);                  !!!parse-error (type => 'unmatched end tag', text => 'table',
5759                                    token => $token);
5760                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
5761                  !!!nack ('t223.1');                  !!!nack ('t223.1');
5762                  !!!next-token;                  !!!next-token;
5763                  next B;                  next B;
5764                }                }
5765                                
5766  ## TODO: Followings are removed from the latest spec.  ## TODO: Followings are removed from the latest spec.
5767                ## generate implied end tags                ## generate implied end tags
5768                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
5769                  !!!cp ('t224');                  !!!cp ('t224');
# Line 5346  sub _tree_construction_main ($) { Line 5774  sub _tree_construction_main ($) {
5774                  !!!cp ('t225');                  !!!cp ('t225');
5775                  ## NOTE: |<table><tr><table>|                  ## NOTE: |<table><tr><table>|
5776                  !!!parse-error (type => 'not closed',                  !!!parse-error (type => 'not closed',
5777                                  value => $self->{open_elements}->[-1]->[0]                                  text => $self->{open_elements}->[-1]->[0]
5778                                      ->manakai_local_name,                                      ->manakai_local_name,
5779                                  token => $token);                                  token => $token);
5780                } else {                } else {
# Line 5387  sub _tree_construction_main ($) { Line 5815  sub _tree_construction_main ($) {
5815                my $type = lc $token->{attributes}->{type}->{value};                my $type = lc $token->{attributes}->{type}->{value};
5816                if ($type eq 'hidden') {                if ($type eq 'hidden') {
5817                  !!!cp ('t227.3');                  !!!cp ('t227.3');
5818                  !!!parse-error (type => 'in table:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'in table',
5819                                    text => $token->{tag_name}, token => $token);
5820    
5821                  !!!insert-element ($token->{tag_name}, $token->{attributes}, $token);                  !!!insert-element ($token->{tag_name}, $token->{attributes}, $token);
5822    
# Line 5415  sub _tree_construction_main ($) { Line 5844  sub _tree_construction_main ($) {
5844            #            #
5845          }          }
5846    
5847          !!!parse-error (type => 'in table:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'in table', text => $token->{tag_name},
5848                            token => $token);
5849    
5850          $insert = $insert_to_foster;          $insert = $insert_to_foster;
5851          #          #
# Line 5437  sub _tree_construction_main ($) { Line 5867  sub _tree_construction_main ($) {
5867                } # INSCOPE                } # INSCOPE
5868                unless (defined $i) {                unless (defined $i) {
5869                  !!!cp ('t230');                  !!!cp ('t230');
5870                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5871                                    text => $token->{tag_name}, token => $token);
5872                  ## Ignore the token                  ## Ignore the token
5873                  !!!nack ('t230.1');                  !!!nack ('t230.1');
5874                  !!!next-token;                  !!!next-token;
# Line 5478  sub _tree_construction_main ($) { Line 5909  sub _tree_construction_main ($) {
5909                  unless (defined $i) {                  unless (defined $i) {
5910                    !!!cp ('t235');                    !!!cp ('t235');
5911  ## TODO: The following is wrong.  ## TODO: The following is wrong.
5912                    !!!parse-error (type => 'unmatched end tag:'.$token->{type}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5913                                      text => $token->{type}, token => $token);
5914                    ## Ignore the token                    ## Ignore the token
5915                    !!!nack ('t236.1');                    !!!nack ('t236.1');
5916                    !!!next-token;                    !!!next-token;
# Line 5514  sub _tree_construction_main ($) { Line 5946  sub _tree_construction_main ($) {
5946                  } # INSCOPE                  } # INSCOPE
5947                  unless (defined $i) {                  unless (defined $i) {
5948                    !!!cp ('t239');                    !!!cp ('t239');
5949                    !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5950                                      text => $token->{tag_name}, token => $token);
5951                    ## Ignore the token                    ## Ignore the token
5952                    !!!nack ('t239.1');                    !!!nack ('t239.1');
5953                    !!!next-token;                    !!!next-token;
# Line 5560  sub _tree_construction_main ($) { Line 5993  sub _tree_construction_main ($) {
5993                } # INSCOPE                } # INSCOPE
5994                unless (defined $i) {                unless (defined $i) {
5995                  !!!cp ('t243');                  !!!cp ('t243');
5996                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5997                                    text => $token->{tag_name}, token => $token);
5998                  ## Ignore the token                  ## Ignore the token
5999                  !!!nack ('t243.1');                  !!!nack ('t243.1');
6000                  !!!next-token;                  !!!next-token;
# Line 5594  sub _tree_construction_main ($) { Line 6028  sub _tree_construction_main ($) {
6028                  } # INSCOPE                  } # INSCOPE
6029                    unless (defined $i) {                    unless (defined $i) {
6030                      !!!cp ('t249');                      !!!cp ('t249');
6031                      !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                      !!!parse-error (type => 'unmatched end tag',
6032                                        text => $token->{tag_name}, token => $token);
6033                      ## Ignore the token                      ## Ignore the token
6034                      !!!nack ('t249.1');                      !!!nack ('t249.1');
6035                      !!!next-token;                      !!!next-token;
# Line 5617  sub _tree_construction_main ($) { Line 6052  sub _tree_construction_main ($) {
6052                  } # INSCOPE                  } # INSCOPE
6053                    unless (defined $i) {                    unless (defined $i) {
6054                      !!!cp ('t252');                      !!!cp ('t252');
6055                      !!!parse-error (type => 'unmatched end tag:tr', token => $token);                      !!!parse-error (type => 'unmatched end tag',
6056                                        text => 'tr', token => $token);
6057                      ## Ignore the token                      ## Ignore the token
6058                      !!!nack ('t252.1');                      !!!nack ('t252.1');
6059                      !!!next-token;                      !!!next-token;
# Line 5652  sub _tree_construction_main ($) { Line 6088  sub _tree_construction_main ($) {
6088                } # INSCOPE                } # INSCOPE
6089                unless (defined $i) {                unless (defined $i) {
6090                  !!!cp ('t256');                  !!!cp ('t256');
6091                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
6092                                    text => $token->{tag_name}, token => $token);
6093                  ## Ignore the token                  ## Ignore the token
6094                  !!!nack ('t256.1');                  !!!nack ('t256.1');
6095                  !!!next-token;                  !!!next-token;
# Line 5679  sub _tree_construction_main ($) { Line 6116  sub _tree_construction_main ($) {
6116                        tbody => 1, tfoot => 1, thead => 1, # $self->{insertion_mode} == IN_TABLE_IM                        tbody => 1, tfoot => 1, thead => 1, # $self->{insertion_mode} == IN_TABLE_IM
6117                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
6118            !!!cp ('t258');            !!!cp ('t258');
6119            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
6120                              text => $token->{tag_name}, token => $token);
6121            ## Ignore the token            ## Ignore the token
6122            !!!nack ('t258.1');            !!!nack ('t258.1');
6123             !!!next-token;             !!!next-token;
6124            next B;            next B;
6125          } else {          } else {
6126            !!!cp ('t259');            !!!cp ('t259');
6127            !!!parse-error (type => 'in table:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in table:/',
6128                              text => $token->{tag_name}, token => $token);
6129    
6130            $insert = $insert_to_foster;            $insert = $insert_to_foster;
6131            #            #
# Line 5736  sub _tree_construction_main ($) { Line 6175  sub _tree_construction_main ($) {
6175              if ($token->{tag_name} eq 'colgroup') {              if ($token->{tag_name} eq 'colgroup') {
6176                if ($self->{open_elements}->[-1]->[1] & HTML_EL) {                if ($self->{open_elements}->[-1]->[1] & HTML_EL) {
6177                  !!!cp ('t264');                  !!!cp ('t264');
6178                  !!!parse-error (type => 'unmatched end tag:colgroup', token => $token);                  !!!parse-error (type => 'unmatched end tag',
6179                                    text => 'colgroup', token => $token);
6180                  ## Ignore the token                  ## Ignore the token
6181                  !!!next-token;                  !!!next-token;
6182                  next B;                  next B;
# Line 5749  sub _tree_construction_main ($) { Line 6189  sub _tree_construction_main ($) {
6189                }                }
6190              } elsif ($token->{tag_name} eq 'col') {              } elsif ($token->{tag_name} eq 'col') {
6191                !!!cp ('t266');                !!!cp ('t266');
6192                !!!parse-error (type => 'unmatched end tag:col', token => $token);                !!!parse-error (type => 'unmatched end tag',
6193                                  text => 'col', token => $token);
6194                ## Ignore the token                ## Ignore the token
6195                !!!next-token;                !!!next-token;
6196                next B;                next B;
# Line 5779  sub _tree_construction_main ($) { Line 6220  sub _tree_construction_main ($) {
6220            if ($self->{open_elements}->[-1]->[1] & HTML_EL) {            if ($self->{open_elements}->[-1]->[1] & HTML_EL) {
6221              !!!cp ('t269');              !!!cp ('t269');
6222  ## TODO: Wrong error type?  ## TODO: Wrong error type?
6223              !!!parse-error (type => 'unmatched end tag:colgroup', token => $token);              !!!parse-error (type => 'unmatched end tag',
6224                                text => 'colgroup', token => $token);
6225              ## Ignore the token              ## Ignore the token
6226              !!!nack ('t269.1');              !!!nack ('t269.1');
6227              !!!next-token;              !!!next-token;
# Line 5833  sub _tree_construction_main ($) { Line 6275  sub _tree_construction_main ($) {
6275            !!!nack ('t277.1');            !!!nack ('t277.1');
6276            !!!next-token;            !!!next-token;
6277            next B;            next B;
6278          } elsif ($token->{tag_name} eq 'select' or          } elsif ({
6279                   $token->{tag_name} eq 'input' or                     select => 1, input => 1, textarea => 1,
6280                     }->{$token->{tag_name}} or
6281                   ($self->{insertion_mode} == IN_SELECT_IN_TABLE_IM and                   ($self->{insertion_mode} == IN_SELECT_IN_TABLE_IM and
6282                    {                    {
6283                     caption => 1, table => 1,                     caption => 1, table => 1,
# Line 5842  sub _tree_construction_main ($) { Line 6285  sub _tree_construction_main ($) {
6285                     tr => 1, td => 1, th => 1,                     tr => 1, td => 1, th => 1,
6286                    }->{$token->{tag_name}})) {                    }->{$token->{tag_name}})) {
6287            ## TODO: The type below is not good - <select> is replaced by </select>            ## TODO: The type below is not good - <select> is replaced by </select>
6288            !!!parse-error (type => 'not closed:select', token => $token);            !!!parse-error (type => 'not closed', text => 'select',
6289                              token => $token);
6290            ## NOTE: As if the token were </select> (<select> case) or            ## NOTE: As if the token were </select> (<select> case) or
6291            ## as if there were </select> (otherwise).            ## as if there were </select> (otherwise).
6292            ## have an element in table scope            ## have an element in table scope
# Line 5860  sub _tree_construction_main ($) { Line 6304  sub _tree_construction_main ($) {
6304            } # INSCOPE            } # INSCOPE
6305            unless (defined $i) {            unless (defined $i) {
6306              !!!cp ('t280');              !!!cp ('t280');
6307              !!!parse-error (type => 'unmatched end tag:select', token => $token);              !!!parse-error (type => 'unmatched end tag',
6308                                text => 'select', token => $token);
6309              ## Ignore the token              ## Ignore the token
6310              !!!nack ('t280.1');              !!!nack ('t280.1');
6311              !!!next-token;              !!!next-token;
# Line 5884  sub _tree_construction_main ($) { Line 6329  sub _tree_construction_main ($) {
6329            }            }
6330          } else {          } else {
6331            !!!cp ('t282');            !!!cp ('t282');
6332            !!!parse-error (type => 'in select:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in select',
6333                              text => $token->{tag_name}, token => $token);
6334            ## Ignore the token            ## Ignore the token
6335            !!!nack ('t282.1');            !!!nack ('t282.1');
6336            !!!next-token;            !!!next-token;
# Line 5902  sub _tree_construction_main ($) { Line 6348  sub _tree_construction_main ($) {
6348              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
6349            } else {            } else {
6350              !!!cp ('t285');              !!!cp ('t285');
6351              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6352                                text => $token->{tag_name}, token => $token);
6353              ## Ignore the token              ## Ignore the token
6354            }            }
6355            !!!nack ('t285.1');            !!!nack ('t285.1');
# Line 5914  sub _tree_construction_main ($) { Line 6361  sub _tree_construction_main ($) {
6361              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
6362            } else {            } else {
6363              !!!cp ('t287');              !!!cp ('t287');
6364              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6365                                text => $token->{tag_name}, token => $token);
6366              ## Ignore the token              ## Ignore the token
6367            }            }
6368            !!!nack ('t287.1');            !!!nack ('t287.1');
# Line 5936  sub _tree_construction_main ($) { Line 6384  sub _tree_construction_main ($) {
6384            } # INSCOPE            } # INSCOPE
6385            unless (defined $i) {            unless (defined $i) {
6386              !!!cp ('t290');              !!!cp ('t290');
6387              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6388                                text => $token->{tag_name}, token => $token);
6389              ## Ignore the token              ## Ignore the token
6390              !!!nack ('t290.1');              !!!nack ('t290.1');
6391              !!!next-token;              !!!next-token;
# Line 5957  sub _tree_construction_main ($) { Line 6406  sub _tree_construction_main ($) {
6406                    tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,                    tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,
6407                   }->{$token->{tag_name}}) {                   }->{$token->{tag_name}}) {
6408  ## TODO: The following is wrong?  ## TODO: The following is wrong?
6409            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
6410                              text => $token->{tag_name}, token => $token);
6411                                
6412            ## have an element in table scope            ## have an element in table scope
6413            my $i;            my $i;
# Line 5998  sub _tree_construction_main ($) { Line 6448  sub _tree_construction_main ($) {
6448            unless (defined $i) {            unless (defined $i) {
6449              !!!cp ('t297');              !!!cp ('t297');
6450  ## TODO: The following error type is correct?  ## TODO: The following error type is correct?
6451              !!!parse-error (type => 'unmatched end tag:select', token => $token);              !!!parse-error (type => 'unmatched end tag',
6452                                text => 'select', token => $token);
6453              ## Ignore the </select> token              ## Ignore the </select> token
6454              !!!nack ('t297.1');              !!!nack ('t297.1');
6455              !!!next-token; ## TODO: ok?              !!!next-token; ## TODO: ok?
# Line 6015  sub _tree_construction_main ($) { Line 6466  sub _tree_construction_main ($) {
6466            next B;            next B;
6467          } else {          } else {
6468            !!!cp ('t299');            !!!cp ('t299');
6469            !!!parse-error (type => 'in select:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in select:/',
6470                              text => $token->{tag_name}, token => $token);
6471            ## Ignore the token            ## Ignore the token
6472            !!!nack ('t299.3');            !!!nack ('t299.3');
6473            !!!next-token;            !!!next-token;
# Line 6053  sub _tree_construction_main ($) { Line 6505  sub _tree_construction_main ($) {
6505                    
6506          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6507            !!!cp ('t301');            !!!cp ('t301');
6508            !!!parse-error (type => 'after html:#character', token => $token);            !!!parse-error (type => 'after html:#text', token => $token);
6509    
6510            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
6511          } else {          } else {
# Line 6061  sub _tree_construction_main ($) { Line 6513  sub _tree_construction_main ($) {
6513          }          }
6514                    
6515          ## "after body" insertion mode          ## "after body" insertion mode
6516          !!!parse-error (type => 'after body:#character', token => $token);          !!!parse-error (type => 'after body:#text', token => $token);
6517    
6518          $self->{insertion_mode} = IN_BODY_IM;          $self->{insertion_mode} = IN_BODY_IM;
6519          ## reprocess          ## reprocess
# Line 6069  sub _tree_construction_main ($) { Line 6521  sub _tree_construction_main ($) {
6521        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
6522          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6523            !!!cp ('t303');            !!!cp ('t303');
6524            !!!parse-error (type => 'after html:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after html',
6525                              text => $token->{tag_name}, token => $token);
6526                        
6527            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
6528          } else {          } else {
# Line 6077  sub _tree_construction_main ($) { Line 6530  sub _tree_construction_main ($) {
6530          }          }
6531    
6532          ## "after body" insertion mode          ## "after body" insertion mode
6533          !!!parse-error (type => 'after body:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'after body',
6534                            text => $token->{tag_name}, token => $token);
6535    
6536          $self->{insertion_mode} = IN_BODY_IM;          $self->{insertion_mode} = IN_BODY_IM;
6537          !!!ack-later;          !!!ack-later;
# Line 6086  sub _tree_construction_main ($) { Line 6540  sub _tree_construction_main ($) {
6540        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
6541          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6542            !!!cp ('t305');            !!!cp ('t305');
6543            !!!parse-error (type => 'after html:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after html:/',
6544                              text => $token->{tag_name}, token => $token);
6545                        
6546            $self->{insertion_mode} = AFTER_BODY_IM;            $self->{insertion_mode} = AFTER_BODY_IM;
6547            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
# Line 6098  sub _tree_construction_main ($) { Line 6553  sub _tree_construction_main ($) {
6553          if ($token->{tag_name} eq 'html') {          if ($token->{tag_name} eq 'html') {
6554            if (defined $self->{inner_html_node}) {            if (defined $self->{inner_html_node}) {
6555              !!!cp ('t307');              !!!cp ('t307');
6556              !!!parse-error (type => 'unmatched end tag:html', token => $token);              !!!parse-error (type => 'unmatched end tag',
6557                                text => 'html', token => $token);
6558              ## Ignore the token              ## Ignore the token
6559              !!!next-token;              !!!next-token;
6560              next B;              next B;
# Line 6110  sub _tree_construction_main ($) { Line 6566  sub _tree_construction_main ($) {
6566            }            }
6567          } else {          } else {
6568            !!!cp ('t309');            !!!cp ('t309');
6569            !!!parse-error (type => 'after body:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after body:/',
6570                              text => $token->{tag_name}, token => $token);
6571    
6572            $self->{insertion_mode} = IN_BODY_IM;            $self->{insertion_mode} = IN_BODY_IM;
6573            ## reprocess            ## reprocess
# Line 6138  sub _tree_construction_main ($) { Line 6595  sub _tree_construction_main ($) {
6595          if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {          if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {
6596            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6597              !!!cp ('t311');              !!!cp ('t311');
6598              !!!parse-error (type => 'in frameset:#character', token => $token);              !!!parse-error (type => 'in frameset:#text', token => $token);
6599            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6600              !!!cp ('t312');              !!!cp ('t312');
6601              !!!parse-error (type => 'after frameset:#character', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6602            } else { # "after html frameset"            } else { # "after after frameset"
6603              !!!cp ('t313');              !!!cp ('t313');
6604              !!!parse-error (type => 'after html:#character', token => $token);              !!!parse-error (type => 'after html:#text', token => $token);
   
             $self->{insertion_mode} = AFTER_FRAMESET_IM;  
             ## Reprocess in the "after frameset" insertion mode.  
             !!!parse-error (type => 'after frameset:#character', token => $token);  
6605            }            }
6606                        
6607            ## Ignore the token.            ## Ignore the token.
# Line 6164  sub _tree_construction_main ($) { Line 6617  sub _tree_construction_main ($) {
6617                    
6618          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6619        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t316');  
           !!!parse-error (type => 'after html:'.$token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t317');  
         }  
   
6620          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6621              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6622            !!!cp ('t318');            !!!cp ('t318');
# Line 6191  sub _tree_construction_main ($) { Line 6634  sub _tree_construction_main ($) {
6634            next B;            next B;
6635          } elsif ($token->{tag_name} eq 'noframes') {          } elsif ($token->{tag_name} eq 'noframes') {
6636            !!!cp ('t320');            !!!cp ('t320');
6637            ## NOTE: As if in body.            ## NOTE: As if in head.
6638            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6639            next B;            next B;
6640    
6641              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6642              ## has no parse error.
6643          } else {          } else {
6644            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6645              !!!cp ('t321');              !!!cp ('t321');
6646              !!!parse-error (type => 'in frameset:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'in frameset',
6647            } else {                              text => $token->{tag_name}, token => $token);
6648              } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6649              !!!cp ('t322');              !!!cp ('t322');
6650              !!!parse-error (type => 'after frameset:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'after frameset',
6651                                text => $token->{tag_name}, token => $token);
6652              } else { # "after after frameset"
6653                !!!cp ('t322.2');
6654                !!!parse-error (type => 'after after frameset',
6655                                text => $token->{tag_name}, token => $token);
6656            }            }
6657            ## Ignore the token            ## Ignore the token
6658            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 6208  sub _tree_construction_main ($) { Line 6660  sub _tree_construction_main ($) {
6660            next B;            next B;
6661          }          }
6662        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
         if ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {  
           !!!cp ('t323');  
           !!!parse-error (type => 'after html:/'.$token->{tag_name}, token => $token);  
   
           $self->{insertion_mode} = AFTER_FRAMESET_IM;  
           ## Process in the "after frameset" insertion mode.  
         } else {  
           !!!cp ('t324');  
         }  
   
6663          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6664              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6665            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
6666                @{$self->{open_elements}} == 1) {                @{$self->{open_elements}} == 1) {
6667              !!!cp ('t325');              !!!cp ('t325');
6668              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6669                                text => $token->{tag_name}, token => $token);
6670              ## Ignore the token              ## Ignore the token
6671              !!!next-token;              !!!next-token;
6672            } else {            } else {
# Line 6249  sub _tree_construction_main ($) { Line 6692  sub _tree_construction_main ($) {
6692          } else {          } else {
6693            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6694              !!!cp ('t330');              !!!cp ('t330');
6695              !!!parse-error (type => 'in frameset:/'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'in frameset:/',
6696            } else {                              text => $token->{tag_name}, token => $token);
6697              } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6698                !!!cp ('t330.1');
6699                !!!parse-error (type => 'after frameset:/',
6700                                text => $token->{tag_name}, token => $token);
6701              } else { # "after after html"
6702              !!!cp ('t331');              !!!cp ('t331');
6703              !!!parse-error (type => 'after frameset:/'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'after after frameset:/',
6704                                text => $token->{tag_name}, token => $token);
6705            }            }
6706            ## Ignore the token            ## Ignore the token
6707            !!!next-token;            !!!next-token;
# Line 6319  sub _tree_construction_main ($) { Line 6768  sub _tree_construction_main ($) {
6768                                           ->{has_reference});                                           ->{has_reference});
6769            } elsif ($token->{attributes}->{content}) {            } elsif ($token->{attributes}->{content}) {
6770              if ($token->{attributes}->{content}->{value}              if ($token->{attributes}->{content}->{value}
6771                  =~ /\A[^;]*;[\x09-\x0D\x20]*[Cc][Hh][Aa][Rr][Ss][Ee][Tt]                  =~ /[Cc][Hh][Aa][Rr][Ss][Ee][Tt]
6772                      [\x09-\x0D\x20]*=                      [\x09-\x0D\x20]*=
6773                      [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|                      [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
6774                      ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {                      ([^"'\x09-\x0D\x20][^\x09-\x0D\x20\x3B]*))/x) {
6775                !!!cp ('t336');                !!!cp ('t336');
6776                ## NOTE: Whether the encoding is supported or not is handled                ## NOTE: Whether the encoding is supported or not is handled
6777                ## in the {change_encoding} callback.                ## in the {change_encoding} callback.
# Line 6360  sub _tree_construction_main ($) { Line 6809  sub _tree_construction_main ($) {
6809          $parse_rcdata->(RCDATA_CONTENT_MODEL);          $parse_rcdata->(RCDATA_CONTENT_MODEL);
6810          next B;          next B;
6811        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
6812          !!!parse-error (type => 'in body:body', token => $token);          !!!parse-error (type => 'in body', text => 'body', token => $token);
6813                                
6814          if (@{$self->{open_elements}} == 1 or          if (@{$self->{open_elements}} == 1 or
6815              not ($self->{open_elements}->[1]->[1] & BODY_EL)) {              not ($self->{open_elements}->[1]->[1] & BODY_EL)) {
# Line 6480  sub _tree_construction_main ($) { Line 6929  sub _tree_construction_main ($) {
6929              if ($i != -1) {              if ($i != -1) {
6930                !!!cp ('t355');                !!!cp ('t355');
6931                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
6932                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
6933                                    ->manakai_local_name,                                    ->manakai_local_name,
6934                                token => $token);                                token => $token);
6935              } else {              } else {
# Line 6634  sub _tree_construction_main ($) { Line 7083  sub _tree_construction_main ($) {
7083                  xmp => 1,                  xmp => 1,
7084                  iframe => 1,                  iframe => 1,
7085                  noembed => 1,                  noembed => 1,
7086                  noframes => 1,                  noframes => 1, ## NOTE: This is an "as if in head" code clone.
7087                  noscript => 0, ## TODO: 1 if scripting is enabled                  noscript => 0, ## TODO: 1 if scripting is enabled
7088                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7089          if ($token->{tag_name} eq 'xmp') {          if ($token->{tag_name} eq 'xmp') {
# Line 6656  sub _tree_construction_main ($) { Line 7105  sub _tree_construction_main ($) {
7105            !!!next-token;            !!!next-token;
7106            next B;            next B;
7107          } else {          } else {
7108              !!!ack ('t391.1');
7109    
7110            my $at = $token->{attributes};            my $at = $token->{attributes};
7111            my $form_attrs;            my $form_attrs;
7112            $form_attrs->{action} = $at->{action} if $at->{action};            $form_attrs->{action} = $at->{action} if $at->{action};
# Line 6699  sub _tree_construction_main ($) { Line 7150  sub _tree_construction_main ($) {
7150                           line => $token->{line}, column => $token->{column}},                           line => $token->{line}, column => $token->{column}},
7151                          {type => END_TAG_TOKEN, tag_name => 'form',                          {type => END_TAG_TOKEN, tag_name => 'form',
7152                           line => $token->{line}, column => $token->{column}};                           line => $token->{line}, column => $token->{column}};
           !!!nack ('t391.1'); ## NOTE: Not acknowledged.  
7153            !!!back-token (@tokens);            !!!back-token (@tokens);
7154            !!!next-token;            !!!next-token;
7155            next B;            next B;
# Line 6747  sub _tree_construction_main ($) { Line 7197  sub _tree_construction_main ($) {
7197            ## Ignore the token            ## Ignore the token
7198          } else {          } else {
7199            !!!cp ('t398');            !!!cp ('t398');
7200            !!!parse-error (type => 'in RCDATA:#'.$token->{type}, token => $token);            !!!parse-error (type => 'in RCDATA:#eof', token => $token);
7201          }          }
7202          !!!next-token;          !!!next-token;
7203          next B;          next B;
7204          } elsif ($token->{tag_name} eq 'rt' or
7205                   $token->{tag_name} eq 'rp') {
7206            ## has a |ruby| element in scope
7207            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
7208              my $node = $self->{open_elements}->[$_];
7209              if ($node->[1] & RUBY_EL) {
7210                !!!cp ('t398.1');
7211                ## generate implied end tags
7212                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
7213                  !!!cp ('t398.2');
7214                  pop @{$self->{open_elements}};
7215                }
7216                unless ($self->{open_elements}->[-1]->[1] & RUBY_EL) {
7217                  !!!cp ('t398.3');
7218                  !!!parse-error (type => 'not closed',
7219                                  text => $self->{open_elements}->[-1]->[0]
7220                                      ->manakai_local_name,
7221                                  token => $token);
7222                  pop @{$self->{open_elements}}
7223                      while not $self->{open_elements}->[-1]->[1] & RUBY_EL;
7224                }
7225                last INSCOPE;
7226              } elsif ($node->[1] & SCOPING_EL) {
7227                !!!cp ('t398.4');
7228                last INSCOPE;
7229              }
7230            } # INSCOPE
7231    
7232            !!!insert-element-t ($token->{tag_name}, $token->{attributes}, $token);
7233    
7234            !!!nack ('t398.5');
7235            !!!next-token;
7236            redo B;
7237        } elsif ($token->{tag_name} eq 'math' or        } elsif ($token->{tag_name} eq 'math' or
7238                 $token->{tag_name} eq 'svg') {                 $token->{tag_name} eq 'svg') {
7239          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
7240    
7241            ## "Adjust MathML attributes" ('math' only) - done in insert-element-f
7242    
7243          ## "adjust SVG attributes" ('svg' only) - done in insert-element-f          ## "adjust SVG attributes" ('svg' only) - done in insert-element-f
7244    
7245          ## "adjust foreign attributes" - done in insert-element-f          ## "adjust foreign attributes" - done in insert-element-f
# Line 6781  sub _tree_construction_main ($) { Line 7266  sub _tree_construction_main ($) {
7266                  thead => 1, tr => 1,                  thead => 1, tr => 1,
7267                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7268          !!!cp ('t401');          !!!cp ('t401');
7269          !!!parse-error (type => 'in body:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'in body',
7270                            text => $token->{tag_name}, token => $token);
7271          ## Ignore the token          ## Ignore the token
7272          !!!nack ('t401.1'); ## NOTE: |<col/>| or |<frame/>| here is an error.          !!!nack ('t401.1'); ## NOTE: |<col/>| or |<frame/>| here is an error.
7273          !!!next-token;          !!!next-token;
# Line 6866  sub _tree_construction_main ($) { Line 7352  sub _tree_construction_main ($) {
7352            }            }
7353    
7354            !!!parse-error (type => 'start tag not allowed',            !!!parse-error (type => 'start tag not allowed',
7355                            value => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7356            ## NOTE: Ignore the token.            ## NOTE: Ignore the token.
7357            !!!next-token;            !!!next-token;
7358            next B;            next B;
# Line 6876  sub _tree_construction_main ($) { Line 7362  sub _tree_construction_main ($) {
7362            unless ($_->[1] & ALL_END_TAG_OPTIONAL_EL) {            unless ($_->[1] & ALL_END_TAG_OPTIONAL_EL) {
7363              !!!cp ('t403');              !!!cp ('t403');
7364              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7365                              value => $_->[0]->manakai_local_name,                              text => $_->[0]->manakai_local_name,
7366                              token => $token);                              token => $token);
7367              last;              last;
7368            } else {            } else {
# Line 6896  sub _tree_construction_main ($) { Line 7382  sub _tree_construction_main ($) {
7382            unless ($self->{open_elements}->[-1]->[1] & BODY_EL) {            unless ($self->{open_elements}->[-1]->[1] & BODY_EL) {
7383              !!!cp ('t406');              !!!cp ('t406');
7384              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7385                              value => $self->{open_elements}->[1]->[0]                              text => $self->{open_elements}->[1]->[0]
7386                                  ->manakai_local_name,                                  ->manakai_local_name,
7387                              token => $token);                              token => $token);
7388            } else {            } else {
# Line 6907  sub _tree_construction_main ($) { Line 7393  sub _tree_construction_main ($) {
7393            next B;            next B;
7394          } else {          } else {
7395            !!!cp ('t408');            !!!cp ('t408');
7396            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7397                              text => $token->{tag_name}, token => $token);
7398            ## Ignore the token            ## Ignore the token
7399            !!!next-token;            !!!next-token;
7400            next B;            next B;
# Line 6935  sub _tree_construction_main ($) { Line 7422  sub _tree_construction_main ($) {
7422    
7423          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7424            !!!cp ('t413');            !!!cp ('t413');
7425            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7426                              text => $token->{tag_name}, token => $token);
7427              ## NOTE: Ignore the token.
7428          } else {          } else {
7429            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7430            while ({            while ({
7431                      ## END_TAG_OPTIONAL_EL
7432                    dd => ($token->{tag_name} ne 'dd'),                    dd => ($token->{tag_name} ne 'dd'),
7433                    dt => ($token->{tag_name} ne 'dt'),                    dt => ($token->{tag_name} ne 'dt'),
7434                    li => ($token->{tag_name} ne 'li'),                    li => ($token->{tag_name} ne 'li'),
7435                    p => 1,                    p => 1,
7436                      rt => 1,
7437                      rp => 1,
7438                   }->{$self->{open_elements}->[-1]->[0]->manakai_local_name}) {                   }->{$self->{open_elements}->[-1]->[0]->manakai_local_name}) {
7439              !!!cp ('t409');              !!!cp ('t409');
7440              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
# Line 6953  sub _tree_construction_main ($) { Line 7445  sub _tree_construction_main ($) {
7445                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7446              !!!cp ('t412');              !!!cp ('t412');
7447              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7448                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7449                                  ->manakai_local_name,                                  ->manakai_local_name,
7450                              token => $token);                              token => $token);
7451            } else {            } else {
# Line 6990  sub _tree_construction_main ($) { Line 7482  sub _tree_construction_main ($) {
7482    
7483          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7484            !!!cp ('t421');            !!!cp ('t421');
7485            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7486                              text => $token->{tag_name}, token => $token);
7487              ## NOTE: Ignore the token.
7488          } else {          } else {
7489            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7490            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7003  sub _tree_construction_main ($) { Line 7497  sub _tree_construction_main ($) {
7497                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7498              !!!cp ('t417.1');              !!!cp ('t417.1');
7499              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7500                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7501                                  ->manakai_local_name,                                  ->manakai_local_name,
7502                              token => $token);                              token => $token);
7503            } else {            } else {
# Line 7035  sub _tree_construction_main ($) { Line 7529  sub _tree_construction_main ($) {
7529    
7530          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7531            !!!cp ('t425.1');            !!!cp ('t425.1');
7532            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7533                              text => $token->{tag_name}, token => $token);
7534              ## NOTE: Ignore the token.
7535          } else {          } else {
7536            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7537            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 7047  sub _tree_construction_main ($) { Line 7543  sub _tree_construction_main ($) {
7543            if ($self->{open_elements}->[-1]->[0]->manakai_local_name            if ($self->{open_elements}->[-1]->[0]->manakai_local_name
7544                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7545              !!!cp ('t425');              !!!cp ('t425');
7546              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
7547                                text => $token->{tag_name}, token => $token);
7548            } else {            } else {
7549              !!!cp ('t426');              !!!cp ('t426');
7550            }            }
# Line 7078  sub _tree_construction_main ($) { Line 7575  sub _tree_construction_main ($) {
7575                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7576              !!!cp ('t412.1');              !!!cp ('t412.1');
7577              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7578                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7579                                  ->manakai_local_name,                                  ->manakai_local_name,
7580                              token => $token);                              token => $token);
7581            } else {            } else {
# Line 7088  sub _tree_construction_main ($) { Line 7585  sub _tree_construction_main ($) {
7585            splice @{$self->{open_elements}}, $i;            splice @{$self->{open_elements}}, $i;
7586          } else {          } else {
7587            !!!cp ('t413.1');            !!!cp ('t413.1');
7588            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7589                              text => $token->{tag_name}, token => $token);
7590    
7591            !!!cp ('t415.1');            !!!cp ('t415.1');
7592            ## As if <p>, then reprocess the current token            ## As if <p>, then reprocess the current token
# Line 7111  sub _tree_construction_main ($) { Line 7609  sub _tree_construction_main ($) {
7609          next B;          next B;
7610        } elsif ($token->{tag_name} eq 'br') {        } elsif ($token->{tag_name} eq 'br') {
7611          !!!cp ('t428');          !!!cp ('t428');
7612          !!!parse-error (type => 'unmatched end tag:br', token => $token);          !!!parse-error (type => 'unmatched end tag',
7613                            text => 'br', token => $token);
7614    
7615          ## As if <br>          ## As if <br>
7616          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
# Line 7136  sub _tree_construction_main ($) { Line 7635  sub _tree_construction_main ($) {
7635                  noscript => 0, ## TODO: if scripting is enabled                  noscript => 0, ## TODO: if scripting is enabled
7636                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7637          !!!cp ('t429');          !!!cp ('t429');
7638          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'unmatched end tag',
7639                            text => $token->{tag_name}, token => $token);
7640          ## Ignore the token          ## Ignore the token
7641          !!!next-token;          !!!next-token;
7642          next B;          next B;
# Line 7155  sub _tree_construction_main ($) { Line 7655  sub _tree_construction_main ($) {
7655              ## generate implied end tags              ## generate implied end tags
7656              while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {              while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
7657                !!!cp ('t430');                !!!cp ('t430');
7658                ## ISSUE: Can this case be reached?                ## NOTE: |<ruby><rt></ruby>|.
7659                  ## ISSUE: <ruby><rt></rt> will also take this code path,
7660                  ## which seems wrong.
7661                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
7662                  $node_i++;
7663              }              }
7664                    
7665              ## Step 2              ## Step 2
# Line 7165  sub _tree_construction_main ($) { Line 7668  sub _tree_construction_main ($) {
7668                !!!cp ('t431');                !!!cp ('t431');
7669                ## NOTE: <x><y></x>                ## NOTE: <x><y></x>
7670                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
7671                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
7672                                    ->manakai_local_name,                                    ->manakai_local_name,
7673                                token => $token);                                token => $token);
7674              } else {              } else {
# Line 7173  sub _tree_construction_main ($) { Line 7676  sub _tree_construction_main ($) {
7676              }              }
7677                            
7678              ## Step 3              ## Step 3
7679              splice @{$self->{open_elements}}, $node_i;              splice @{$self->{open_elements}}, $node_i if $node_i < 0;
7680    
7681              !!!next-token;              !!!next-token;
7682              last S2;              last S2;
# Line 7184  sub _tree_construction_main ($) { Line 7687  sub _tree_construction_main ($) {
7687                  ($node->[1] & SPECIAL_EL or                  ($node->[1] & SPECIAL_EL or
7688                   $node->[1] & SCOPING_EL)) {                   $node->[1] & SCOPING_EL)) {
7689                !!!cp ('t433');                !!!cp ('t433');
7690                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
7691                                  text => $token->{tag_name}, token => $token);
7692                ## Ignore the token                ## Ignore the token
7693                !!!next-token;                !!!next-token;
7694                last S2;                last S2;
# Line 7230  sub _tree_construction_main ($) { Line 7734  sub _tree_construction_main ($) {
7734    ## TODO: script stuffs    ## TODO: script stuffs
7735  } # _tree_construct_main  } # _tree_construct_main
7736    
7737  sub set_inner_html ($$$) {  sub set_inner_html ($$$$;$) {
7738    my $class = shift;    my $class = shift;
7739    my $node = shift;    my $node = shift;
7740    my $s = \$_[0];    #my $s = \$_[0];
7741    my $onerror = $_[1];    my $onerror = $_[1];
7742      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7743    
7744    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7745    
# Line 7253  sub set_inner_html ($$$) { Line 7758  sub set_inner_html ($$$) {
7758      }      }
7759    
7760      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7761      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($_[0] => $node, $onerror, $get_wrapper);
7762    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7763      ## TODO: If non-html element      ## TODO: If non-html element
7764    
7765      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7766    
7767    ## TODO: Support for $get_wrapper
7768    
7769      ## Step 1 # MUST      ## Step 1 # MUST
7770      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7771      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
# Line 7270  sub set_inner_html ($$$) { Line 7777  sub set_inner_html ($$$) {
7777      my $i = 0;      my $i = 0;
7778      $p->{line_prev} = $p->{line} = 1;      $p->{line_prev} = $p->{line} = 1;
7779      $p->{column_prev} = $p->{column} = 0;      $p->{column_prev} = $p->{column} = 0;
7780        require Whatpm::Charset::DecodeHandle;
7781        my $input = Whatpm::Charset::DecodeHandle::CharString->new (\($_[0]));
7782        $input = $get_wrapper->($input);
7783      $p->{set_next_char} = sub {      $p->{set_next_char} = sub {
7784        my $self = shift;        my $self = shift;
7785    
7786        pop @{$self->{prev_char}};        pop @{$self->{prev_char}};
7787        unshift @{$self->{prev_char}}, $self->{next_char};        unshift @{$self->{prev_char}}, $self->{next_char};
7788    
7789        $self->{next_char} = -1 and return if $i >= length $$s;        my $char;
7790        $self->{next_char} = ord substr $$s, $i++, 1;        if (defined $self->{next_next_char}) {
7791            $char = $self->{next_next_char};
7792            delete $self->{next_next_char};
7793          } else {
7794            $char = $input->getc;
7795          }
7796          $self->{next_char} = -1 and return unless defined $char;
7797          $self->{next_char} = ord $char;
7798    
7799        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});        ($p->{line_prev}, $p->{column_prev}) = ($p->{line}, $p->{column});
7800        $p->{column}++;        $p->{column}++;
# Line 7287  sub set_inner_html ($$$) { Line 7804  sub set_inner_html ($$$) {
7804          $p->{column} = 0;          $p->{column} = 0;
7805          !!!cp ('i1');          !!!cp ('i1');
7806        } elsif ($self->{next_char} == 0x000D) { # CR        } elsif ($self->{next_char} == 0x000D) { # CR
7807          $i++ if substr ($$s, $i, 1) eq "\x0A";  ## TODO: support for abort/streaming
7808            my $next = $input->getc;
7809            if (defined $next and $next ne "\x0A") {
7810              $self->{next_next_char} = $next;
7811            }
7812          $self->{next_char} = 0x000A; # LF # MUST          $self->{next_char} = 0x000A; # LF # MUST
7813          $p->{line}++;          $p->{line}++;
7814          $p->{column} = 0;          $p->{column} = 0;
# Line 7320  sub set_inner_html ($$$) { Line 7841  sub set_inner_html ($$$) {
7841                  0x10FFFE => 1, 0x10FFFF => 1,                  0x10FFFE => 1, 0x10FFFF => 1,
7842                 }->{$self->{next_char}}) {                 }->{$self->{next_char}}) {
7843          !!!cp ('i4.1');          !!!cp ('i4.1');
7844          !!!parse-error (type => 'control char', level => $self->{must_level});          if ($self->{next_char} < 0x10000) {
7845  ## TODO: error type documentation            !!!parse-error (type => 'control char',
7846                              text => (sprintf 'U+%04X', $self->{next_char}));
7847            } else {
7848              !!!parse-error (type => 'control char',
7849                              text => (sprintf 'U-%08X', $self->{next_char}));
7850            }
7851        }        }
7852      };      };
7853      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7854      $p->{next_char} = -1;      $p->{next_char} = -1;
7855        
7856        $p->{read_until} = sub {
7857          #my ($scalar, $specials_range, $offset) = @_;
7858          my $specials_range = $_[1];
7859          return 0 if defined $p->{next_next_char};
7860          my $count = $input->manakai_read_until
7861            ($_[0],
7862             qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
7863             $_[2]);
7864          if ($count) {
7865            $p->{column} += $count;
7866            $p->{column_prev} += $count;
7867            $p->{prev_char} = [-1, -1, -1];
7868            $p->{next_char} = -1;
7869          }
7870          return $count;
7871        }; # $p->{read_until}
7872    
7873      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7874        my (%opt) = @_;        my (%opt) = @_;
7875        my $line = $opt{line};        my $line = $opt{line};
Legend:
Removed from v.1.139  
changed lines
  Added in v.1.177
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24