/[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.129 by wakaba, Sat Apr 12 15:37:33 2008 UTC revision 1.171 by wakaba, Sun Sep 14 01:51:08 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    
11  ## TODO: Control charcters and noncharacters are not allowed (HTML5 revision 1263)  require IO::Handle;
 ## TODO: 1252 parse error (revision 1264)  
 ## TODO: 8859-11 = 874 (revision 1271)  
12    
13  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;  my $HTML_NS = q<http://www.w3.org/1999/xhtml>;
14  my $MML_NS = q<http://www.w3.org/1998/Math/MathML>;  my $MML_NS = q<http://www.w3.org/1998/Math/MathML>;
# Line 47  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 54  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 98  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 172  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 205  my $el_category_f = { Line 223  my $el_category_f = {
223      mtext => FOREIGN_FLOW_CONTENT_EL,      mtext => FOREIGN_FLOW_CONTENT_EL,
224    },    },
225    $SVG_NS => {    $SVG_NS => {
226      foreignobject => FOREIGN_FLOW_CONTENT_EL, ## TODO: case      foreignObject => FOREIGN_FLOW_CONTENT_EL,
227      desc => FOREIGN_FLOW_CONTENT_EL,      desc => FOREIGN_FLOW_CONTENT_EL,
228      title => FOREIGN_FLOW_CONTENT_EL,      title => FOREIGN_FLOW_CONTENT_EL,
229    },    },
230    ## NOTE: In addition, FOREIGN_EL is set to non-HTML elements.    ## NOTE: In addition, FOREIGN_EL is set to non-HTML elements.
231  };  };
232    
233    my $svg_attr_name = {
234      attributename => 'attributeName',
235      attributetype => 'attributeType',
236      basefrequency => 'baseFrequency',
237      baseprofile => 'baseProfile',
238      calcmode => 'calcMode',
239      clippathunits => 'clipPathUnits',
240      contentscripttype => 'contentScriptType',
241      contentstyletype => 'contentStyleType',
242      diffuseconstant => 'diffuseConstant',
243      edgemode => 'edgeMode',
244      externalresourcesrequired => 'externalResourcesRequired',
245      filterres => 'filterRes',
246      filterunits => 'filterUnits',
247      glyphref => 'glyphRef',
248      gradienttransform => 'gradientTransform',
249      gradientunits => 'gradientUnits',
250      kernelmatrix => 'kernelMatrix',
251      kernelunitlength => 'kernelUnitLength',
252      keypoints => 'keyPoints',
253      keysplines => 'keySplines',
254      keytimes => 'keyTimes',
255      lengthadjust => 'lengthAdjust',
256      limitingconeangle => 'limitingConeAngle',
257      markerheight => 'markerHeight',
258      markerunits => 'markerUnits',
259      markerwidth => 'markerWidth',
260      maskcontentunits => 'maskContentUnits',
261      maskunits => 'maskUnits',
262      numoctaves => 'numOctaves',
263      pathlength => 'pathLength',
264      patterncontentunits => 'patternContentUnits',
265      patterntransform => 'patternTransform',
266      patternunits => 'patternUnits',
267      pointsatx => 'pointsAtX',
268      pointsaty => 'pointsAtY',
269      pointsatz => 'pointsAtZ',
270      preservealpha => 'preserveAlpha',
271      preserveaspectratio => 'preserveAspectRatio',
272      primitiveunits => 'primitiveUnits',
273      refx => 'refX',
274      refy => 'refY',
275      repeatcount => 'repeatCount',
276      repeatdur => 'repeatDur',
277      requiredextensions => 'requiredExtensions',
278      requiredfeatures => 'requiredFeatures',
279      specularconstant => 'specularConstant',
280      specularexponent => 'specularExponent',
281      spreadmethod => 'spreadMethod',
282      startoffset => 'startOffset',
283      stddeviation => 'stdDeviation',
284      stitchtiles => 'stitchTiles',
285      surfacescale => 'surfaceScale',
286      systemlanguage => 'systemLanguage',
287      tablevalues => 'tableValues',
288      targetx => 'targetX',
289      targety => 'targetY',
290      textlength => 'textLength',
291      viewbox => 'viewBox',
292      viewtarget => 'viewTarget',
293      xchannelselector => 'xChannelSelector',
294      ychannelselector => 'yChannelSelector',
295      zoomandpan => 'zoomAndPan',
296    };
297    
298    my $foreign_attr_xname = {
299      'xlink:actuate' => [$XLINK_NS, ['xlink', 'actuate']],
300      'xlink:arcrole' => [$XLINK_NS, ['xlink', 'arcrole']],
301      'xlink:href' => [$XLINK_NS, ['xlink', 'href']],
302      'xlink:role' => [$XLINK_NS, ['xlink', 'role']],
303      'xlink:show' => [$XLINK_NS, ['xlink', 'show']],
304      'xlink:title' => [$XLINK_NS, ['xlink', 'title']],
305      'xlink:type' => [$XLINK_NS, ['xlink', 'type']],
306      'xml:base' => [$XML_NS, ['xml', 'base']],
307      'xml:lang' => [$XML_NS, ['xml', 'lang']],
308      'xml:space' => [$XML_NS, ['xml', 'space']],
309      'xmlns' => [$XMLNS_NS, [undef, 'xmlns']],
310      'xmlns:xlink' => [$XMLNS_NS, ['xmlns', 'xlink']],
311    };
312    
313    ## ISSUE: xmlns:xlink="non-xlink-ns" is not an error.
314    
315  my $c1_entity_char = {  my $c1_entity_char = {
316    0x80 => 0x20AC,    0x80 => 0x20AC,
317    0x81 => 0xFFFD,    0x81 => 0xFFFD,
# Line 248  my $c1_entity_char = { Line 348  my $c1_entity_char = {
348  }; # $c1_entity_char  }; # $c1_entity_char
349    
350  sub parse_byte_string ($$$$;$) {  sub parse_byte_string ($$$$;$) {
351      my $self = shift;
352      my $charset_name = shift;
353      open my $input, '<', ref $_[0] ? $_[0] : \($_[0]);
354      return $self->parse_byte_stream ($charset_name, $input, @_[1..$#_]);
355    } # parse_byte_string
356    
357    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 = shift;    my $charset_name = shift;
361    my $bytes_s = ref $_[0] ? $_[0] : \($_[0]);    my $byte_stream = $_[0];
362    my $s;  
363        my $onerror = $_[2] || sub {
364    if (defined $charset) {      my (%opt) = @_;
365      require Encode; ## TODO: decode(utf8) don't delete BOM      warn "Parse error ($opt{type})\n";
366      $s = \ (Encode::decode ($charset, $$bytes_s));    };
367      $self->{input_encoding} = lc $charset; ## TODO: normalize name    $self->{parse_error} = $onerror; # updated later by parse_char_string
368      $self->{confident} = 1;  
369    } else {    my $get_wrapper = $_[3] || sub ($) {
370      ## TODO: Implement HTML5 detection algorithm      return $_[0]; # $_[0] = byte stream handle, returned = arg to char handle
371      };
372    
373      ## HTML5 encoding sniffing algorithm
374      require Message::Charset::Info;
375      my $charset;
376      my $buffer;
377      my ($char_stream, $e_status);
378    
379      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
388        if (defined $charset_name) {
389          $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.
394          ($char_stream, $e_status) = $charset->get_decode_handle
395              ($byte_stream, allow_error_reporting => 1,
396               allow_fallback => 1);
397          if ($char_stream) {
398            $self->{confident} = 1;
399            last SNIFFING;
400          } else {
401            ## TODO: unsupported error
402          }
403        }
404    
405        ## Step 2
406        my $byte_buffer = '';
407        for (1..1024) {
408          my $char = $byte_stream->getc;
409          last unless defined $char;
410          $byte_buffer .= $char;
411        } ## TODO: timeout
412    
413        ## Step 3
414        if ($byte_buffer =~ /^\xFE\xFF/) {
415          $charset = Message::Charset::Info->get_by_html_name ('utf-16be');
416          ($char_stream, $e_status) = $charset->get_decode_handle
417              ($byte_stream, allow_error_reporting => 1,
418               allow_fallback => 1, byte_buffer => \$byte_buffer);
419          $self->{confident} = 1;
420          last SNIFFING;
421        } elsif ($byte_buffer =~ /^\xFF\xFE/) {
422          $charset = Message::Charset::Info->get_by_html_name ('utf-16le');
423          ($char_stream, $e_status) = $charset->get_decode_handle
424              ($byte_stream, allow_error_reporting => 1,
425               allow_fallback => 1, byte_buffer => \$byte_buffer);
426          $self->{confident} = 1;
427          last SNIFFING;
428        } elsif ($byte_buffer =~ /^\xEF\xBB\xBF/) {
429          $charset = Message::Charset::Info->get_by_html_name ('utf-8');
430          ($char_stream, $e_status) = $charset->get_decode_handle
431              ($byte_stream, allow_error_reporting => 1,
432               allow_fallback => 1, byte_buffer => \$byte_buffer);
433          $self->{confident} = 1;
434          last SNIFFING;
435        }
436    
437        ## Step 4
438        ## TODO: <meta charset>
439    
440        ## Step 5
441        ## TODO: from history
442    
443        ## Step 6
444      require Whatpm::Charset::UniversalCharDet;      require Whatpm::Charset::UniversalCharDet;
445      $charset = Whatpm::Charset::UniversalCharDet->detect_byte_string      $charset_name = Whatpm::Charset::UniversalCharDet->detect_byte_string
446          (substr ($$bytes_s, 0, 1024));          ($byte_buffer);
447      $charset ||= 'windows-1252';      if (defined $charset_name) {
448      $s = \ (Encode::decode ($charset, $$bytes_s));        $charset = Message::Charset::Info->get_by_html_name ($charset_name);
449      $self->{input_encoding} = $charset;  
450          ## ISSUE: Unsupported encoding is not ignored according to the spec.
451          require Whatpm::Charset::DecodeHandle;
452          $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new
453              ($byte_stream);
454          ($char_stream, $e_status) = $charset->get_decode_handle
455              ($buffer, allow_error_reporting => 1,
456               allow_fallback => 1, byte_buffer => \$byte_buffer);
457          if ($char_stream) {
458            $buffer->{buffer} = $byte_buffer;
459            !!!parse-error (type => 'sniffing:chardet',
460                            text => $charset_name,
461                            level => $self->{level}->{info},
462                            layer => 'encode',
463                            line => 1, column => 1);
464            $self->{confident} = 0;
465            last SNIFFING;
466          }
467        }
468    
469        ## Step 7: default
470        ## TODO: Make this configurable.
471        $charset = Message::Charset::Info->get_by_html_name ('windows-1252');
472            ## NOTE: We choose |windows-1252| here, since |utf-8| should be
473            ## detectable in the step 6.
474        require Whatpm::Charset::DecodeHandle;
475        $buffer = Whatpm::Charset::DecodeHandle::ByteBuffer->new
476            ($byte_stream);
477        ($char_stream, $e_status)
478            = $charset->get_decode_handle ($buffer,
479                                           allow_error_reporting => 1,
480                                           allow_fallback => 1,
481                                           byte_buffer => \$byte_buffer);
482        $buffer->{buffer} = $byte_buffer;
483        !!!parse-error (type => 'sniffing:default',
484                        text => 'windows-1252',
485                        level => $self->{level}->{info},
486                        line => 1, column => 1,
487                        layer => 'encode');
488      $self->{confident} = 0;      $self->{confident} = 0;
489      } # SNIFFING
490    
491      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
492        $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
493        !!!parse-error (type => 'chardecode:fallback',
494                        #text => $self->{input_encoding},
495                        level => $self->{level}->{uncertain},
496                        line => 1, column => 1,
497                        layer => 'encode');
498      } elsif (not ($e_status &
499                    Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
500        $self->{input_encoding} = $charset->get_iana_name;
501        !!!parse-error (type => 'chardecode:no error',
502                        text => $self->{input_encoding},
503                        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 {
511      my $self = shift;      my $self = shift;
512      my $charset = lc shift;      $charset_name = shift;
513      my $token = shift;      my $token = shift;
     ## TODO: if $charset is supported  
     ## TODO: normalize charset name  
514    
515      ## "Change the encoding" algorithm:      $charset = Message::Charset::Info->get_by_html_name ($charset_name);
516        ($char_stream, $e_status) = $charset->get_decode_handle
517            ($byte_stream, allow_error_reporting => 1, allow_fallback => 1,
518             byte_buffer => \ $buffer->{buffer});
519        
520        if ($char_stream) { # if supported
521          ## "Change the encoding" algorithm:
522    
523      ## Step 1            ## Step 1    
524      if ($charset eq 'utf-16') { ## ISSUE: UTF-16BE -> UTF-8? UTF-16LE -> UTF-8?        if ($charset->{category} &
525        $charset = '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
528                ($byte_stream,
529                 byte_buffer => \ $buffer->{buffer});
530          }
531          $charset_name = $charset->get_iana_name;
532          
533          ## Step 2
534          if (defined $self->{input_encoding} and
535              $self->{input_encoding} eq $charset_name) {
536            !!!parse-error (type => 'charset label:matching',
537                            text => $charset_name,
538                            level => $self->{level}->{info});
539            $self->{confident} = 1;
540            return;
541          }
542    
543      ## Step 2        !!!parse-error (type => 'charset label detected',
544      if (defined $self->{input_encoding} and                        text => $self->{input_encoding},
545          $self->{input_encoding} eq $charset) {                        value => $charset_name,
546        $self->{confident} = 1;                        level => $self->{level}->{warn},
547        return;                        token => $token);
548          
549          ## Step 3
550          # if (can) {
551            ## change the encoding on the fly.
552            #$self->{confident} = 1;
553            #return;
554          # }
555          
556          ## Step 4
557          throw Whatpm::HTML::RestartParser ();
558      }      }
559      }; # $self->{change_encoding}
560    
561      !!!parse-error (type => 'charset label detected:'.$self->{input_encoding}.    my $char_onerror = sub {
562          ':'.$charset, level => 'w', token => $token);      my (undef, $type, %opt) = @_;
563        !!!parse-error (layer => 'encode',
564      ## Step 3                      %opt, type => $type,
565      # if (can) {                      line => $self->{line}, column => $self->{column} + 1);
566        ## change the encoding on the fly.      if ($opt{octets}) {
567        #$self->{confident} = 1;        ${$opt{octets}} = "\x{FFFD}"; # relacement character
568        #return;      }
569      # }    };
570    
571      ## Step 4    my $wrapped_char_stream = $get_wrapper->($char_stream);
572      throw Whatpm::HTML::RestartParser (charset => $charset);    $wrapped_char_stream->onerror ($char_onerror);
   }; # $self->{change_encoding}  
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_string ($s, @args);        $return = $self->parse_char_stream ($wrapped_char_stream, @args);  
578    } catch Whatpm::HTML::RestartParser with {    } catch Whatpm::HTML::RestartParser with {
579      my $charset = shift->{charset};      ## NOTE: Invoked after {change_encoding}.
580      $s = \ (Encode::decode ($charset, $$bytes_s));      
581      $self->{input_encoding} = $charset; ## TODO: normalize      if ($e_status & Message::Charset::Info::FALLBACK_ENCODING_IMPL ()) {
582          $self->{input_encoding} = $charset->get_iana_name; ## TODO: Should we set actual charset decoder's encoding name?
583          !!!parse-error (type => 'chardecode:fallback',
584                          level => $self->{level}->{uncertain},
585                          #text => $self->{input_encoding},
586                          line => 1, column => 1,
587                          layer => 'encode');
588        } elsif (not ($e_status &
589                      Message::Charset::Info::ERROR_REPORTING_ENCODING_IMPL())) {
590          $self->{input_encoding} = $charset->get_iana_name;
591          !!!parse-error (type => 'chardecode:no error',
592                          text => $self->{input_encoding},
593                          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      $return = $self->parse_char_string ($s, @args);  
601        $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_string  } # parse_byte_stream
608    
609  ## NOTE: HTML5 spec says that the encoding layer MUST NOT strip BOM  ## NOTE: HTML5 spec says that the encoding layer MUST NOT strip BOM
610  ## and the HTML layer MUST ignore it.  However, we does strip BOM in  ## and the HTML layer MUST ignore it.  However, we does strip BOM in
# Line 327  sub parse_byte_string ($$$$;$) { Line 615  sub parse_byte_string ($$$$;$) {
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  *parse_char_string = \&parse_string;  sub parse_char_string ($$$;$$) {
619      #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620      my $self = shift;
621      my $s = ref $_[0] ? $_[0] : \($_[0]);
622      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..$#_]);
628    } # parse_char_string
629    *parse_string = \&parse_char_string; ## NOTE: Alias for backward compatibility.
630    
631  sub parse_string ($$$;$) {  sub parse_char_stream ($$$;$) {
632    my $self = ref $_[0] ? shift : shift->new;    my $self = ref $_[0] ? shift : shift->new;
633    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $input = $_[0];
634    $self->{document} = $_[1];    $self->{document} = $_[1];
635    @{$self->{document}->child_nodes} = ();    @{$self->{document}->child_nodes} = ();
636    
# Line 350  sub parse_string ($$$;$) { Line 649  sub parse_string ($$$;$) {
649      pop @{$self->{prev_char}};      pop @{$self->{prev_char}};
650      unshift @{$self->{prev_char}}, $self->{next_char};      unshift @{$self->{prev_char}}, $self->{next_char};
651    
652      $self->{next_char} = -1 and return if $i >= length $$s;      my $char;
653      $self->{next_char} = ord substr $$s, $i++, 1;      if (defined $self->{next_next_char}) {
654          $char = $self->{next_next_char};
655          delete $self->{next_next_char};
656        } else {
657          $char = $input->getc;
658        }
659        $self->{next_char} = -1 and return unless defined $char;
660        $self->{next_char} = ord $char;
661    
662      ($self->{line_prev}, $self->{column_prev})      ($self->{line_prev}, $self->{column_prev})
663          = ($self->{line}, $self->{column});          = ($self->{line}, $self->{column});
664      $self->{column}++;      $self->{column}++;
665            
666      if ($self->{next_char} == 0x000A) { # LF      if ($self->{next_char} == 0x000A) { # LF
667          !!!cp ('j1');
668        $self->{line}++;        $self->{line}++;
669        $self->{column} = 0;        $self->{column} = 0;
670      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
671        $i++ if substr ($$s, $i, 1) eq "\x0A";        !!!cp ('j2');
672    ## TODO: support for abort/streaming
673          my $next = $input->getc;
674          if (defined $next and $next ne "\x0A") {
675            $self->{next_next_char} = $next;
676          }
677        $self->{next_char} = 0x000A; # LF # MUST        $self->{next_char} = 0x000A; # LF # MUST
678        $self->{line}++;        $self->{line}++;
679        $self->{column} = 0;        $self->{column} = 0;
680      } elsif ($self->{next_char} > 0x10FFFF) {      } elsif ($self->{next_char} > 0x10FFFF) {
681          !!!cp ('j3');
682        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
683      } elsif ($self->{next_char} == 0x0000) { # NULL      } elsif ($self->{next_char} == 0x0000) { # NULL
684          !!!cp ('j4');
685        !!!parse-error (type => 'NULL');        !!!parse-error (type => 'NULL');
686        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
687        } elsif ($self->{next_char} <= 0x0008 or
688                 (0x000E <= $self->{next_char} and $self->{next_char} <= 0x001F) or
689                 (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
690                 (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
691                 (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,
695                  0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
696                  0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,
697                  0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,
698                  0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,
699                  0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,
700                  0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,
701                  0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,
702                  0x10FFFE => 1, 0x10FFFF => 1,
703                 }->{$self->{next_char}}) {
704          !!!cp ('j5');
705          if ($self->{next_char} < 0x10000) {
706            !!!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->{getc_until} = sub { return undef };
718    #  if ($input->can ('manakai_getc_until')) {
719        $self->{getc_until} = sub {
720          my $special_range = shift;
721          return undef if defined $self->{next_next_char};
722          my $s = $input->manakai_getc_until
723              (qr/(?![$special_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          if ($s) {
725            $self->{column} += length $$s;
726            $self->{column_prev} += length $$s;
727            $self->{prev_char} = [-1, -1, -1];
728            $self->{next_char} = -1;
729          }
730          return $s;
731        }; # $self->{getc_until}
732    #  } else {
733    #    $self->{getc_until} = sub {
734    #      my $special_range = shift;
735    #      return undef if defined $self->{next_next_char};
736    #      my $c = $input->getc;
737    #      if ($c =~ /^(?![$special_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}]/) {
738    #        $self->{column}++;
739    #        $self->{column_prev}++;
740    #        $self->{prev_char} = [-1, -1, -1];
741    #        $self->{next_char} = -1;
742    #        return \$c;
743    #      } elsif (defined $c) {
744    #        #$input->ungetc (ord $c);
745    #        $self->{next_next_char} = $c;
746    #        return undef;
747    #      } else {
748    #        return undef;
749    #      }
750    #    }; # $self->{getc_until}
751    #  }
752    
753    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
754      my (%opt) = @_;      my (%opt) = @_;
755      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 393  sub parse_string ($$$;$) { Line 768  sub parse_string ($$$;$) {
768    delete $self->{parse_error}; # remove loop    delete $self->{parse_error}; # remove loop
769    
770    return $self->{document};    return $self->{document};
771  } # parse_string  } # parse_char_stream
772    
773  sub new ($) {  sub new ($) {
774    my $class = shift;    my $class = shift;
775    my $self = bless {}, $class;    my $self = bless {
776        level => {must => 'm',
777                  should => 's',
778                  warn => 'w',
779                  info => 'i',
780                  uncertain => 'u'},
781      }, $class;
782    $self->{set_next_char} = sub {    $self->{set_next_char} = sub {
783      $self->{next_char} = -1;      $self->{next_char} = -1;
784    };    };
# Line 426  sub RCDATA_CONTENT_MODEL () { CM_ENTITY Line 807  sub RCDATA_CONTENT_MODEL () { CM_ENTITY
807  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }  sub PCDATA_CONTENT_MODEL () { CM_ENTITY | CM_FULL_MARKUP }
808    
809  sub DATA_STATE () { 0 }  sub DATA_STATE () { 0 }
810  sub ENTITY_DATA_STATE () { 1 }  #sub ENTITY_DATA_STATE () { 1 }
811  sub TAG_OPEN_STATE () { 2 }  sub TAG_OPEN_STATE () { 2 }
812  sub CLOSE_TAG_OPEN_STATE () { 3 }  sub CLOSE_TAG_OPEN_STATE () { 3 }
813  sub TAG_NAME_STATE () { 4 }  sub TAG_NAME_STATE () { 4 }
# Line 437  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8 Line 818  sub BEFORE_ATTRIBUTE_VALUE_STATE () { 8
818  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }  sub ATTRIBUTE_VALUE_DOUBLE_QUOTED_STATE () { 9 }
819  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }  sub ATTRIBUTE_VALUE_SINGLE_QUOTED_STATE () { 10 }
820  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }  sub ATTRIBUTE_VALUE_UNQUOTED_STATE () { 11 }
821  sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }  #sub ENTITY_IN_ATTRIBUTE_VALUE_STATE () { 12 }
822  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }  sub MARKUP_DECLARATION_OPEN_STATE () { 13 }
823  sub COMMENT_START_STATE () { 14 }  sub COMMENT_START_STATE () { 14 }
824  sub COMMENT_START_DASH_STATE () { 15 }  sub COMMENT_START_DASH_STATE () { 15 }
# Line 460  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT Line 841  sub AFTER_DOCTYPE_SYSTEM_IDENTIFIER_STAT
841  sub BOGUS_DOCTYPE_STATE () { 32 }  sub BOGUS_DOCTYPE_STATE () { 32 }
842  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }  sub AFTER_ATTRIBUTE_VALUE_QUOTED_STATE () { 33 }
843  sub SELF_CLOSING_START_TAG_STATE () { 34 }  sub SELF_CLOSING_START_TAG_STATE () { 34 }
844  sub CDATA_BLOCK_STATE () { 35 }  sub CDATA_SECTION_STATE () { 35 }
845    sub MD_HYPHEN_STATE () { 36 } # "markup declaration open state" in the spec
846    sub MD_DOCTYPE_STATE () { 37 } # "markup declaration open state" in the spec
847    sub MD_CDATA_STATE () { 38 } # "markup declaration open state" in the spec
848    sub CDATA_PCDATA_CLOSE_TAG_STATE () { 39 } # "close tag open state" in the spec
849    sub CDATA_SECTION_MSE1_STATE () { 40 } # "CDATA section state" in the spec
850    sub CDATA_SECTION_MSE2_STATE () { 41 } # "CDATA section state" in the spec
851    sub PUBLIC_STATE () { 42 } # "after DOCTYPE name state" in the spec
852    sub SYSTEM_STATE () { 43 } # "after DOCTYPE name state" in the spec
853    ## NOTE: "Entity data state", "entity in attribute value state", and
854    ## "consume a character reference" algorithm are jointly implemented
855    ## using the following six states:
856    sub ENTITY_STATE () { 44 }
857    sub ENTITY_HASH_STATE () { 45 }
858    sub NCR_NUM_STATE () { 46 }
859    sub HEXREF_X_STATE () { 47 }
860    sub HEXREF_HEX_STATE () { 48 }
861    sub ENTITY_NAME_STATE () { 49 }
862    
863  sub DOCTYPE_TOKEN () { 1 }  sub DOCTYPE_TOKEN () { 1 }
864  sub COMMENT_TOKEN () { 2 }  sub COMMENT_TOKEN () { 2 }
# Line 513  sub IN_COLUMN_GROUP_IM () { 0b10 } Line 911  sub IN_COLUMN_GROUP_IM () { 0b10 }
911  sub _initialize_tokenizer ($) {  sub _initialize_tokenizer ($) {
912    my $self = shift;    my $self = shift;
913    $self->{state} = DATA_STATE; # MUST    $self->{state} = DATA_STATE; # MUST
914      #$self->{state_keyword}; # initialized when used
915      #$self->{entity__value}; # initialized when used
916      #$self->{entity__match}; # initialized when used
917    $self->{content_model} = PCDATA_CONTENT_MODEL; # be    $self->{content_model} = PCDATA_CONTENT_MODEL; # be
918    undef $self->{current_token}; # start tag, end tag, comment, or DOCTYPE    undef $self->{current_token};
919    undef $self->{current_attribute};    undef $self->{current_attribute};
920    undef $self->{last_emitted_start_tag_name};    undef $self->{last_emitted_start_tag_name};
921    undef $self->{last_attribute_value_state};    #$self->{prev_state}; # initialized when used
922    delete $self->{self_closing};    delete $self->{self_closing};
   $self->{char} = [];  
923    # $self->{next_char}    # $self->{next_char}
924    !!!next-input-character;    !!!next-input-character;
925    $self->{token} = [];    $self->{token} = [];
# Line 543  sub _initialize_tokenizer ($) { Line 943  sub _initialize_tokenizer ($) {
943  ##     |->{self_closing}| is used to save the value of |$self->{self_closing}|  ##     |->{self_closing}| is used to save the value of |$self->{self_closing}|
944  ##     while the token is pushed back to the stack.  ##     while the token is pushed back to the stack.
945    
 ## 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?  
   
946  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
947    
948  ## 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 555  sub _initialize_tokenizer ($) { Line 951  sub _initialize_tokenizer ($) {
951  ## has completed loading.  If one has, then it MUST be executed  ## has completed loading.  If one has, then it MUST be executed
952  ## and removed from the list.  ## and removed from the list.
953    
954  ## NOTE: HTML5 "Writing HTML documents" section, applied to  ## TODO: Polytheistic slash SHOULD NOT be used. (Applied only to atheists.)
955  ## 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,  
956    
957  sub _get_next_token ($) {  sub _get_next_token ($) {
958    my $self = shift;    my $self = shift;
# Line 592  sub _get_next_token ($) { Line 976  sub _get_next_token ($) {
976          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA          if ($self->{content_model} & CM_ENTITY and # PCDATA | RCDATA
977              not $self->{escape}) {              not $self->{escape}) {
978            !!!cp (1);            !!!cp (1);
979            $self->{state} = ENTITY_DATA_STATE;            ## NOTE: In the spec, the tokenizer is switched to the
980              ## "entity data state".  In this implementation, the tokenizer
981              ## is switched to the |ENTITY_STATE|, which is an implementation
982              ## of the "consume a character reference" algorithm.
983              $self->{entity_additional} = -1;
984              $self->{prev_state} = DATA_STATE;
985              $self->{state} = ENTITY_STATE;
986            !!!next-input-character;            !!!next-input-character;
987            redo A;            redo A;
988          } else {          } else {
# Line 656  sub _get_next_token ($) { Line 1046  sub _get_next_token ($) {
1046                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1047                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1048                    };                    };
1049    
1050          my $s = $self->{getc_until}->(q[-!<>&]);
1051          if ($s) {
1052            $token->{data} .= $$s;
1053          }
1054    
1055        ## Stay in the data state        ## Stay in the data state
1056        !!!next-input-character;        !!!next-input-character;
1057    
1058        !!!emit ($token);        !!!emit ($token);
1059    
1060        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;  
1061      } elsif ($self->{state} == TAG_OPEN_STATE) {      } elsif ($self->{state} == TAG_OPEN_STATE) {
1062        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1063          if ($self->{next_char} == 0x002F) { # /          if ($self->{next_char} == 0x002F) { # /
# Line 762  sub _get_next_token ($) { Line 1137  sub _get_next_token ($) {
1137            redo A;            redo A;
1138          } else {          } else {
1139            !!!cp (23);            !!!cp (23);
1140            !!!parse-error (type => 'bare stago');            !!!parse-error (type => 'bare stago',
1141                              line => $self->{line_prev},
1142                              column => $self->{column_prev});
1143            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1144            ## reconsume            ## reconsume
1145    
# Line 777  sub _get_next_token ($) { Line 1154  sub _get_next_token ($) {
1154          die "$0: $self->{content_model} in tag open";          die "$0: $self->{content_model} in tag open";
1155        }        }
1156      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {      } elsif ($self->{state} == CLOSE_TAG_OPEN_STATE) {
1157          ## NOTE: The "close tag open state" in the spec is implemented as
1158          ## |CLOSE_TAG_OPEN_STATE| and |CDATA_PCDATA_CLOSE_TAG_STATE|.
1159    
1160        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"        my ($l, $c) = ($self->{line_prev}, $self->{column_prev} - 1); # "<"of"</"
1161        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA        if ($self->{content_model} & CM_LIMITED_MARKUP) { # RCDATA | CDATA
1162          if (defined $self->{last_emitted_start_tag_name}) {          if (defined $self->{last_emitted_start_tag_name}) {
1163              $self->{state} = CDATA_PCDATA_CLOSE_TAG_STATE;
1164            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>            $self->{state_keyword} = '';
1165            my @next_char;            ## Reconsume.
1166            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...  
           }  
1167          } else {          } else {
1168            ## No start tag token has ever been emitted            ## No start tag token has ever been emitted
1169              ## NOTE: See <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>.
1170            !!!cp (28);            !!!cp (28);
           # next-input-character is already done  
1171            $self->{state} = DATA_STATE;            $self->{state} = DATA_STATE;
1172              ## Reconsume.
1173            !!!emit ({type => CHARACTER_TOKEN, data => '</',            !!!emit ({type => CHARACTER_TOKEN, data => '</',
1174                      line => $l, column => $c,                      line => $l, column => $c,
1175                     });                     });
1176            redo A;            redo A;
1177          }          }
1178        }        }
1179          
1180        if (0x0041 <= $self->{next_char} and        if (0x0041 <= $self->{next_char} and
1181            $self->{next_char} <= 0x005A) { # A..Z            $self->{next_char} <= 0x005A) { # A..Z
1182          !!!cp (29);          !!!cp (29);
# Line 886  sub _get_next_token ($) { Line 1223  sub _get_next_token ($) {
1223                                    line => $self->{line_prev}, # "<" of "</"                                    line => $self->{line_prev}, # "<" of "</"
1224                                    column => $self->{column_prev} - 1,                                    column => $self->{column_prev} - 1,
1225                                   };                                   };
1226          ## $self->{next_char} is intentionally left as is          ## NOTE: $self->{next_char} is intentionally left as is.
1227          redo A;          ## Although the "anything else" case of the spec not explicitly
1228            ## states that the next input character is to be reconsumed,
1229            ## it will be included to the |data| of the comment token
1230            ## generated from the bogus end tag, as defined in the
1231            ## "bogus comment state" entry.
1232            redo A;
1233          }
1234        } elsif ($self->{state} == CDATA_PCDATA_CLOSE_TAG_STATE) {
1235          my $ch = substr $self->{last_emitted_start_tag_name}, length $self->{state_keyword}, 1;
1236          if (length $ch) {
1237            my $CH = $ch;
1238            $ch =~ tr/a-z/A-Z/;
1239            my $nch = chr $self->{next_char};
1240            if ($nch eq $ch or $nch eq $CH) {
1241              !!!cp (24);
1242              ## Stay in the state.
1243              $self->{state_keyword} .= $nch;
1244              !!!next-input-character;
1245              redo A;
1246            } else {
1247              !!!cp (25);
1248              $self->{state} = DATA_STATE;
1249              ## Reconsume.
1250              !!!emit ({type => CHARACTER_TOKEN,
1251                        data => '</' . $self->{state_keyword},
1252                        line => $self->{line_prev},
1253                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1254                       });
1255              redo A;
1256            }
1257          } else { # after "<{tag-name}"
1258            unless ({
1259                     0x0009 => 1, # HT
1260                     0x000A => 1, # LF
1261                     0x000B => 1, # VT
1262                     0x000C => 1, # FF
1263                     0x0020 => 1, # SP
1264                     0x003E => 1, # >
1265                     0x002F => 1, # /
1266                     -1 => 1, # EOF
1267                    }->{$self->{next_char}}) {
1268              !!!cp (26);
1269              ## Reconsume.
1270              $self->{state} = DATA_STATE;
1271              !!!emit ({type => CHARACTER_TOKEN,
1272                        data => '</' . $self->{state_keyword},
1273                        line => $self->{line_prev},
1274                        column => $self->{column_prev} - 1 - length $self->{state_keyword},
1275                       });
1276              redo A;
1277            } else {
1278              !!!cp (27);
1279              $self->{current_token}
1280                  = {type => END_TAG_TOKEN,
1281                     tag_name => $self->{last_emitted_start_tag_name},
1282                     line => $self->{line_prev},
1283                     column => $self->{column_prev} - 1 - length $self->{state_keyword}};
1284              $self->{state} = TAG_NAME_STATE;
1285              ## Reconsume.
1286              redo A;
1287            }
1288        }        }
1289      } elsif ($self->{state} == TAG_NAME_STATE) {      } elsif ($self->{state} == TAG_NAME_STATE) {
1290        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
# Line 1057  sub _get_next_token ($) { Line 1454  sub _get_next_token ($) {
1454          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
1455              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
1456            !!!cp (57);            !!!cp (57);
1457            !!!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});
1458            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
1459          } else {          } else {
1460            !!!cp (58);            !!!cp (58);
# Line 1228  sub _get_next_token ($) { Line 1625  sub _get_next_token ($) {
1625    
1626          redo A;          redo A;
1627        } else {        } else {
1628          !!!cp (82);          if ($self->{next_char} == 0x0022 or # "
1629                $self->{next_char} == 0x0027) { # '
1630              !!!cp (78);
1631              !!!parse-error (type => 'bad attribute name');
1632            } else {
1633              !!!cp (82);
1634            }
1635          $self->{current_attribute}          $self->{current_attribute}
1636              = {name => chr ($self->{next_char}),              = {name => chr ($self->{next_char}),
1637                 value => '',                 value => '',
# Line 1263  sub _get_next_token ($) { Line 1666  sub _get_next_token ($) {
1666          !!!next-input-character;          !!!next-input-character;
1667          redo A;          redo A;
1668        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
1669            !!!parse-error (type => 'empty unquoted attribute value');
1670          if ($self->{current_token}->{type} == START_TAG_TOKEN) {          if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1671            !!!cp (87);            !!!cp (87);
1672            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
# Line 1327  sub _get_next_token ($) { Line 1731  sub _get_next_token ($) {
1731          redo A;          redo A;
1732        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1733          !!!cp (96);          !!!cp (96);
1734          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1735          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1736            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1737            ## implementation of the "consume a character reference" algorithm.
1738            $self->{prev_state} = $self->{state};
1739            $self->{entity_additional} = 0x0022; # "
1740            $self->{state} = ENTITY_STATE;
1741          !!!next-input-character;          !!!next-input-character;
1742          redo A;          redo A;
1743        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1369  sub _get_next_token ($) { Line 1778  sub _get_next_token ($) {
1778          redo A;          redo A;
1779        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1780          !!!cp (102);          !!!cp (102);
1781          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1782          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1783            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1784            ## implementation of the "consume a character reference" algorithm.
1785            $self->{entity_additional} = 0x0027; # '
1786            $self->{prev_state} = $self->{state};
1787            $self->{state} = ENTITY_STATE;
1788          !!!next-input-character;          !!!next-input-character;
1789          redo A;          redo A;
1790        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
# Line 1415  sub _get_next_token ($) { Line 1829  sub _get_next_token ($) {
1829          redo A;          redo A;
1830        } elsif ($self->{next_char} == 0x0026) { # &        } elsif ($self->{next_char} == 0x0026) { # &
1831          !!!cp (108);          !!!cp (108);
1832          $self->{last_attribute_value_state} = $self->{state};          ## NOTE: In the spec, the tokenizer is switched to the
1833          $self->{state} = ENTITY_IN_ATTRIBUTE_VALUE_STATE;          ## "entity in attribute value state".  In this implementation, the
1834            ## tokenizer is switched to the |ENTITY_STATE|, which is an
1835            ## implementation of the "consume a character reference" algorithm.
1836            $self->{entity_additional} = -1;
1837            $self->{prev_state} = $self->{state};
1838            $self->{state} = ENTITY_STATE;
1839          !!!next-input-character;          !!!next-input-character;
1840          redo A;          redo A;
1841        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
# Line 1480  sub _get_next_token ($) { Line 1899  sub _get_next_token ($) {
1899          !!!next-input-character;          !!!next-input-character;
1900          redo A;          redo A;
1901        }        }
     } 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;  
1902      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {      } elsif ($self->{state} == AFTER_ATTRIBUTE_VALUE_QUOTED_STATE) {
1903        if ($self->{next_char} == 0x0009 or # HT        if ($self->{next_char} == 0x0009 or # HT
1904            $self->{next_char} == 0x000A or # LF            $self->{next_char} == 0x000A or # LF
# Line 1539  sub _get_next_token ($) { Line 1936  sub _get_next_token ($) {
1936          $self->{state} = SELF_CLOSING_START_TAG_STATE;          $self->{state} = SELF_CLOSING_START_TAG_STATE;
1937          !!!next-input-character;          !!!next-input-character;
1938          redo A;          redo A;
1939          } elsif ($self->{next_char} == -1) {
1940            !!!parse-error (type => 'unclosed tag');
1941            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1942              !!!cp (122.3);
1943              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1944            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1945              if ($self->{current_token}->{attributes}) {
1946                !!!cp (122.1);
1947                !!!parse-error (type => 'end tag attribute');
1948              } else {
1949                ## NOTE: This state should never be reached.
1950                !!!cp (122.2);
1951              }
1952            } else {
1953              die "$0: $self->{current_token}->{type}: Unknown token type";
1954            }
1955            $self->{state} = DATA_STATE;
1956            ## Reconsume.
1957            !!!emit ($self->{current_token}); # start tag or end tag
1958            redo A;
1959        } else {        } else {
1960          !!!cp ('124.1');          !!!cp ('124.1');
1961          !!!parse-error (type => 'no space between attributes');          !!!parse-error (type => 'no space between attributes');
# Line 1571  sub _get_next_token ($) { Line 1988  sub _get_next_token ($) {
1988          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
1989    
1990          redo A;          redo A;
1991          } elsif ($self->{next_char} == -1) {
1992            !!!parse-error (type => 'unclosed tag');
1993            if ($self->{current_token}->{type} == START_TAG_TOKEN) {
1994              !!!cp (124.7);
1995              $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
1996            } elsif ($self->{current_token}->{type} == END_TAG_TOKEN) {
1997              if ($self->{current_token}->{attributes}) {
1998                !!!cp (124.5);
1999                !!!parse-error (type => 'end tag attribute');
2000              } else {
2001                ## NOTE: This state should never be reached.
2002                !!!cp (124.6);
2003              }
2004            } else {
2005              die "$0: $self->{current_token}->{type}: Unknown token type";
2006            }
2007            $self->{state} = DATA_STATE;
2008            ## Reconsume.
2009            !!!emit ($self->{current_token}); # start tag or end tag
2010            redo A;
2011        } else {        } else {
2012          !!!cp ('124.4');          !!!cp ('124.4');
2013          !!!parse-error (type => 'nestc');          !!!parse-error (type => 'nestc');
# Line 1581  sub _get_next_token ($) { Line 2018  sub _get_next_token ($) {
2018        }        }
2019      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {      } elsif ($self->{state} == BOGUS_COMMENT_STATE) {
2020        ## (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  
   
           redo A;  
         } elsif ($self->{next_char} == -1) {  
           !!!cp (125);  
           $self->{state} = DATA_STATE;  
           ## reconsume  
2021    
2022            !!!emit ($self->{current_token}); # comment        ## NOTE: Unlike spec's "bogus comment state", this implementation
2023          ## consumes characters one-by-one basis.
2024          
2025          if ($self->{next_char} == 0x003E) { # >
2026            !!!cp (124);
2027            $self->{state} = DATA_STATE;
2028            !!!next-input-character;
2029    
2030            redo A;          !!!emit ($self->{current_token}); # comment
2031          } else {          redo A;
2032            !!!cp (126);        } elsif ($self->{next_char} == -1) {
2033            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          !!!cp (125);
2034            !!!next-input-character;          $self->{state} = DATA_STATE;
2035            redo BC;          ## reconsume
         }  
       } # BC  
2036    
2037        die "$0: _get_next_token: unexpected case [BC]";          !!!emit ($self->{current_token}); # comment
2038            redo A;
2039          } else {
2040            !!!cp (126);
2041            $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2042            ## Stay in the state.
2043            !!!next-input-character;
2044            redo A;
2045          }
2046      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {      } elsif ($self->{state} == MARKUP_DECLARATION_OPEN_STATE) {
2047        ## (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};  
2048                
2049        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2050            !!!cp (133);
2051            $self->{state} = MD_HYPHEN_STATE;
2052          !!!next-input-character;          !!!next-input-character;
2053          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);  
         }  
2054        } elsif ($self->{next_char} == 0x0044 or # D        } elsif ($self->{next_char} == 0x0044 or # D
2055                 $self->{next_char} == 0x0064) { # d                 $self->{next_char} == 0x0064) { # d
2056            ## ASCII case-insensitive.
2057            !!!cp (130);
2058            $self->{state} = MD_DOCTYPE_STATE;
2059            $self->{state_keyword} = chr $self->{next_char};
2060          !!!next-input-character;          !!!next-input-character;
2061          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);  
         }  
2062        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and        } elsif ($self->{insertion_mode} & IN_FOREIGN_CONTENT_IM and
2063                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and                 $self->{open_elements}->[-1]->[1] & FOREIGN_EL and
2064                 $self->{next_char} == 0x005B) { # [                 $self->{next_char} == 0x005B) { # [
2065            !!!cp (135.4);                
2066            $self->{state} = MD_CDATA_STATE;
2067            $self->{state_keyword} = '[';
2068          !!!next-input-character;          !!!next-input-character;
2069          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);  
         }  
2070        } else {        } else {
2071          !!!cp (136);          !!!cp (136);
2072        }        }
2073    
2074        !!!parse-error (type => 'bogus comment');        !!!parse-error (type => 'bogus comment',
2075        $self->{next_char} = shift @next_char;                        line => $self->{line_prev},
2076        !!!back-next-input-character (@next_char);                        column => $self->{column_prev} - 1);
2077          ## Reconsume.
2078        $self->{state} = BOGUS_COMMENT_STATE;        $self->{state} = BOGUS_COMMENT_STATE;
2079        $self->{current_token} = {type => COMMENT_TOKEN, data => '',        $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2080                                  line => $l, column => $c,                                  line => $self->{line_prev},
2081                                    column => $self->{column_prev} - 1,
2082                                 };                                 };
2083        redo A;        redo A;
2084              } elsif ($self->{state} == MD_HYPHEN_STATE) {
2085        ## ISSUE: typos in spec: chacacters, is is a parse error        if ($self->{next_char} == 0x002D) { # -
2086        ## 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);
2087            $self->{current_token} = {type => COMMENT_TOKEN, data => '',
2088                                      line => $self->{line_prev},
2089                                      column => $self->{column_prev} - 2,
2090                                     };
2091            $self->{state} = COMMENT_START_STATE;
2092            !!!next-input-character;
2093            redo A;
2094          } else {
2095            !!!cp (128);
2096            !!!parse-error (type => 'bogus comment',
2097                            line => $self->{line_prev},
2098                            column => $self->{column_prev} - 2);
2099            $self->{state} = BOGUS_COMMENT_STATE;
2100            ## Reconsume.
2101            $self->{current_token} = {type => COMMENT_TOKEN,
2102                                      data => '-',
2103                                      line => $self->{line_prev},
2104                                      column => $self->{column_prev} - 2,
2105                                     };
2106            redo A;
2107          }
2108        } elsif ($self->{state} == MD_DOCTYPE_STATE) {
2109          ## ASCII case-insensitive.
2110          if ($self->{next_char} == [
2111                undef,
2112                0x004F, # O
2113                0x0043, # C
2114                0x0054, # T
2115                0x0059, # Y
2116                0x0050, # P
2117              ]->[length $self->{state_keyword}] or
2118              $self->{next_char} == [
2119                undef,
2120                0x006F, # o
2121                0x0063, # c
2122                0x0074, # t
2123                0x0079, # y
2124                0x0070, # p
2125              ]->[length $self->{state_keyword}]) {
2126            !!!cp (131);
2127            ## Stay in the state.
2128            $self->{state_keyword} .= chr $self->{next_char};
2129            !!!next-input-character;
2130            redo A;
2131          } elsif ((length $self->{state_keyword}) == 6 and
2132                   ($self->{next_char} == 0x0045 or # E
2133                    $self->{next_char} == 0x0065)) { # e
2134            !!!cp (129);
2135            $self->{state} = DOCTYPE_STATE;
2136            $self->{current_token} = {type => DOCTYPE_TOKEN,
2137                                      quirks => 1,
2138                                      line => $self->{line_prev},
2139                                      column => $self->{column_prev} - 7,
2140                                     };
2141            !!!next-input-character;
2142            redo A;
2143          } else {
2144            !!!cp (132);        
2145            !!!parse-error (type => 'bogus comment',
2146                            line => $self->{line_prev},
2147                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2148            $self->{state} = BOGUS_COMMENT_STATE;
2149            ## Reconsume.
2150            $self->{current_token} = {type => COMMENT_TOKEN,
2151                                      data => $self->{state_keyword},
2152                                      line => $self->{line_prev},
2153                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2154                                     };
2155            redo A;
2156          }
2157        } elsif ($self->{state} == MD_CDATA_STATE) {
2158          if ($self->{next_char} == {
2159                '[' => 0x0043, # C
2160                '[C' => 0x0044, # D
2161                '[CD' => 0x0041, # A
2162                '[CDA' => 0x0054, # T
2163                '[CDAT' => 0x0041, # A
2164              }->{$self->{state_keyword}}) {
2165            !!!cp (135.1);
2166            ## Stay in the state.
2167            $self->{state_keyword} .= chr $self->{next_char};
2168            !!!next-input-character;
2169            redo A;
2170          } elsif ($self->{state_keyword} eq '[CDATA' and
2171                   $self->{next_char} == 0x005B) { # [
2172            !!!cp (135.2);
2173            $self->{current_token} = {type => CHARACTER_TOKEN,
2174                                      data => '',
2175                                      line => $self->{line_prev},
2176                                      column => $self->{column_prev} - 7};
2177            $self->{state} = CDATA_SECTION_STATE;
2178            !!!next-input-character;
2179            redo A;
2180          } else {
2181            !!!cp (135.3);
2182            !!!parse-error (type => 'bogus comment',
2183                            line => $self->{line_prev},
2184                            column => $self->{column_prev} - 1 - length $self->{state_keyword});
2185            $self->{state} = BOGUS_COMMENT_STATE;
2186            ## Reconsume.
2187            $self->{current_token} = {type => COMMENT_TOKEN,
2188                                      data => $self->{state_keyword},
2189                                      line => $self->{line_prev},
2190                                      column => $self->{column_prev} - 1 - length $self->{state_keyword},
2191                                     };
2192            redo A;
2193          }
2194      } elsif ($self->{state} == COMMENT_START_STATE) {      } elsif ($self->{state} == COMMENT_START_STATE) {
2195        if ($self->{next_char} == 0x002D) { # -        if ($self->{next_char} == 0x002D) { # -
2196          !!!cp (137);          !!!cp (137);
# Line 2010  sub _get_next_token ($) { Line 2457  sub _get_next_token ($) {
2457          redo A;          redo A;
2458        } elsif ($self->{next_char} == 0x0050 or # P        } elsif ($self->{next_char} == 0x0050 or # P
2459                 $self->{next_char} == 0x0070) { # p                 $self->{next_char} == 0x0070) { # p
2460            $self->{state} = PUBLIC_STATE;
2461            $self->{state_keyword} = chr $self->{next_char};
2462          !!!next-input-character;          !!!next-input-character;
2463          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);  
         }  
   
         #  
2464        } elsif ($self->{next_char} == 0x0053 or # S        } elsif ($self->{next_char} == 0x0053 or # S
2465                 $self->{next_char} == 0x0073) { # s                 $self->{next_char} == 0x0073) { # s
2466            $self->{state} = SYSTEM_STATE;
2467            $self->{state_keyword} = chr $self->{next_char};
2468          !!!next-input-character;          !!!next-input-character;
2469          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);  
         }  
   
         #  
2470        } else {        } else {
2471          !!!cp (180);          !!!cp (180);
2472            !!!parse-error (type => 'string after DOCTYPE name');
2473            $self->{current_token}->{quirks} = 1;
2474    
2475            $self->{state} = BOGUS_DOCTYPE_STATE;
2476          !!!next-input-character;          !!!next-input-character;
2477          #          redo A;
2478        }        }
2479        } elsif ($self->{state} == PUBLIC_STATE) {
2480          ## ASCII case-insensitive
2481          if ($self->{next_char} == [
2482                undef,
2483                0x0055, # U
2484                0x0042, # B
2485                0x004C, # L
2486                0x0049, # I
2487              ]->[length $self->{state_keyword}] or
2488              $self->{next_char} == [
2489                undef,
2490                0x0075, # u
2491                0x0062, # b
2492                0x006C, # l
2493                0x0069, # i
2494              ]->[length $self->{state_keyword}]) {
2495            !!!cp (175);
2496            ## Stay in the state.
2497            $self->{state_keyword} .= chr $self->{next_char};
2498            !!!next-input-character;
2499            redo A;
2500          } elsif ((length $self->{state_keyword}) == 5 and
2501                   ($self->{next_char} == 0x0043 or # C
2502                    $self->{next_char} == 0x0063)) { # c
2503            !!!cp (168);
2504            $self->{state} = BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE;
2505            !!!next-input-character;
2506            redo A;
2507          } else {
2508            !!!cp (169);
2509            !!!parse-error (type => 'string after DOCTYPE name',
2510                            line => $self->{line_prev},
2511                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2512            $self->{current_token}->{quirks} = 1;
2513    
2514        !!!parse-error (type => 'string after DOCTYPE name');          $self->{state} = BOGUS_DOCTYPE_STATE;
2515        $self->{current_token}->{quirks} = 1;          ## Reconsume.
2516            redo A;
2517          }
2518        } elsif ($self->{state} == SYSTEM_STATE) {
2519          ## ASCII case-insensitive
2520          if ($self->{next_char} == [
2521                undef,
2522                0x0059, # Y
2523                0x0053, # S
2524                0x0054, # T
2525                0x0045, # E
2526              ]->[length $self->{state_keyword}] or
2527              $self->{next_char} == [
2528                undef,
2529                0x0079, # y
2530                0x0073, # s
2531                0x0074, # t
2532                0x0065, # e
2533              ]->[length $self->{state_keyword}]) {
2534            !!!cp (170);
2535            ## Stay in the state.
2536            $self->{state_keyword} .= chr $self->{next_char};
2537            !!!next-input-character;
2538            redo A;
2539          } elsif ((length $self->{state_keyword}) == 5 and
2540                   ($self->{next_char} == 0x004D or # M
2541                    $self->{next_char} == 0x006D)) { # m
2542            !!!cp (171);
2543            $self->{state} = BEFORE_DOCTYPE_SYSTEM_IDENTIFIER_STATE;
2544            !!!next-input-character;
2545            redo A;
2546          } else {
2547            !!!cp (172);
2548            !!!parse-error (type => 'string after DOCTYPE name',
2549                            line => $self->{line_prev},
2550                            column => $self->{column_prev} + 1 - length $self->{state_keyword});
2551            $self->{current_token}->{quirks} = 1;
2552    
2553        $self->{state} = BOGUS_DOCTYPE_STATE;          $self->{state} = BOGUS_DOCTYPE_STATE;
2554        # next-input-character is already done          ## Reconsume.
2555        redo A;          redo A;
2556          }
2557      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {      } elsif ($self->{state} == BEFORE_DOCTYPE_PUBLIC_IDENTIFIER_STATE) {
2558        if ({        if ({
2559              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,              0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
# Line 2328  sub _get_next_token ($) { Line 2786  sub _get_next_token ($) {
2786          redo A;          redo A;
2787        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
2788          !!!cp (208);          !!!cp (208);
2789          !!!parse-error (type => 'unclosed PUBLIC literal');          !!!parse-error (type => 'unclosed SYSTEM literal');
2790    
2791          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2792          !!!next-input-character;          !!!next-input-character;
# Line 2364  sub _get_next_token ($) { Line 2822  sub _get_next_token ($) {
2822          redo A;          redo A;
2823        } elsif ($self->{next_char} == 0x003E) { # >        } elsif ($self->{next_char} == 0x003E) { # >
2824          !!!cp (212);          !!!cp (212);
2825          !!!parse-error (type => 'unclosed PUBLIC literal');          !!!parse-error (type => 'unclosed SYSTEM literal');
2826    
2827          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2828          !!!next-input-character;          !!!next-input-character;
# Line 2412  sub _get_next_token ($) { Line 2870  sub _get_next_token ($) {
2870        } elsif ($self->{next_char} == -1) {        } elsif ($self->{next_char} == -1) {
2871          !!!cp (217);          !!!cp (217);
2872          !!!parse-error (type => 'unclosed DOCTYPE');          !!!parse-error (type => 'unclosed DOCTYPE');
   
2873          $self->{state} = DATA_STATE;          $self->{state} = DATA_STATE;
2874          ## reconsume          ## reconsume
2875    
# Line 2453  sub _get_next_token ($) { Line 2910  sub _get_next_token ($) {
2910          !!!next-input-character;          !!!next-input-character;
2911          redo A;          redo A;
2912        }        }
2913      } elsif ($self->{state} == CDATA_BLOCK_STATE) {      } elsif ($self->{state} == CDATA_SECTION_STATE) {
2914        my $s = '';        ## NOTE: "CDATA section state" in the state is jointly implemented
2915          ## by three states, |CDATA_SECTION_STATE|, |CDATA_SECTION_MSE1_STATE|,
2916          ## and |CDATA_SECTION_MSE2_STATE|.
2917                
2918        my ($l, $c) = ($self->{line}, $self->{column});        if ($self->{next_char} == 0x005D) { # ]
2919            !!!cp (221.1);
2920            $self->{state} = CDATA_SECTION_MSE1_STATE;
2921            !!!next-input-character;
2922            redo A;
2923          } elsif ($self->{next_char} == -1) {
2924            $self->{state} = DATA_STATE;
2925            !!!next-input-character;
2926            if (length $self->{current_token}->{data}) { # character
2927              !!!cp (221.2);
2928              !!!emit ($self->{current_token}); # character
2929            } else {
2930              !!!cp (221.3);
2931              ## No token to emit. $self->{current_token} is discarded.
2932            }        
2933            redo A;
2934          } else {
2935            !!!cp (221.4);
2936            $self->{current_token}->{data} .= chr $self->{next_char};
2937            ## Stay in the state.
2938            !!!next-input-character;
2939            redo A;
2940          }
2941    
2942        CS: while ($self->{next_char} != -1) {        ## ISSUE: "text tokens" in spec.
2943          if ($self->{next_char} == 0x005D) { # ]      } elsif ($self->{state} == CDATA_SECTION_MSE1_STATE) {
2944            !!!next-input-character;        if ($self->{next_char} == 0x005D) { # ]
2945            if ($self->{next_char} == 0x005D) { # ]          !!!cp (221.5);
2946              !!!next-input-character;          $self->{state} = CDATA_SECTION_MSE2_STATE;
2947              MDC: {          !!!next-input-character;
2948                if ($self->{next_char} == 0x003E) { # >          redo A;
2949                  !!!cp (221.1);        } else {
2950                  !!!next-input-character;          !!!cp (221.6);
2951                  last CS;          $self->{current_token}->{data} .= ']';
2952                } elsif ($self->{next_char} == 0x005D) { # ]          $self->{state} = CDATA_SECTION_STATE;
2953                  !!!cp (221.2);          ## Reconsume.
2954                  $s .= ']';          redo A;
2955                  !!!next-input-character;        }
2956                  redo MDC;      } elsif ($self->{state} == CDATA_SECTION_MSE2_STATE) {
2957                } else {        if ($self->{next_char} == 0x003E) { # >
2958                  !!!cp (221.3);          $self->{state} = DATA_STATE;
2959                  $s .= ']]';          !!!next-input-character;
2960                  #          if (length $self->{current_token}->{data}) { # character
2961                }            !!!cp (221.7);
2962              } # MDC            !!!emit ($self->{current_token}); # character
           } else {  
             !!!cp (221.4);  
             $s .= ']';  
             #  
           }  
2963          } else {          } else {
2964            !!!cp (221.5);            !!!cp (221.8);
2965            #            ## No token to emit. $self->{current_token} is discarded.
2966          }          }
2967          $s .= chr $self->{next_char};          redo A;
2968          } elsif ($self->{next_char} == 0x005D) { # ]
2969            !!!cp (221.9); # character
2970            $self->{current_token}->{data} .= ']'; ## Add first "]" of "]]]".
2971            ## Stay in the state.
2972          !!!next-input-character;          !!!next-input-character;
2973        } # CS          redo A;
   
       $self->{state} = DATA_STATE;  
       ## next-input-character done or EOF, which is reconsumed.  
   
       if (length $s) {  
         !!!cp (221.6);  
         !!!emit ({type => CHARACTER_TOKEN, data => $s,  
                   line => $l, column => $c});  
2974        } else {        } else {
2975          !!!cp (221.7);          !!!cp (221.11);
2976            $self->{current_token}->{data} .= ']]'; # character
2977            $self->{state} = CDATA_SECTION_STATE;
2978            ## Reconsume.
2979            redo A;
2980          }
2981        } elsif ($self->{state} == ENTITY_STATE) {
2982          if ({
2983            0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
2984            0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, &
2985            $self->{entity_additional} => 1,
2986          }->{$self->{next_char}}) {
2987            !!!cp (1001);
2988            ## Don't consume
2989            ## No error
2990            ## Return nothing.
2991            #
2992          } elsif ($self->{next_char} == 0x0023) { # #
2993            !!!cp (999);
2994            $self->{state} = ENTITY_HASH_STATE;
2995            $self->{state_keyword} = '#';
2996            !!!next-input-character;
2997            redo A;
2998          } elsif ((0x0041 <= $self->{next_char} and
2999                    $self->{next_char} <= 0x005A) or # A..Z
3000                   (0x0061 <= $self->{next_char} and
3001                    $self->{next_char} <= 0x007A)) { # a..z
3002            !!!cp (998);
3003            require Whatpm::_NamedEntityList;
3004            $self->{state} = ENTITY_NAME_STATE;
3005            $self->{state_keyword} = chr $self->{next_char};
3006            $self->{entity__value} = $self->{state_keyword};
3007            $self->{entity__match} = 0;
3008            !!!next-input-character;
3009            redo A;
3010          } else {
3011            !!!cp (1027);
3012            !!!parse-error (type => 'bare ero');
3013            ## Return nothing.
3014            #
3015        }        }
3016    
3017        redo A;        ## NOTE: No character is consumed by the "consume a character
3018          ## reference" algorithm.  In other word, there is an "&" character
3019        ## ISSUE: "text tokens" in spec.        ## that does not introduce a character reference, which would be
3020        ## TODO: Streaming support        ## appended to the parent element or the attribute value in later
3021      } else {        ## process of the tokenizer.
3022        die "$0: $self->{state}: Unknown state";  
3023      }        if ($self->{prev_state} == DATA_STATE) {
3024    } # A            !!!cp (997);
3025            $self->{state} = $self->{prev_state};
3026    die "$0: _get_next_token: unexpected case";          ## Reconsume.
3027  } # _get_next_token          !!!emit ({type => CHARACTER_TOKEN, data => '&',
3028                      line => $self->{line_prev},
3029  sub _tokenize_attempt_to_consume_an_entity ($$$) {                    column => $self->{column_prev},
3030    my ($self, $in_attr, $additional) = @_;                   });
3031            redo A;
3032    my ($l, $c) = ($self->{line_prev}, $self->{column_prev});        } else {
3033            !!!cp (996);
3034            $self->{current_attribute}->{value} .= '&';
3035            $self->{state} = $self->{prev_state};
3036            ## Reconsume.
3037            redo A;
3038          }
3039        } elsif ($self->{state} == ENTITY_HASH_STATE) {
3040          if ($self->{next_char} == 0x0078 or # x
3041              $self->{next_char} == 0x0058) { # X
3042            !!!cp (995);
3043            $self->{state} = HEXREF_X_STATE;
3044            $self->{state_keyword} .= chr $self->{next_char};
3045            !!!next-input-character;
3046            redo A;
3047          } elsif (0x0030 <= $self->{next_char} and
3048                   $self->{next_char} <= 0x0039) { # 0..9
3049            !!!cp (994);
3050            $self->{state} = NCR_NUM_STATE;
3051            $self->{state_keyword} = $self->{next_char} - 0x0030;
3052            !!!next-input-character;
3053            redo A;
3054          } else {
3055            !!!parse-error (type => 'bare nero',
3056                            line => $self->{line_prev},
3057                            column => $self->{column_prev} - 1);
3058    
3059    if ({          ## NOTE: According to the spec algorithm, nothing is returned,
3060         0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,          ## and then "&#" is appended to the parent element or the attribute
3061         0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR          ## value in the later processing.
3062         $additional => 1,  
3063        }->{$self->{next_char}}) {          if ($self->{prev_state} == DATA_STATE) {
3064      !!!cp (1001);            !!!cp (1019);
3065      ## Don't consume            $self->{state} = $self->{prev_state};
3066      ## No error            ## Reconsume.
3067      return undef;            !!!emit ({type => CHARACTER_TOKEN,
3068    } elsif ($self->{next_char} == 0x0023) { # #                      data => '&#',
3069      !!!next-input-character;                      line => $self->{line_prev},
3070      if ($self->{next_char} == 0x0078 or # x                      column => $self->{column_prev} - 1,
3071          $self->{next_char} == 0x0058) { # X                     });
3072        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;  
3073          } else {          } else {
3074            !!!cp (1007);            !!!cp (993);
3075            !!!parse-error (type => 'no refc', line => $l, column => $c);            $self->{current_attribute}->{value} .= '&#';
3076              $self->{state} = $self->{prev_state};
3077              ## Reconsume.
3078              redo A;
3079          }          }
3080          }
3081          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {      } elsif ($self->{state} == NCR_NUM_STATE) {
3082            !!!cp (1008);        if (0x0030 <= $self->{next_char} and
3083            !!!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  
3084          !!!cp (1012);          !!!cp (1012);
3085          $code *= 10;          $self->{state_keyword} *= 10;
3086          $code += $self->{next_char} - 0x0030;          $self->{state_keyword} += $self->{next_char} - 0x0030;
3087                    
3088            ## Stay in the state.
3089          !!!next-input-character;          !!!next-input-character;
3090        }          redo A;
3091          } elsif ($self->{next_char} == 0x003B) { # ;
       if ($self->{next_char} == 0x003B) { # ;  
3092          !!!cp (1013);          !!!cp (1013);
3093          !!!next-input-character;          !!!next-input-character;
3094            #
3095        } else {        } else {
3096          !!!cp (1014);          !!!cp (1014);
3097          !!!parse-error (type => 'no refc', line => $l, column => $c);          !!!parse-error (type => 'no refc');
3098            ## Reconsume.
3099            #
3100        }        }
3101    
3102          my $code = $self->{state_keyword};
3103          my $l = $self->{line_prev};
3104          my $c = $self->{column_prev};
3105        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3106          !!!cp (1015);          !!!cp (1015);
3107          !!!parse-error (type => (sprintf 'invalid character reference:U+%04X', $code), line => $l, column => $c);          !!!parse-error (type => 'invalid character reference',
3108                            text => (sprintf 'U+%04X', $code),
3109                            line => $l, column => $c);
3110          $code = 0xFFFD;          $code = 0xFFFD;
3111        } elsif ($code > 0x10FFFF) {        } elsif ($code > 0x10FFFF) {
3112          !!!cp (1016);          !!!cp (1016);
3113          !!!parse-error (type => (sprintf 'invalid character reference:U-%08X', $code), line => $l, column => $c);          !!!parse-error (type => 'invalid character reference',
3114                            text => (sprintf 'U-%08X', $code),
3115                            line => $l, column => $c);
3116          $code = 0xFFFD;          $code = 0xFFFD;
3117        } elsif ($code == 0x000D) {        } elsif ($code == 0x000D) {
3118          !!!cp (1017);          !!!cp (1017);
3119          !!!parse-error (type => 'CR character reference', line => $l, column => $c);          !!!parse-error (type => 'CR character reference',
3120                            line => $l, column => $c);
3121          $code = 0x000A;          $code = 0x000A;
3122        } elsif (0x80 <= $code and $code <= 0x9F) {        } elsif (0x80 <= $code and $code <= 0x9F) {
3123          !!!cp (1018);          !!!cp (1018);
3124          !!!parse-error (type => (sprintf 'C1 character reference:U+%04X', $code), line => $l, column => $c);          !!!parse-error (type => 'C1 character reference',
3125                            text => (sprintf 'U+%04X', $code),
3126                            line => $l, column => $c);
3127          $code = $c1_entity_char->{$code};          $code = $c1_entity_char->{$code};
3128        }        }
3129          
3130        return {type => CHARACTER_TOKEN, data => chr $code, has_reference => 1,        if ($self->{prev_state} == DATA_STATE) {
3131                line => $l, column => $c,          !!!cp (992);
3132               };          $self->{state} = $self->{prev_state};
3133      } else {          ## Reconsume.
3134        !!!cp (1019);          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3135        !!!parse-error (type => 'bare nero', line => $l, column => $c);                    line => $l, column => $c,
3136        !!!back-next-input-character ($self->{next_char});                   });
3137        $self->{next_char} = 0x0023; # #          redo A;
3138        return undef;        } else {
3139      }          !!!cp (991);
3140    } elsif ((0x0041 <= $self->{next_char} and          $self->{current_attribute}->{value} .= chr $code;
3141              $self->{next_char} <= 0x005A) or          $self->{current_attribute}->{has_reference} = 1;
3142             (0x0061 <= $self->{next_char} and          $self->{state} = $self->{prev_state};
3143              $self->{next_char} <= 0x007A)) {          ## Reconsume.
3144      my $entity_name = chr $self->{next_char};          redo A;
3145      !!!next-input-character;        }
3146        } elsif ($self->{state} == HEXREF_X_STATE) {
3147      my $value = $entity_name;        if ((0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) or
3148      my $match = 0;            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3149      require Whatpm::_NamedEntityList;            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3150      our $EntityChar;          # 0..9, A..F, a..f
3151            !!!cp (990);
3152      while (length $entity_name < 30 and          $self->{state} = HEXREF_HEX_STATE;
3153             ## NOTE: Some number greater than the maximum length of entity name          $self->{state_keyword} = 0;
3154             ((0x0041 <= $self->{next_char} and # a          ## Reconsume.
3155               $self->{next_char} <= 0x005A) or # x          redo A;
3156              (0x0061 <= $self->{next_char} and # a        } else {
3157               $self->{next_char} <= 0x007A) or # z          !!!parse-error (type => 'bare hcro',
3158              (0x0030 <= $self->{next_char} and # 0                          line => $self->{line_prev},
3159               $self->{next_char} <= 0x0039) or # 9                          column => $self->{column_prev} - 2);
3160              $self->{next_char} == 0x003B)) { # ;  
3161        $entity_name .= chr $self->{next_char};          ## NOTE: According to the spec algorithm, nothing is returned,
3162        if (defined $EntityChar->{$entity_name}) {          ## and then "&#" followed by "X" or "x" is appended to the parent
3163          if ($self->{next_char} == 0x003B) { # ;          ## element or the attribute value in the later processing.
3164            !!!cp (1020);  
3165            $value = $EntityChar->{$entity_name};          if ($self->{prev_state} == DATA_STATE) {
3166            $match = 1;            !!!cp (1005);
3167            !!!next-input-character;            $self->{state} = $self->{prev_state};
3168            last;            ## Reconsume.
3169              !!!emit ({type => CHARACTER_TOKEN,
3170                        data => '&' . $self->{state_keyword},
3171                        line => $self->{line_prev},
3172                        column => $self->{column_prev} - length $self->{state_keyword},
3173                       });
3174              redo A;
3175          } else {          } else {
3176            !!!cp (1021);            !!!cp (989);
3177            $value = $EntityChar->{$entity_name};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3178            $match = -1;            $self->{state} = $self->{prev_state};
3179              ## Reconsume.
3180              redo A;
3181            }
3182          }
3183        } elsif ($self->{state} == HEXREF_HEX_STATE) {
3184          if (0x0030 <= $self->{next_char} and $self->{next_char} <= 0x0039) {
3185            # 0..9
3186            !!!cp (1002);
3187            $self->{state_keyword} *= 0x10;
3188            $self->{state_keyword} += $self->{next_char} - 0x0030;
3189            ## Stay in the state.
3190            !!!next-input-character;
3191            redo A;
3192          } elsif (0x0061 <= $self->{next_char} and
3193                   $self->{next_char} <= 0x0066) { # a..f
3194            !!!cp (1003);
3195            $self->{state_keyword} *= 0x10;
3196            $self->{state_keyword} += $self->{next_char} - 0x0060 + 9;
3197            ## Stay in the state.
3198            !!!next-input-character;
3199            redo A;
3200          } elsif (0x0041 <= $self->{next_char} and
3201                   $self->{next_char} <= 0x0046) { # A..F
3202            !!!cp (1004);
3203            $self->{state_keyword} *= 0x10;
3204            $self->{state_keyword} += $self->{next_char} - 0x0040 + 9;
3205            ## Stay in the state.
3206            !!!next-input-character;
3207            redo A;
3208          } elsif ($self->{next_char} == 0x003B) { # ;
3209            !!!cp (1006);
3210            !!!next-input-character;
3211            #
3212          } else {
3213            !!!cp (1007);
3214            !!!parse-error (type => 'no refc',
3215                            line => $self->{line},
3216                            column => $self->{column});
3217            ## Reconsume.
3218            #
3219          }
3220    
3221          my $code = $self->{state_keyword};
3222          my $l = $self->{line_prev};
3223          my $c = $self->{column_prev};
3224          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
3225            !!!cp (1008);
3226            !!!parse-error (type => 'invalid character reference',
3227                            text => (sprintf 'U+%04X', $code),
3228                            line => $l, column => $c);
3229            $code = 0xFFFD;
3230          } elsif ($code > 0x10FFFF) {
3231            !!!cp (1009);
3232            !!!parse-error (type => 'invalid character reference',
3233                            text => (sprintf 'U-%08X', $code),
3234                            line => $l, column => $c);
3235            $code = 0xFFFD;
3236          } elsif ($code == 0x000D) {
3237            !!!cp (1010);
3238            !!!parse-error (type => 'CR character reference', line => $l, column => $c);
3239            $code = 0x000A;
3240          } elsif (0x80 <= $code and $code <= 0x9F) {
3241            !!!cp (1011);
3242            !!!parse-error (type => 'C1 character reference', text => (sprintf 'U+%04X', $code), line => $l, column => $c);
3243            $code = $c1_entity_char->{$code};
3244          }
3245    
3246          if ($self->{prev_state} == DATA_STATE) {
3247            !!!cp (988);
3248            $self->{state} = $self->{prev_state};
3249            ## Reconsume.
3250            !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
3251                      line => $l, column => $c,
3252                     });
3253            redo A;
3254          } else {
3255            !!!cp (987);
3256            $self->{current_attribute}->{value} .= chr $code;
3257            $self->{current_attribute}->{has_reference} = 1;
3258            $self->{state} = $self->{prev_state};
3259            ## Reconsume.
3260            redo A;
3261          }
3262        } elsif ($self->{state} == ENTITY_NAME_STATE) {
3263          if (length $self->{state_keyword} < 30 and
3264              ## NOTE: Some number greater than the maximum length of entity name
3265              ((0x0041 <= $self->{next_char} and # a
3266                $self->{next_char} <= 0x005A) or # x
3267               (0x0061 <= $self->{next_char} and # a
3268                $self->{next_char} <= 0x007A) or # z
3269               (0x0030 <= $self->{next_char} and # 0
3270                $self->{next_char} <= 0x0039) or # 9
3271               $self->{next_char} == 0x003B)) { # ;
3272            our $EntityChar;
3273            $self->{state_keyword} .= chr $self->{next_char};
3274            if (defined $EntityChar->{$self->{state_keyword}}) {
3275              if ($self->{next_char} == 0x003B) { # ;
3276                !!!cp (1020);
3277                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3278                $self->{entity__match} = 1;
3279                !!!next-input-character;
3280                #
3281              } else {
3282                !!!cp (1021);
3283                $self->{entity__value} = $EntityChar->{$self->{state_keyword}};
3284                $self->{entity__match} = -1;
3285                ## Stay in the state.
3286                !!!next-input-character;
3287                redo A;
3288              }
3289            } else {
3290              !!!cp (1022);
3291              $self->{entity__value} .= chr $self->{next_char};
3292              $self->{entity__match} *= 2;
3293              ## Stay in the state.
3294            !!!next-input-character;            !!!next-input-character;
3295              redo A;
3296            }
3297          }
3298    
3299          my $data;
3300          my $has_ref;
3301          if ($self->{entity__match} > 0) {
3302            !!!cp (1023);
3303            $data = $self->{entity__value};
3304            $has_ref = 1;
3305            #
3306          } elsif ($self->{entity__match} < 0) {
3307            !!!parse-error (type => 'no refc');
3308            if ($self->{prev_state} != DATA_STATE and # in attribute
3309                $self->{entity__match} < -1) {
3310              !!!cp (1024);
3311              $data = '&' . $self->{state_keyword};
3312              #
3313            } else {
3314              !!!cp (1025);
3315              $data = $self->{entity__value};
3316              $has_ref = 1;
3317              #
3318          }          }
3319        } else {        } else {
3320          !!!cp (1022);          !!!cp (1026);
3321          $value .= chr $self->{next_char};          !!!parse-error (type => 'bare ero',
3322          $match *= 2;                          line => $self->{line_prev},
3323          !!!next-input-character;                          column => $self->{column_prev});
3324            $data = '&' . $self->{state_keyword};
3325            #
3326        }        }
3327      }    
3328              ## NOTE: In these cases, when a character reference is found,
3329      if ($match > 0) {        ## it is consumed and a character token is returned, or, otherwise,
3330        !!!cp (1023);        ## nothing is consumed and returned, according to the spec algorithm.
3331        return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,        ## In this implementation, anything that has been examined by the
3332                line => $l, column => $c,        ## tokenizer is appended to the parent element or the attribute value
3333               };        ## as string, either literal string when no character reference or
3334      } elsif ($match < 0) {        ## entity-replaced string otherwise, in this stage, since any characters
3335        !!!parse-error (type => 'no refc', line => $l, column => $c);        ## that would not be consumed are appended in the data state or in an
3336        if ($in_attr and $match < -1) {        ## appropriate attribute value state anyway.
3337          !!!cp (1024);  
3338          return {type => CHARACTER_TOKEN, data => '&'.$entity_name,        if ($self->{prev_state} == DATA_STATE) {
3339                  line => $l, column => $c,          !!!cp (986);
3340                 };          $self->{state} = $self->{prev_state};
3341        } else {          ## Reconsume.
3342          !!!cp (1025);          !!!emit ({type => CHARACTER_TOKEN,
3343          return {type => CHARACTER_TOKEN, data => $value, has_reference => 1,                    data => $data,
3344                  line => $l, column => $c,                    line => $self->{line_prev},
3345                 };                    column => $self->{column_prev} + 1 - length $self->{state_keyword},
3346                     });
3347            redo A;
3348          } else {
3349            !!!cp (985);
3350            $self->{current_attribute}->{value} .= $data;
3351            $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3352            $self->{state} = $self->{prev_state};
3353            ## Reconsume.
3354            redo A;
3355        }        }
3356      } else {      } else {
3357        !!!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,  
              };  
3358      }      }
3359    } else {    } # A  
3360      !!!cp (1027);  
3361      ## no characters are consumed    die "$0: _get_next_token: unexpected case";
3362      !!!parse-error (type => 'bare ero', line => $l, column => $c);  } # _get_next_token
     return undef;  
   }  
 } # _tokenize_attempt_to_consume_an_entity  
3363    
3364  sub _initialize_tree_constructor ($) {  sub _initialize_tree_constructor ($) {
3365    my $self = shift;    my $self = shift;
# Line 2729  sub _initialize_tree_constructor ($) { Line 3368  sub _initialize_tree_constructor ($) {
3368    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
3369    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
3370    $self->{document}->manakai_is_html (1); # MUST    $self->{document}->manakai_is_html (1); # MUST
3371      $self->{document}->set_user_data (manakai_source_line => 1);
3372      $self->{document}->set_user_data (manakai_source_column => 1);
3373  } # _initialize_tree_constructor  } # _initialize_tree_constructor
3374    
3375  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 2783  sub _tree_construction_initial ($) { Line 3424  sub _tree_construction_initial ($) {
3424        ## language.        ## language.
3425        my $doctype_name = $token->{name};        my $doctype_name = $token->{name};
3426        $doctype_name = '' unless defined $doctype_name;        $doctype_name = '' unless defined $doctype_name;
3427        $doctype_name =~ tr/a-z/A-Z/;        $doctype_name =~ tr/a-z/A-Z/; # ASCII case-insensitive
3428        if (not defined $token->{name} or # <!DOCTYPE>        if (not defined $token->{name} or # <!DOCTYPE>
           defined $token->{public_identifier} or  
3429            defined $token->{system_identifier}) {            defined $token->{system_identifier}) {
3430          !!!cp ('t1');          !!!cp ('t1');
3431          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3432        } elsif ($doctype_name ne 'HTML') {        } elsif ($doctype_name ne 'HTML') {
3433          !!!cp ('t2');          !!!cp ('t2');
         ## ISSUE: ASCII case-insensitive? (in fact it does not matter)  
3434          !!!parse-error (type => 'not HTML5', token => $token);          !!!parse-error (type => 'not HTML5', token => $token);
3435          } elsif (defined $token->{public_identifier}) {
3436            if ($token->{public_identifier} eq 'XSLT-compat') {
3437              !!!cp ('t1.2');
3438              !!!parse-error (type => 'XSLT-compat', token => $token,
3439                              level => $self->{level}->{should});
3440            } else {
3441              !!!parse-error (type => 'not HTML5', token => $token);
3442            }
3443        } else {        } else {
3444          !!!cp ('t3');          !!!cp ('t3');
3445            #
3446        }        }
3447                
3448        my $doctype = $self->{document}->create_document_type_definition        my $doctype = $self->{document}->create_document_type_definition
# Line 2815  sub _tree_construction_initial ($) { Line 3463  sub _tree_construction_initial ($) {
3463        } elsif (defined $token->{public_identifier}) {        } elsif (defined $token->{public_identifier}) {
3464          my $pubid = $token->{public_identifier};          my $pubid = $token->{public_identifier};
3465          $pubid =~ tr/a-z/A-z/;          $pubid =~ tr/a-z/A-z/;
3466          if ({          my $prefix = [
3467            "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,            "+//SILMARIL//DTD HTML PRO V0R11 19970101//",
3468            "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,            "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//",
3469            "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,            "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//",
3470            "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,            "-//IETF//DTD HTML 2.0 LEVEL 1//",
3471            "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,            "-//IETF//DTD HTML 2.0 LEVEL 2//",
3472            "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//",
3473            "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//",
3474            "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,            "-//IETF//DTD HTML 2.0 STRICT//",
3475            "-//IETF//DTD HTML 2.0//EN" => 1,            "-//IETF//DTD HTML 2.0//",
3476            "-//IETF//DTD HTML 2.1E//EN" => 1,            "-//IETF//DTD HTML 2.1E//",
3477            "-//IETF//DTD HTML 3.0//EN" => 1,            "-//IETF//DTD HTML 3.0//",
3478            "-//IETF//DTD HTML 3.0//EN//" => 1,            "-//IETF//DTD HTML 3.2 FINAL//",
3479            "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,            "-//IETF//DTD HTML 3.2//",
3480            "-//IETF//DTD HTML 3.2//EN" => 1,            "-//IETF//DTD HTML 3//",
3481            "-//IETF//DTD HTML 3//EN" => 1,            "-//IETF//DTD HTML LEVEL 0//",
3482            "-//IETF//DTD HTML LEVEL 0//EN" => 1,            "-//IETF//DTD HTML LEVEL 1//",
3483            "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,            "-//IETF//DTD HTML LEVEL 2//",
3484            "-//IETF//DTD HTML LEVEL 1//EN" => 1,            "-//IETF//DTD HTML LEVEL 3//",
3485            "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,            "-//IETF//DTD HTML STRICT LEVEL 0//",
3486            "-//IETF//DTD HTML LEVEL 2//EN" => 1,            "-//IETF//DTD HTML STRICT LEVEL 1//",
3487            "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,            "-//IETF//DTD HTML STRICT LEVEL 2//",
3488            "-//IETF//DTD HTML LEVEL 3//EN" => 1,            "-//IETF//DTD HTML STRICT LEVEL 3//",
3489            "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,            "-//IETF//DTD HTML STRICT//",
3490            "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,            "-//IETF//DTD HTML//",
3491            "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,            "-//METRIUS//DTD METRIUS PRESENTATIONAL//",
3492            "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//",
3493            "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//",
3494            "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//",
3495            "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//",
3496            "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//",
3497            "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//",
3498            "-//IETF//DTD HTML STRICT//EN" => 1,            "-//NETSCAPE COMM. CORP.//DTD HTML//",
3499            "-//IETF//DTD HTML STRICT//EN//2.0" => 1,            "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//",
3500            "-//IETF//DTD HTML STRICT//EN//3.0" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//",
3501            "-//IETF//DTD HTML//EN" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//",
3502            "-//IETF//DTD HTML//EN//2.0" => 1,            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED RELAXED 1.0//",
3503            "-//IETF//DTD HTML//EN//3.0" => 1,            "-//SOFTQUAD SOFTWARE//DTD HOTMETAL PRO 6.0::19990601::EXTENSIONS TO HTML 4.0//",
3504            "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,            "-//SOFTQUAD//DTD HOTMETAL PRO 4.0::19971010::EXTENSIONS TO HTML 4.0//",
3505            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,            "-//SPYGLASS//DTD HTML 2.0 EXTENDED//",
3506            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,            "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//",
3507            "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//",
3508            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//",
3509            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,            "-//W3C//DTD HTML 3 1995-03-24//",
3510            "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,            "-//W3C//DTD HTML 3.2 DRAFT//",
3511            "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,            "-//W3C//DTD HTML 3.2 FINAL//",
3512            "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,            "-//W3C//DTD HTML 3.2//",
3513            "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,            "-//W3C//DTD HTML 3.2S DRAFT//",
3514            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,            "-//W3C//DTD HTML 4.0 FRAMESET//",
3515            "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED RELAXED 1.0//EN" => 1,            "-//W3C//DTD HTML 4.0 TRANSITIONAL//",
3516            "-//SOFTQUAD SOFTWARE//DTD HOTMETAL PRO 6.0::19990601::EXTENSIONS TO HTML 4.0//EN" => 1,            "-//W3C//DTD HTML EXPERIMETNAL 19960712//",
3517            "-//SOFTQUAD//DTD HOTMETAL PRO 4.0::19971010::EXTENSIONS TO HTML 4.0//EN" => 1,            "-//W3C//DTD HTML EXPERIMENTAL 970421//",
3518            "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,            "-//W3C//DTD W3 HTML//",
3519            "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,            "-//W3O//DTD W3 HTML 3.0//",
3520            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,            "-//WEBTECHS//DTD MOZILLA HTML 2.0//",
3521            "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,            "-//WEBTECHS//DTD MOZILLA HTML//",
3522            "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,          ]; # $prefix
3523            "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,          my $match;
3524            "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,          for (@$prefix) {
3525            "-//W3C//DTD HTML 3.2//EN" => 1,            if (substr ($prefix, 0, length $_) eq $_) {
3526            "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,              $match = 1;
3527            "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,              last;
3528            "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,            }
3529            "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,          }
3530            "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,          if ($match or
3531            "-//W3C//DTD W3 HTML//EN" => 1,              $pubid eq "-//W3O//DTD W3 HTML STRICT 3.0//EN//" or
3532            "-//W3O//DTD W3 HTML 3.0//EN" => 1,              $pubid eq "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" or
3533            "-//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}) {  
3534            !!!cp ('t5');            !!!cp ('t5');
3535            $self->{document}->manakai_compat_mode ('quirks');            $self->{document}->manakai_compat_mode ('quirks');
3536          } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or          } elsif ($pubid =~ m[^-//W3C//DTD HTML 4.01 FRAMESET//] or
3537                   $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {                   $pubid =~ m[^-//W3C//DTD HTML 4.01 TRANSITIONAL//]) {
3538            if (defined $token->{system_identifier}) {            if (defined $token->{system_identifier}) {
3539              !!!cp ('t6');              !!!cp ('t6');
3540              $self->{document}->manakai_compat_mode ('quirks');              $self->{document}->manakai_compat_mode ('quirks');
# Line 2900  sub _tree_construction_initial ($) { Line 3542  sub _tree_construction_initial ($) {
3542              !!!cp ('t7');              !!!cp ('t7');
3543              $self->{document}->manakai_compat_mode ('limited quirks');              $self->{document}->manakai_compat_mode ('limited quirks');
3544            }            }
3545          } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 FRAMESET//EN" or          } elsif ($pubid =~ m[^-//W3C//DTD XHTML 1.0 FRAMESET//] or
3546                   $pubid eq "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN") {                   $pubid =~ m[^-//W3C//DTD XHTML 1.0 TRANSITIONAL//]) {
3547            !!!cp ('t8');            !!!cp ('t8');
3548            $self->{document}->manakai_compat_mode ('limited quirks');            $self->{document}->manakai_compat_mode ('limited quirks');
3549          } else {          } else {
# Line 2914  sub _tree_construction_initial ($) { Line 3556  sub _tree_construction_initial ($) {
3556          my $sysid = $token->{system_identifier};          my $sysid = $token->{system_identifier};
3557          $sysid =~ tr/A-Z/a-z/;          $sysid =~ tr/A-Z/a-z/;
3558          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") {
3559            ## TODO: Check the spec: PUBLIC "(limited quirks)" "(quirks)"            ## NOTE: Ensure that |PUBLIC "(limited quirks)" "(quirks)"| is
3560              ## marked as quirks.
3561            $self->{document}->manakai_compat_mode ('quirks');            $self->{document}->manakai_compat_mode ('quirks');
3562            !!!cp ('t11');            !!!cp ('t11');
3563          } else {          } else {
# Line 3086  sub _reset_insertion_mode ($) { Line 3729  sub _reset_insertion_mode ($) {
3729        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {        if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
3730          $last = 1;          $last = 1;
3731          if (defined $self->{inner_html_node}) {          if (defined $self->{inner_html_node}) {
3732            if ($self->{inner_html_node}->[1] & TABLE_CELL_EL) {            !!!cp ('t28');
3733              !!!cp ('t27');            $node = $self->{inner_html_node};
3734              #          } else {
3735            } else {            die "_reset_insertion_mode: t27";
             !!!cp ('t28');  
             $node = $self->{inner_html_node};  
           }  
3736          }          }
3737        }        }
3738              
3739      ## Step 4..14        ## Step 4..14
3740      my $new_mode;        my $new_mode;
3741      if ($node->[1] & FOREIGN_EL) {        if ($node->[1] & FOREIGN_EL) {
3742        ## NOTE: Strictly spaking, the line below only applies to MathML and          !!!cp ('t28.1');
3743        ## SVG elements.  Currently the HTML syntax supports only MathML and          ## NOTE: Strictly spaking, the line below only applies to MathML and
3744        ## SVG elements as foreigners.          ## SVG elements.  Currently the HTML syntax supports only MathML and
3745        $new_mode = $self->{insertion_mode} | IN_FOREIGN_CONTENT_IM;          ## SVG elements as foreigners.
3746        ## ISSUE: What is set as the secondary insertion mode?          $new_mode = IN_BODY_IM | IN_FOREIGN_CONTENT_IM;
3747      } else {        } elsif ($node->[1] & TABLE_CELL_EL) {
3748        $new_mode = {          if ($last) {
3749              !!!cp ('t28.2');
3750              #
3751            } else {
3752              !!!cp ('t28.3');
3753              $new_mode = IN_CELL_IM;
3754            }
3755          } else {
3756            !!!cp ('t28.4');
3757            $new_mode = {
3758                        select => IN_SELECT_IM,                        select => IN_SELECT_IM,
3759                        ## NOTE: |option| and |optgroup| do not set                        ## NOTE: |option| and |optgroup| do not set
3760                        ## insertion mode to "in select" by themselves.                        ## insertion mode to "in select" by themselves.
                       td => IN_CELL_IM,  
                       th => IN_CELL_IM,  
3761                        tr => IN_ROW_IM,                        tr => IN_ROW_IM,
3762                        tbody => IN_TABLE_BODY_IM,                        tbody => IN_TABLE_BODY_IM,
3763                        thead => IN_TABLE_BODY_IM,                        thead => IN_TABLE_BODY_IM,
# Line 3122  sub _reset_insertion_mode ($) { Line 3769  sub _reset_insertion_mode ($) {
3769                        body => IN_BODY_IM,                        body => IN_BODY_IM,
3770                        frameset => IN_FRAMESET_IM,                        frameset => IN_FRAMESET_IM,
3771                       }->{$node->[0]->manakai_local_name};                       }->{$node->[0]->manakai_local_name};
3772      }        }
3773      $self->{insertion_mode} = $new_mode and return if defined $new_mode;        $self->{insertion_mode} = $new_mode and return if defined $new_mode;
3774                
3775        ## Step 15        ## Step 15
3776        if ($node->[1] & HTML_EL) {        if ($node->[1] & HTML_EL) {
# Line 3297  sub _tree_construction_main ($) { Line 3944  sub _tree_construction_main ($) {
3944        ## NOTE: An end-of-file token.        ## NOTE: An end-of-file token.
3945        if ($content_model_flag == CDATA_CONTENT_MODEL) {        if ($content_model_flag == CDATA_CONTENT_MODEL) {
3946          !!!cp ('t43');          !!!cp ('t43');
3947          !!!parse-error (type => 'in CDATA:#'.$token->{type}, token => $token);          !!!parse-error (type => 'in CDATA:#eof', token => $token);
3948        } elsif ($content_model_flag == RCDATA_CONTENT_MODEL) {        } elsif ($content_model_flag == RCDATA_CONTENT_MODEL) {
3949          !!!cp ('t44');          !!!cp ('t44');
3950          !!!parse-error (type => 'in RCDATA:#'.$token->{type}, token => $token);          !!!parse-error (type => 'in RCDATA:#eof', token => $token);
3951        } else {        } else {
3952          die "$0: $content_model_flag in parse_rcdata";          die "$0: $content_model_flag in parse_rcdata";
3953        }        }
# Line 3337  sub _tree_construction_main ($) { Line 3984  sub _tree_construction_main ($) {
3984        ## Ignore the token        ## Ignore the token
3985      } else {      } else {
3986        !!!cp ('t48');        !!!cp ('t48');
3987        !!!parse-error (type => 'in CDATA:#'.$token->{type}, token => $token);        !!!parse-error (type => 'in CDATA:#eof', token => $token);
3988        ## ISSUE: And ignore?        ## ISSUE: And ignore?
3989        ## TODO: mark as "already executed"        ## TODO: mark as "already executed"
3990      }      }
# Line 3388  sub _tree_construction_main ($) { Line 4035  sub _tree_construction_main ($) {
4035        } # AFE        } # AFE
4036        unless (defined $formatting_element) {        unless (defined $formatting_element) {
4037          !!!cp ('t53');          !!!cp ('t53');
4038          !!!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);
4039          ## Ignore the token          ## Ignore the token
4040          !!!next-token;          !!!next-token;
4041          return;          return;
# Line 3405  sub _tree_construction_main ($) { Line 4052  sub _tree_construction_main ($) {
4052              last INSCOPE;              last INSCOPE;
4053            } else { # in open elements but not in scope            } else { # in open elements but not in scope
4054              !!!cp ('t55');              !!!cp ('t55');
4055              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name},              !!!parse-error (type => 'unmatched end tag',
4056                                text => $token->{tag_name},
4057                              token => $end_tag_token);                              token => $end_tag_token);
4058              ## Ignore the token              ## Ignore the token
4059              !!!next-token;              !!!next-token;
# Line 3418  sub _tree_construction_main ($) { Line 4066  sub _tree_construction_main ($) {
4066        } # INSCOPE        } # INSCOPE
4067        unless (defined $formatting_element_i_in_open) {        unless (defined $formatting_element_i_in_open) {
4068          !!!cp ('t57');          !!!cp ('t57');
4069          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name},          !!!parse-error (type => 'unmatched end tag',
4070                            text => $token->{tag_name},
4071                          token => $end_tag_token);                          token => $end_tag_token);
4072          pop @$active_formatting_elements; # $formatting_element          pop @$active_formatting_elements; # $formatting_element
4073          !!!next-token; ## TODO: ok?          !!!next-token; ## TODO: ok?
# Line 3427  sub _tree_construction_main ($) { Line 4076  sub _tree_construction_main ($) {
4076        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
4077          !!!cp ('t58');          !!!cp ('t58');
4078          !!!parse-error (type => 'not closed',          !!!parse-error (type => 'not closed',
4079                          value => $self->{open_elements}->[-1]->[0]                          text => $self->{open_elements}->[-1]->[0]
4080                              ->manakai_local_name,                              ->manakai_local_name,
4081                          token => $end_tag_token);                          token => $end_tag_token);
4082        }        }
# Line 3636  sub _tree_construction_main ($) { Line 4285  sub _tree_construction_main ($) {
4285    B: while (1) {    B: while (1) {
4286      if ($token->{type} == DOCTYPE_TOKEN) {      if ($token->{type} == DOCTYPE_TOKEN) {
4287        !!!cp ('t73');        !!!cp ('t73');
4288        !!!parse-error (type => 'DOCTYPE in the middle', token => $token);        !!!parse-error (type => 'in html:#DOCTYPE', token => $token);
4289        ## Ignore the token        ## Ignore the token
4290        ## Stay in the phase        ## Stay in the phase
4291        !!!next-token;        !!!next-token;
# Line 3645  sub _tree_construction_main ($) { Line 4294  sub _tree_construction_main ($) {
4294               $token->{tag_name} eq 'html') {               $token->{tag_name} eq 'html') {
4295        if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {        if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
4296          !!!cp ('t79');          !!!cp ('t79');
4297          !!!parse-error (type => 'after html:html', token => $token);          !!!parse-error (type => 'after html', text => 'html', token => $token);
4298          $self->{insertion_mode} = AFTER_BODY_IM;          $self->{insertion_mode} = AFTER_BODY_IM;
4299        } elsif ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {        } elsif ($self->{insertion_mode} == AFTER_HTML_FRAMESET_IM) {
4300          !!!cp ('t80');          !!!cp ('t80');
4301          !!!parse-error (type => 'after html:html', token => $token);          !!!parse-error (type => 'after html', text => 'html', token => $token);
4302          $self->{insertion_mode} = AFTER_FRAMESET_IM;          $self->{insertion_mode} = AFTER_FRAMESET_IM;
4303        } else {        } else {
4304          !!!cp ('t81');          !!!cp ('t81');
# Line 3699  sub _tree_construction_main ($) { Line 4348  sub _tree_construction_main ($) {
4348            !!!cp ('t87.2');            !!!cp ('t87.2');
4349            #            #
4350          } elsif ({          } elsif ({
4351    ## TODO:                    b => 1, big => 1, blockquote => 1, body => 1, br => 1,
4352                      center => 1, code => 1, dd => 1, div => 1, dl => 1, dt => 1,
4353                      em => 1, embed => 1, font => 1, h1 => 1, h2 => 1, h3 => 1,
4354                      h4 => 1, h5 => 1, h6 => 1, head => 1, hr => 1, i => 1,
4355                      img => 1, li => 1, listing => 1, menu => 1, meta => 1,
4356                      nobr => 1, ol => 1, p => 1, pre => 1, ruby => 1, s => 1,
4357                      small => 1, span => 1, strong => 1, strike => 1, sub => 1,
4358                      sup => 1, table => 1, tt => 1, u => 1, ul => 1, var => 1,
4359                   }->{$token->{tag_name}}) {                   }->{$token->{tag_name}}) {
4360            !!!cp ('t87.2');            !!!cp ('t87.2');
4361            !!!parse-error (type => 'not closed',            !!!parse-error (type => 'not closed',
4362                            value => $self->{open_elements}->[-1]->[0]                            text => $self->{open_elements}->[-1]->[0]
4363                                ->manakai_local_name,                                ->manakai_local_name,
4364                            token => $token);                            token => $token);
4365    
4366            pop @{$self->{open_elements}}            pop @{$self->{open_elements}}
4367                while $self->{open_elements}->[-1]->[1] & FOREIGN_EL;                while $self->{open_elements}->[-1]->[1] & FOREIGN_EL;
4368    
4369            $self->{insertion_mode} &= ~ $self->{insertion_mode};            $self->{insertion_mode} &= ~ IN_FOREIGN_CONTENT_IM;
4370            ## Reprocess.            ## Reprocess.
4371            next B;            next B;
4372          } else {          } else {
4373            ## TODO: case fixup            my $nsuri = $self->{open_elements}->[-1]->[0]->namespace_uri;
4374              my $tag_name = $token->{tag_name};
4375              if ($nsuri eq $SVG_NS) {
4376                $tag_name = {
4377                   altglyph => 'altGlyph',
4378                   altglyphdef => 'altGlyphDef',
4379                   altglyphitem => 'altGlyphItem',
4380                   animatecolor => 'animateColor',
4381                   animatemotion => 'animateMotion',
4382                   animatetransform => 'animateTransform',
4383                   clippath => 'clipPath',
4384                   feblend => 'feBlend',
4385                   fecolormatrix => 'feColorMatrix',
4386                   fecomponenttransfer => 'feComponentTransfer',
4387                   fecomposite => 'feComposite',
4388                   feconvolvematrix => 'feConvolveMatrix',
4389                   fediffuselighting => 'feDiffuseLighting',
4390                   fedisplacementmap => 'feDisplacementMap',
4391                   fedistantlight => 'feDistantLight',
4392                   feflood => 'feFlood',
4393                   fefunca => 'feFuncA',
4394                   fefuncb => 'feFuncB',
4395                   fefuncg => 'feFuncG',
4396                   fefuncr => 'feFuncR',
4397                   fegaussianblur => 'feGaussianBlur',
4398                   feimage => 'feImage',
4399                   femerge => 'feMerge',
4400                   femergenode => 'feMergeNode',
4401                   femorphology => 'feMorphology',
4402                   feoffset => 'feOffset',
4403                   fepointlight => 'fePointLight',
4404                   fespecularlighting => 'feSpecularLighting',
4405                   fespotlight => 'feSpotLight',
4406                   fetile => 'feTile',
4407                   feturbulence => 'feTurbulence',
4408                   foreignobject => 'foreignObject',
4409                   glyphref => 'glyphRef',
4410                   lineargradient => 'linearGradient',
4411                   radialgradient => 'radialGradient',
4412                   #solidcolor => 'solidColor', ## NOTE: Commented in spec (SVG1.2)
4413                   textpath => 'textPath',  
4414                }->{$tag_name} || $tag_name;
4415              }
4416    
4417              ## "adjust SVG attributes" (SVG only) - done in insert-element-f
4418    
4419            !!!insert-element-f ($self->{open_elements}->[-1]->[0]->namespace_uri, $token);            ## "adjust foreign attributes" - done in insert-element-f
4420    
4421              !!!insert-element-f ($nsuri, $tag_name, $token->{attributes}, $token);
4422    
4423            if ($self->{self_closing}) {            if ($self->{self_closing}) {
4424              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
# Line 3733  sub _tree_construction_main ($) { Line 4435  sub _tree_construction_main ($) {
4435          !!!cp ('t87.5');          !!!cp ('t87.5');
4436          #          #
4437        } elsif ($token->{type} == END_OF_FILE_TOKEN) {        } elsif ($token->{type} == END_OF_FILE_TOKEN) {
         ## NOTE: "using the rules for secondary insertion mode" then "continue"  
4438          !!!cp ('t87.6');          !!!cp ('t87.6');
4439          #          !!!parse-error (type => 'not closed',
4440          ## TODO: ...                          text => $self->{open_elements}->[-1]->[0]
4441                                ->manakai_local_name,
4442                            token => $token);
4443    
4444            pop @{$self->{open_elements}}
4445                while $self->{open_elements}->[-1]->[1] & FOREIGN_EL;
4446    
4447            $self->{insertion_mode} &= ~ IN_FOREIGN_CONTENT_IM;
4448            ## Reprocess.
4449            next B;
4450        } else {        } else {
4451          die "$0: $token->{type}: Unknown token type";                  die "$0: $token->{type}: Unknown token type";        
4452        }        }
# Line 3777  sub _tree_construction_main ($) { Line 4487  sub _tree_construction_main ($) {
4487            !!!cp ('t90');            !!!cp ('t90');
4488            ## As if </noscript>            ## As if </noscript>
4489            pop @{$self->{open_elements}};            pop @{$self->{open_elements}};
4490            !!!parse-error (type => 'in noscript:#character', token => $token);            !!!parse-error (type => 'in noscript:#text', token => $token);
4491                        
4492            ## Reprocess in the "in head" insertion mode...            ## Reprocess in the "in head" insertion mode...
4493            ## As if </head>            ## As if </head>
# Line 3813  sub _tree_construction_main ($) { Line 4523  sub _tree_construction_main ($) {
4523              !!!next-token;              !!!next-token;
4524              next B;              next B;
4525            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {            } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4526              !!!cp ('t94');              !!!cp ('t93.2');
4527              #              !!!parse-error (type => 'after head', text => 'head',
4528                                token => $token);
4529                ## Ignore the token
4530                !!!nack ('t93.3');
4531                !!!next-token;
4532                next B;
4533            } else {            } else {
4534              !!!cp ('t95');              !!!cp ('t95');
4535              !!!parse-error (type => 'in head:head', token => $token); # or in head noscript              !!!parse-error (type => 'in head:head',
4536                                token => $token); # or in head noscript
4537              ## Ignore the token              ## Ignore the token
4538              !!!nack ('t95.1');              !!!nack ('t95.1');
4539              !!!next-token;              !!!next-token;
# Line 3842  sub _tree_construction_main ($) { Line 4558  sub _tree_construction_main ($) {
4558                  !!!cp ('t98');                  !!!cp ('t98');
4559                  ## As if </noscript>                  ## As if </noscript>
4560                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4561                  !!!parse-error (type => 'in noscript:base', token => $token);                  !!!parse-error (type => 'in noscript', text => 'base',
4562                                    token => $token);
4563                                
4564                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4565                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
# Line 3853  sub _tree_construction_main ($) { Line 4570  sub _tree_construction_main ($) {
4570                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4571                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4572                  !!!cp ('t100');                  !!!cp ('t100');
4573                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4574                                    text => $token->{tag_name}, token => $token);
4575                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4576                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4577                } else {                } else {
# Line 3870  sub _tree_construction_main ($) { Line 4588  sub _tree_construction_main ($) {
4588                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4589                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4590                  !!!cp ('t102');                  !!!cp ('t102');
4591                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4592                                    text => $token->{tag_name}, token => $token);
4593                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4594                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4595                } else {                } else {
# Line 3887  sub _tree_construction_main ($) { Line 4606  sub _tree_construction_main ($) {
4606                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4607                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4608                  !!!cp ('t104');                  !!!cp ('t104');
4609                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4610                                    text => $token->{tag_name}, token => $token);
4611                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4612                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4613                } else {                } else {
# Line 3897  sub _tree_construction_main ($) { Line 4617  sub _tree_construction_main ($) {
4617                my $meta_el = pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.                my $meta_el = pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
4618    
4619                unless ($self->{confident}) {                unless ($self->{confident}) {
4620                  if ($token->{attributes}->{charset}) { ## TODO: And if supported                  if ($token->{attributes}->{charset}) {
4621                    !!!cp ('t106');                    !!!cp ('t106');
4622                      ## NOTE: Whether the encoding is supported or not is handled
4623                      ## in the {change_encoding} callback.
4624                    $self->{change_encoding}                    $self->{change_encoding}
4625                        ->($self, $token->{attributes}->{charset}->{value},                        ->($self, $token->{attributes}->{charset}->{value},
4626                           $token);                           $token);
# Line 3908  sub _tree_construction_main ($) { Line 4630  sub _tree_construction_main ($) {
4630                                             $token->{attributes}->{charset}                                             $token->{attributes}->{charset}
4631                                                 ->{has_reference});                                                 ->{has_reference});
4632                  } elsif ($token->{attributes}->{content}) {                  } elsif ($token->{attributes}->{content}) {
                   ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.  
4633                    if ($token->{attributes}->{content}->{value}                    if ($token->{attributes}->{content}->{value}
4634                        =~ /\A[^;]*;[\x09-\x0D\x20]*[Cc][Hh][Aa][Rr][Ss][Ee][Tt]                        =~ /[Cc][Hh][Aa][Rr][Ss][Ee][Tt]
4635                            [\x09-\x0D\x20]*=                            [\x09-\x0D\x20]*=
4636                            [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|                            [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
4637                            ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {                            ([^"'\x09-\x0D\x20][^\x09-\x0D\x20\x3B]*))/x) {
4638                      !!!cp ('t107');                      !!!cp ('t107');
4639                        ## NOTE: Whether the encoding is supported or not is handled
4640                        ## in the {change_encoding} callback.
4641                      $self->{change_encoding}                      $self->{change_encoding}
4642                          ->($self, defined $1 ? $1 : defined $2 ? $2 : $3,                          ->($self, defined $1 ? $1 : defined $2 ? $2 : $3,
4643                             $token);                             $token);
# Line 3953  sub _tree_construction_main ($) { Line 4676  sub _tree_construction_main ($) {
4676                  !!!cp ('t111');                  !!!cp ('t111');
4677                  ## As if </noscript>                  ## As if </noscript>
4678                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4679                  !!!parse-error (type => 'in noscript:title', token => $token);                  !!!parse-error (type => 'in noscript', text => 'title',
4680                                    token => $token);
4681                                
4682                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4683                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4684                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4685                  !!!cp ('t112');                  !!!cp ('t112');
4686                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4687                                    text => $token->{tag_name}, token => $token);
4688                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4689                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4690                } else {                } else {
# Line 3973  sub _tree_construction_main ($) { Line 4698  sub _tree_construction_main ($) {
4698                pop @{$self->{open_elements}} # <head>                pop @{$self->{open_elements}} # <head>
4699                    if $self->{insertion_mode} == AFTER_HEAD_IM;                    if $self->{insertion_mode} == AFTER_HEAD_IM;
4700                next B;                next B;
4701              } elsif ($token->{tag_name} eq 'style') {              } elsif ($token->{tag_name} eq 'style' or
4702                         $token->{tag_name} eq 'noframes') {
4703                ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and                ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
4704                ## insertion mode IN_HEAD_IM)                ## insertion mode IN_HEAD_IM)
4705                ## NOTE: There is a "as if in head" code clone.                ## NOTE: There is a "as if in head" code clone.
4706                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                if ($self->{insertion_mode} == AFTER_HEAD_IM) {
4707                  !!!cp ('t114');                  !!!cp ('t114');
4708                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4709                                    text => $token->{tag_name}, token => $token);
4710                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4711                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4712                } else {                } else {
# Line 4000  sub _tree_construction_main ($) { Line 4727  sub _tree_construction_main ($) {
4727                  next B;                  next B;
4728                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4729                  !!!cp ('t117');                  !!!cp ('t117');
4730                  !!!parse-error (type => 'in noscript:noscript', token => $token);                  !!!parse-error (type => 'in noscript', text => 'noscript',
4731                                    token => $token);
4732                  ## Ignore the token                  ## Ignore the token
4733                  !!!nack ('t117.1');                  !!!nack ('t117.1');
4734                  !!!next-token;                  !!!next-token;
# Line 4014  sub _tree_construction_main ($) { Line 4742  sub _tree_construction_main ($) {
4742                  !!!cp ('t119');                  !!!cp ('t119');
4743                  ## As if </noscript>                  ## As if </noscript>
4744                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4745                  !!!parse-error (type => 'in noscript:script', token => $token);                  !!!parse-error (type => 'in noscript', text => 'script',
4746                                    token => $token);
4747                                
4748                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4749                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4750                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4751                  !!!cp ('t120');                  !!!cp ('t120');
4752                  !!!parse-error (type => 'after head:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'after head',
4753                                    text => $token->{tag_name}, token => $token);
4754                  push @{$self->{open_elements}},                  push @{$self->{open_elements}},
4755                      [$self->{head_element}, $el_category->{head}];                      [$self->{head_element}, $el_category->{head}];
4756                } else {                } else {
# Line 4038  sub _tree_construction_main ($) { Line 4768  sub _tree_construction_main ($) {
4768                  !!!cp ('t122');                  !!!cp ('t122');
4769                  ## As if </noscript>                  ## As if </noscript>
4770                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4771                  !!!parse-error (type => 'in noscript:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'in noscript',
4772                                    text => $token->{tag_name}, token => $token);
4773                                    
4774                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4775                  ## As if </head>                  ## As if </head>
# Line 4077  sub _tree_construction_main ($) { Line 4808  sub _tree_construction_main ($) {
4808                !!!cp ('t129');                !!!cp ('t129');
4809                ## As if </noscript>                ## As if </noscript>
4810                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
4811                !!!parse-error (type => 'in noscript:/'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'in noscript:/',
4812                                  text => $token->{tag_name}, token => $token);
4813                                
4814                ## Reprocess in the "in head" insertion mode...                ## Reprocess in the "in head" insertion mode...
4815                ## As if </head>                ## As if </head>
# Line 4120  sub _tree_construction_main ($) { Line 4852  sub _tree_construction_main ($) {
4852                  !!!cp ('t133');                  !!!cp ('t133');
4853                  ## As if </noscript>                  ## As if </noscript>
4854                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
4855                  !!!parse-error (type => 'in noscript:/head', token => $token);                  !!!parse-error (type => 'in noscript:/',
4856                                    text => 'head', token => $token);
4857                                    
4858                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4859                  pop @{$self->{open_elements}};                  pop @{$self->{open_elements}};
# Line 4133  sub _tree_construction_main ($) { Line 4866  sub _tree_construction_main ($) {
4866                  $self->{insertion_mode} = AFTER_HEAD_IM;                  $self->{insertion_mode} = AFTER_HEAD_IM;
4867                  !!!next-token;                  !!!next-token;
4868                  next B;                  next B;
4869                  } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4870                    !!!cp ('t134.1');
4871                    !!!parse-error (type => 'unmatched end tag', text => 'head',
4872                                    token => $token);
4873                    ## Ignore the token
4874                    !!!next-token;
4875                    next B;
4876                } else {                } else {
4877                  !!!cp ('t135');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
                 #  
4878                }                }
4879              } elsif ($token->{tag_name} eq 'noscript') {              } elsif ($token->{tag_name} eq 'noscript') {
4880                if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {                if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
# Line 4144  sub _tree_construction_main ($) { Line 4883  sub _tree_construction_main ($) {
4883                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4884                  !!!next-token;                  !!!next-token;
4885                  next B;                  next B;
4886                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {                } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM or
4887                           $self->{insertion_mode} == AFTER_HEAD_IM) {
4888                  !!!cp ('t137');                  !!!cp ('t137');
4889                  !!!parse-error (type => 'unmatched end tag:noscript', token => $token);                  !!!parse-error (type => 'unmatched end tag',
4890                                    text => 'noscript', token => $token);
4891                  ## Ignore the token ## ISSUE: An issue in the spec.                  ## Ignore the token ## ISSUE: An issue in the spec.
4892                  !!!next-token;                  !!!next-token;
4893                  next B;                  next B;
# Line 4157  sub _tree_construction_main ($) { Line 4898  sub _tree_construction_main ($) {
4898              } elsif ({              } elsif ({
4899                        body => 1, html => 1,                        body => 1, html => 1,
4900                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4901                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {                if ($self->{insertion_mode} == BEFORE_HEAD_IM or
4902                  !!!cp ('t139');                    $self->{insertion_mode} == IN_HEAD_IM or
4903                  ## As if <head>                    $self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
                 !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);  
                 $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});  
                 push @{$self->{open_elements}},  
                     [$self->{head_element}, $el_category->{head}];  
   
                 $self->{insertion_mode} = IN_HEAD_IM;  
                 ## Reprocess in the "in head" insertion mode...  
               } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {  
4904                  !!!cp ('t140');                  !!!cp ('t140');
4905                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
4906                                    text => $token->{tag_name}, token => $token);
4907                    ## Ignore the token
4908                    !!!next-token;
4909                    next B;
4910                  } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4911                    !!!cp ('t140.1');
4912                    !!!parse-error (type => 'unmatched end tag',
4913                                    text => $token->{tag_name}, token => $token);
4914                  ## Ignore the token                  ## Ignore the token
4915                  !!!next-token;                  !!!next-token;
4916                  next B;                  next B;
4917                } else {                } else {
4918                  !!!cp ('t141');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
4919                }                }
4920                              } elsif ($token->{tag_name} eq 'p') {
4921                #                !!!cp ('t142');
4922              } elsif ({                !!!parse-error (type => 'unmatched end tag',
4923                        p => 1, br => 1,                                text => $token->{tag_name}, token => $token);
4924                       }->{$token->{tag_name}}) {                ## Ignore the token
4925                  !!!next-token;
4926                  next B;
4927                } elsif ($token->{tag_name} eq 'br') {
4928                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {                if ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4929                  !!!cp ('t142');                  !!!cp ('t142.2');
4930                  ## As if <head>                  ## (before head) as if <head>, (in head) as if </head>
4931                  !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);                  !!!create-element ($self->{head_element}, $HTML_NS, 'head',, $token);
4932                  $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});                  $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
4933                  push @{$self->{open_elements}},                  $self->{insertion_mode} = AFTER_HEAD_IM;
4934                      [$self->{head_element}, $el_category->{head}];    
4935                    ## Reprocess in the "after head" insertion mode...
4936                  } elsif ($self->{insertion_mode} == IN_HEAD_IM) {
4937                    !!!cp ('t143.2');
4938                    ## As if </head>
4939                    pop @{$self->{open_elements}};
4940                    $self->{insertion_mode} = AFTER_HEAD_IM;
4941      
4942                    ## Reprocess in the "after head" insertion mode...
4943                  } elsif ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4944                    !!!cp ('t143.3');
4945                    ## ISSUE: Two parse errors for <head><noscript></br>
4946                    !!!parse-error (type => 'unmatched end tag',
4947                                    text => 'br', token => $token);
4948                    ## As if </noscript>
4949                    pop @{$self->{open_elements}};
4950                  $self->{insertion_mode} = IN_HEAD_IM;                  $self->{insertion_mode} = IN_HEAD_IM;
4951    
4952                  ## Reprocess in the "in head" insertion mode...                  ## Reprocess in the "in head" insertion mode...
4953                } else {                  ## As if </head>
4954                  !!!cp ('t143');                  pop @{$self->{open_elements}};
4955                }                  $self->{insertion_mode} = AFTER_HEAD_IM;
4956    
4957                #                  ## Reprocess in the "after head" insertion mode...
4958              } else {                } elsif ($self->{insertion_mode} == AFTER_HEAD_IM) {
4959                if ($self->{insertion_mode} == AFTER_HEAD_IM) {                  !!!cp ('t143.4');
                 !!!cp ('t144');  
4960                  #                  #
4961                } else {                } else {
4962                  !!!cp ('t145');                  die "$0: $self->{insertion_mode}: Unknown insertion mode";
                 !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);  
                 ## Ignore the token  
                 !!!next-token;  
                 next B;  
4963                }                }
4964    
4965                  ## ISSUE: does not agree with IE7 - it doesn't ignore </br>.
4966                  !!!parse-error (type => 'unmatched end tag',
4967                                  text => 'br', token => $token);
4968                  ## Ignore the token
4969                  !!!next-token;
4970                  next B;
4971                } else {
4972                  !!!cp ('t145');
4973                  !!!parse-error (type => 'unmatched end tag',
4974                                  text => $token->{tag_name}, token => $token);
4975                  ## Ignore the token
4976                  !!!next-token;
4977                  next B;
4978              }              }
4979    
4980              if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {              if ($self->{insertion_mode} == IN_HEAD_NOSCRIPT_IM) {
4981                !!!cp ('t146');                !!!cp ('t146');
4982                ## As if </noscript>                ## As if </noscript>
4983                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
4984                !!!parse-error (type => 'in noscript:/'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'in noscript:/',
4985                                  text => $token->{tag_name}, token => $token);
4986                                
4987                ## Reprocess in the "in head" insertion mode...                ## Reprocess in the "in head" insertion mode...
4988                ## As if </head>                ## As if </head>
# Line 4229  sub _tree_construction_main ($) { Line 4998  sub _tree_construction_main ($) {
4998              } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {              } elsif ($self->{insertion_mode} == BEFORE_HEAD_IM) {
4999  ## ISSUE: This case cannot be reached?  ## ISSUE: This case cannot be reached?
5000                !!!cp ('t148');                !!!cp ('t148');
5001                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
5002                                  text => $token->{tag_name}, token => $token);
5003                ## Ignore the token ## ISSUE: An issue in the spec.                ## Ignore the token ## ISSUE: An issue in the spec.
5004                !!!next-token;                !!!next-token;
5005                next B;                next B;
# Line 4340  sub _tree_construction_main ($) { Line 5110  sub _tree_construction_main ($) {
5110    
5111                  !!!cp ('t153');                  !!!cp ('t153');
5112                  !!!parse-error (type => 'start tag not allowed',                  !!!parse-error (type => 'start tag not allowed',
5113                      value => $token->{tag_name}, token => $token);                      text => $token->{tag_name}, token => $token);
5114                  ## Ignore the token                  ## Ignore the token
5115                  !!!nack ('t153.1');                  !!!nack ('t153.1');
5116                  !!!next-token;                  !!!next-token;
5117                  next B;                  next B;
5118                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {
5119                  !!!parse-error (type => 'not closed:caption', token => $token);                  !!!parse-error (type => 'not closed', text => 'caption',
5120                                    token => $token);
5121                                    
5122                  ## NOTE: As if </caption>.                  ## NOTE: As if </caption>.
5123                  ## have a table element in table scope                  ## have a table element in table scope
# Line 4366  sub _tree_construction_main ($) { Line 5137  sub _tree_construction_main ($) {
5137    
5138                    !!!cp ('t157');                    !!!cp ('t157');
5139                    !!!parse-error (type => 'start tag not allowed',                    !!!parse-error (type => 'start tag not allowed',
5140                                    value => $token->{tag_name}, token => $token);                                    text => $token->{tag_name}, token => $token);
5141                    ## Ignore the token                    ## Ignore the token
5142                    !!!nack ('t157.1');                    !!!nack ('t157.1');
5143                    !!!next-token;                    !!!next-token;
# Line 4383  sub _tree_construction_main ($) { Line 5154  sub _tree_construction_main ($) {
5154                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5155                    !!!cp ('t159');                    !!!cp ('t159');
5156                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5157                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5158                                        ->manakai_local_name,                                        ->manakai_local_name,
5159                                    token => $token);                                    token => $token);
5160                  } else {                  } else {
# Line 4425  sub _tree_construction_main ($) { Line 5196  sub _tree_construction_main ($) {
5196                  } # INSCOPE                  } # INSCOPE
5197                    unless (defined $i) {                    unless (defined $i) {
5198                      !!!cp ('t165');                      !!!cp ('t165');
5199                      !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                      !!!parse-error (type => 'unmatched end tag',
5200                                        text => $token->{tag_name},
5201                                        token => $token);
5202                      ## Ignore the token                      ## Ignore the token
5203                      !!!next-token;                      !!!next-token;
5204                      next B;                      next B;
# Line 4442  sub _tree_construction_main ($) { Line 5215  sub _tree_construction_main ($) {
5215                          ne $token->{tag_name}) {                          ne $token->{tag_name}) {
5216                    !!!cp ('t167');                    !!!cp ('t167');
5217                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5218                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5219                                        ->manakai_local_name,                                        ->manakai_local_name,
5220                                    token => $token);                                    token => $token);
5221                  } else {                  } else {
# Line 4459  sub _tree_construction_main ($) { Line 5232  sub _tree_construction_main ($) {
5232                  next B;                  next B;
5233                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {                } elsif ($self->{insertion_mode} == IN_CAPTION_IM) {
5234                  !!!cp ('t169');                  !!!cp ('t169');
5235                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5236                                    text => $token->{tag_name}, token => $token);
5237                  ## Ignore the token                  ## Ignore the token
5238                  !!!next-token;                  !!!next-token;
5239                  next B;                  next B;
# Line 4486  sub _tree_construction_main ($) { Line 5260  sub _tree_construction_main ($) {
5260    
5261                    !!!cp ('t173');                    !!!cp ('t173');
5262                    !!!parse-error (type => 'unmatched end tag',                    !!!parse-error (type => 'unmatched end tag',
5263                                    value => $token->{tag_name}, token => $token);                                    text => $token->{tag_name}, token => $token);
5264                    ## Ignore the token                    ## Ignore the token
5265                    !!!next-token;                    !!!next-token;
5266                    next B;                    next B;
# Line 4502  sub _tree_construction_main ($) { Line 5276  sub _tree_construction_main ($) {
5276                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                  unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5277                    !!!cp ('t175');                    !!!cp ('t175');
5278                    !!!parse-error (type => 'not closed',                    !!!parse-error (type => 'not closed',
5279                                    value => $self->{open_elements}->[-1]->[0]                                    text => $self->{open_elements}->[-1]->[0]
5280                                        ->manakai_local_name,                                        ->manakai_local_name,
5281                                    token => $token);                                    token => $token);
5282                  } else {                  } else {
# Line 4519  sub _tree_construction_main ($) { Line 5293  sub _tree_construction_main ($) {
5293                  next B;                  next B;
5294                } elsif ($self->{insertion_mode} == IN_CELL_IM) {                } elsif ($self->{insertion_mode} == IN_CELL_IM) {
5295                  !!!cp ('t177');                  !!!cp ('t177');
5296                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5297                                    text => $token->{tag_name}, token => $token);
5298                  ## Ignore the token                  ## Ignore the token
5299                  !!!next-token;                  !!!next-token;
5300                  next B;                  next B;
# Line 4562  sub _tree_construction_main ($) { Line 5337  sub _tree_construction_main ($) {
5337    
5338                  !!!cp ('t182');                  !!!cp ('t182');
5339                  !!!parse-error (type => 'unmatched end tag',                  !!!parse-error (type => 'unmatched end tag',
5340                      value => $token->{tag_name}, token => $token);                      text => $token->{tag_name}, token => $token);
5341                  ## Ignore the token                  ## Ignore the token
5342                  !!!next-token;                  !!!next-token;
5343                  next B;                  next B;
5344                } # INSCOPE                } # INSCOPE
5345              } elsif ($token->{tag_name} eq 'table' and              } elsif ($token->{tag_name} eq 'table' and
5346                       $self->{insertion_mode} == IN_CAPTION_IM) {                       $self->{insertion_mode} == IN_CAPTION_IM) {
5347                !!!parse-error (type => 'not closed:caption', token => $token);                !!!parse-error (type => 'not closed', text => 'caption',
5348                                  token => $token);
5349    
5350                ## As if </caption>                ## As if </caption>
5351                ## have a table element in table scope                ## have a table element in table scope
# Line 4587  sub _tree_construction_main ($) { Line 5363  sub _tree_construction_main ($) {
5363                } # INSCOPE                } # INSCOPE
5364                unless (defined $i) {                unless (defined $i) {
5365                  !!!cp ('t186');                  !!!cp ('t186');
5366                  !!!parse-error (type => 'unmatched end tag:caption', token => $token);                  !!!parse-error (type => 'unmatched end tag',
5367                                    text => 'caption', token => $token);
5368                  ## Ignore the token                  ## Ignore the token
5369                  !!!next-token;                  !!!next-token;
5370                  next B;                  next B;
# Line 4602  sub _tree_construction_main ($) { Line 5379  sub _tree_construction_main ($) {
5379                unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {                unless ($self->{open_elements}->[-1]->[1] & CAPTION_EL) {
5380                  !!!cp ('t188');                  !!!cp ('t188');
5381                  !!!parse-error (type => 'not closed',                  !!!parse-error (type => 'not closed',
5382                                  value => $self->{open_elements}->[-1]->[0]                                  text => $self->{open_elements}->[-1]->[0]
5383                                      ->manakai_local_name,                                      ->manakai_local_name,
5384                                  token => $token);                                  token => $token);
5385                } else {                } else {
# Line 4622  sub _tree_construction_main ($) { Line 5399  sub _tree_construction_main ($) {
5399                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
5400                if ($self->{insertion_mode} & BODY_TABLE_IMS) {                if ($self->{insertion_mode} & BODY_TABLE_IMS) {
5401                  !!!cp ('t190');                  !!!cp ('t190');
5402                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5403                                    text => $token->{tag_name}, token => $token);
5404                  ## Ignore the token                  ## Ignore the token
5405                  !!!next-token;                  !!!next-token;
5406                  next B;                  next B;
# Line 4636  sub _tree_construction_main ($) { Line 5414  sub _tree_construction_main ($) {
5414                       }->{$token->{tag_name}} and                       }->{$token->{tag_name}} and
5415                       $self->{insertion_mode} == IN_CAPTION_IM) {                       $self->{insertion_mode} == IN_CAPTION_IM) {
5416                !!!cp ('t192');                !!!cp ('t192');
5417                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
5418                                  text => $token->{tag_name}, token => $token);
5419                ## Ignore the token                ## Ignore the token
5420                !!!next-token;                !!!next-token;
5421                next B;                next B;
# Line 4676  sub _tree_construction_main ($) { Line 5455  sub _tree_construction_main ($) {
5455            }            }
5456          }          }
5457    
5458              !!!parse-error (type => 'in table:#character', token => $token);          !!!parse-error (type => 'in table:#text', token => $token);
5459    
5460              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
5461              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
# Line 4727  sub _tree_construction_main ($) { Line 5506  sub _tree_construction_main ($) {
5506          !!!next-token;          !!!next-token;
5507          next B;          next B;
5508        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
5509              if ({          if ({
5510                   tr => ($self->{insertion_mode} != IN_ROW_IM),               tr => ($self->{insertion_mode} != IN_ROW_IM),
5511                   th => 1, td => 1,               th => 1, td => 1,
5512                  }->{$token->{tag_name}}) {              }->{$token->{tag_name}}) {
5513                if ($self->{insertion_mode} == IN_TABLE_IM) {            if ($self->{insertion_mode} == IN_TABLE_IM) {
5514                  ## Clear back to table context              ## Clear back to table context
5515                  while (not ($self->{open_elements}->[-1]->[1]              while (not ($self->{open_elements}->[-1]->[1]
5516                                  & TABLE_SCOPING_EL)) {                              & TABLE_SCOPING_EL)) {
5517                    !!!cp ('t201');                !!!cp ('t201');
5518                    pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
5519                  }              }
5520                                
5521                  !!!insert-element ('tbody',, $token);              !!!insert-element ('tbody',, $token);
5522                  $self->{insertion_mode} = IN_TABLE_BODY_IM;              $self->{insertion_mode} = IN_TABLE_BODY_IM;
5523                  ## reprocess in the "in table body" insertion mode...              ## reprocess in the "in table body" insertion mode...
5524                }            }
5525              
5526                if ($self->{insertion_mode} == IN_TABLE_BODY_IM) {            if ($self->{insertion_mode} == IN_TABLE_BODY_IM) {
5527                  unless ($token->{tag_name} eq 'tr') {              unless ($token->{tag_name} eq 'tr') {
5528                    !!!cp ('t202');                !!!cp ('t202');
5529                    !!!parse-error (type => 'missing start tag:tr', token => $token);                !!!parse-error (type => 'missing start tag:tr', token => $token);
5530                  }              }
5531                                    
5532                  ## Clear back to table body context              ## Clear back to table body context
5533                  while (not ($self->{open_elements}->[-1]->[1]              while (not ($self->{open_elements}->[-1]->[1]
5534                                  & TABLE_ROWS_SCOPING_EL)) {                              & TABLE_ROWS_SCOPING_EL)) {
5535                    !!!cp ('t203');                !!!cp ('t203');
5536                    ## ISSUE: Can this case be reached?                ## ISSUE: Can this case be reached?
5537                    pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
5538                  }              }
5539                                    
5540                  $self->{insertion_mode} = IN_ROW_IM;                  $self->{insertion_mode} = IN_ROW_IM;
5541                  if ($token->{tag_name} eq 'tr') {                  if ($token->{tag_name} eq 'tr') {
# Line 4812  sub _tree_construction_main ($) { Line 5591  sub _tree_construction_main ($) {
5591                  unless (defined $i) {                  unless (defined $i) {
5592                    !!!cp ('t210');                    !!!cp ('t210');
5593  ## TODO: This type is wrong.  ## TODO: This type is wrong.
5594                    !!!parse-error (type => 'unmacthed end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmacthed end tag',
5595                                      text => $token->{tag_name}, token => $token);
5596                    ## Ignore the token                    ## Ignore the token
5597                    !!!nack ('t210.1');                    !!!nack ('t210.1');
5598                    !!!next-token;                    !!!next-token;
# Line 4856  sub _tree_construction_main ($) { Line 5636  sub _tree_construction_main ($) {
5636                  } # INSCOPE                  } # INSCOPE
5637                  unless (defined $i) {                  unless (defined $i) {
5638                    !!!cp ('t216');                    !!!cp ('t216');
5639  ## TODO: This erorr type ios wrong.  ## TODO: This erorr type is wrong.
5640                    !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5641                                      text => $token->{tag_name}, token => $token);
5642                    ## Ignore the token                    ## Ignore the token
5643                    !!!nack ('t216.1');                    !!!nack ('t216.1');
5644                    !!!next-token;                    !!!next-token;
# Line 4932  sub _tree_construction_main ($) { Line 5713  sub _tree_construction_main ($) {
5713                }                }
5714              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
5715                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
5716                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
5717                                    ->manakai_local_name,                                    ->manakai_local_name,
5718                                token => $token);                                token => $token);
5719    
# Line 4953  sub _tree_construction_main ($) { Line 5734  sub _tree_construction_main ($) {
5734                unless (defined $i) {                unless (defined $i) {
5735                  !!!cp ('t223');                  !!!cp ('t223');
5736  ## TODO: The following is wrong, maybe.  ## TODO: The following is wrong, maybe.
5737                  !!!parse-error (type => 'unmatched end tag:table', token => $token);                  !!!parse-error (type => 'unmatched end tag', text => 'table',
5738                                    token => $token);
5739                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
5740                  !!!nack ('t223.1');                  !!!nack ('t223.1');
5741                  !!!next-token;                  !!!next-token;
5742                  next B;                  next B;
5743                }                }
5744                                
5745  ## TODO: Followings are removed from the latest spec.  ## TODO: Followings are removed from the latest spec.
5746                ## generate implied end tags                ## generate implied end tags
5747                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
5748                  !!!cp ('t224');                  !!!cp ('t224');
# Line 4971  sub _tree_construction_main ($) { Line 5753  sub _tree_construction_main ($) {
5753                  !!!cp ('t225');                  !!!cp ('t225');
5754                  ## NOTE: |<table><tr><table>|                  ## NOTE: |<table><tr><table>|
5755                  !!!parse-error (type => 'not closed',                  !!!parse-error (type => 'not closed',
5756                                  value => $self->{open_elements}->[-1]->[0]                                  text => $self->{open_elements}->[-1]->[0]
5757                                      ->manakai_local_name,                                      ->manakai_local_name,
5758                                  token => $token);                                  token => $token);
5759                } else {                } else {
# Line 5012  sub _tree_construction_main ($) { Line 5794  sub _tree_construction_main ($) {
5794                my $type = lc $token->{attributes}->{type}->{value};                my $type = lc $token->{attributes}->{type}->{value};
5795                if ($type eq 'hidden') {                if ($type eq 'hidden') {
5796                  !!!cp ('t227.3');                  !!!cp ('t227.3');
5797                  !!!parse-error (type => 'in table:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'in table',
5798                                    text => $token->{tag_name}, token => $token);
5799    
5800                  !!!insert-element ($token->{tag_name}, $token->{attributes}, $token);                  !!!insert-element ($token->{tag_name}, $token->{attributes}, $token);
5801    
# Line 5040  sub _tree_construction_main ($) { Line 5823  sub _tree_construction_main ($) {
5823            #            #
5824          }          }
5825    
5826          !!!parse-error (type => 'in table:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'in table', text => $token->{tag_name},
5827                            token => $token);
5828    
5829          $insert = $insert_to_foster;          $insert = $insert_to_foster;
5830          #          #
# Line 5062  sub _tree_construction_main ($) { Line 5846  sub _tree_construction_main ($) {
5846                } # INSCOPE                } # INSCOPE
5847                unless (defined $i) {                unless (defined $i) {
5848                  !!!cp ('t230');                  !!!cp ('t230');
5849                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5850                                    text => $token->{tag_name}, token => $token);
5851                  ## Ignore the token                  ## Ignore the token
5852                  !!!nack ('t230.1');                  !!!nack ('t230.1');
5853                  !!!next-token;                  !!!next-token;
# Line 5103  sub _tree_construction_main ($) { Line 5888  sub _tree_construction_main ($) {
5888                  unless (defined $i) {                  unless (defined $i) {
5889                    !!!cp ('t235');                    !!!cp ('t235');
5890  ## TODO: The following is wrong.  ## TODO: The following is wrong.
5891                    !!!parse-error (type => 'unmatched end tag:'.$token->{type}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5892                                      text => $token->{type}, token => $token);
5893                    ## Ignore the token                    ## Ignore the token
5894                    !!!nack ('t236.1');                    !!!nack ('t236.1');
5895                    !!!next-token;                    !!!next-token;
# Line 5139  sub _tree_construction_main ($) { Line 5925  sub _tree_construction_main ($) {
5925                  } # INSCOPE                  } # INSCOPE
5926                  unless (defined $i) {                  unless (defined $i) {
5927                    !!!cp ('t239');                    !!!cp ('t239');
5928                    !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                    !!!parse-error (type => 'unmatched end tag',
5929                                      text => $token->{tag_name}, token => $token);
5930                    ## Ignore the token                    ## Ignore the token
5931                    !!!nack ('t239.1');                    !!!nack ('t239.1');
5932                    !!!next-token;                    !!!next-token;
# Line 5185  sub _tree_construction_main ($) { Line 5972  sub _tree_construction_main ($) {
5972                } # INSCOPE                } # INSCOPE
5973                unless (defined $i) {                unless (defined $i) {
5974                  !!!cp ('t243');                  !!!cp ('t243');
5975                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
5976                                    text => $token->{tag_name}, token => $token);
5977                  ## Ignore the token                  ## Ignore the token
5978                  !!!nack ('t243.1');                  !!!nack ('t243.1');
5979                  !!!next-token;                  !!!next-token;
# Line 5219  sub _tree_construction_main ($) { Line 6007  sub _tree_construction_main ($) {
6007                  } # INSCOPE                  } # INSCOPE
6008                    unless (defined $i) {                    unless (defined $i) {
6009                      !!!cp ('t249');                      !!!cp ('t249');
6010                      !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                      !!!parse-error (type => 'unmatched end tag',
6011                                        text => $token->{tag_name}, token => $token);
6012                      ## Ignore the token                      ## Ignore the token
6013                      !!!nack ('t249.1');                      !!!nack ('t249.1');
6014                      !!!next-token;                      !!!next-token;
# Line 5242  sub _tree_construction_main ($) { Line 6031  sub _tree_construction_main ($) {
6031                  } # INSCOPE                  } # INSCOPE
6032                    unless (defined $i) {                    unless (defined $i) {
6033                      !!!cp ('t252');                      !!!cp ('t252');
6034                      !!!parse-error (type => 'unmatched end tag:tr', token => $token);                      !!!parse-error (type => 'unmatched end tag',
6035                                        text => 'tr', token => $token);
6036                      ## Ignore the token                      ## Ignore the token
6037                      !!!nack ('t252.1');                      !!!nack ('t252.1');
6038                      !!!next-token;                      !!!next-token;
# Line 5277  sub _tree_construction_main ($) { Line 6067  sub _tree_construction_main ($) {
6067                } # INSCOPE                } # INSCOPE
6068                unless (defined $i) {                unless (defined $i) {
6069                  !!!cp ('t256');                  !!!cp ('t256');
6070                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                  !!!parse-error (type => 'unmatched end tag',
6071                                    text => $token->{tag_name}, token => $token);
6072                  ## Ignore the token                  ## Ignore the token
6073                  !!!nack ('t256.1');                  !!!nack ('t256.1');
6074                  !!!next-token;                  !!!next-token;
# Line 5304  sub _tree_construction_main ($) { Line 6095  sub _tree_construction_main ($) {
6095                        tbody => 1, tfoot => 1, thead => 1, # $self->{insertion_mode} == IN_TABLE_IM                        tbody => 1, tfoot => 1, thead => 1, # $self->{insertion_mode} == IN_TABLE_IM
6096                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
6097            !!!cp ('t258');            !!!cp ('t258');
6098            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
6099                              text => $token->{tag_name}, token => $token);
6100            ## Ignore the token            ## Ignore the token
6101            !!!nack ('t258.1');            !!!nack ('t258.1');
6102             !!!next-token;             !!!next-token;
6103            next B;            next B;
6104          } else {          } else {
6105            !!!cp ('t259');            !!!cp ('t259');
6106            !!!parse-error (type => 'in table:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in table:/',
6107                              text => $token->{tag_name}, token => $token);
6108    
6109            $insert = $insert_to_foster;            $insert = $insert_to_foster;
6110            #            #
# Line 5361  sub _tree_construction_main ($) { Line 6154  sub _tree_construction_main ($) {
6154              if ($token->{tag_name} eq 'colgroup') {              if ($token->{tag_name} eq 'colgroup') {
6155                if ($self->{open_elements}->[-1]->[1] & HTML_EL) {                if ($self->{open_elements}->[-1]->[1] & HTML_EL) {
6156                  !!!cp ('t264');                  !!!cp ('t264');
6157                  !!!parse-error (type => 'unmatched end tag:colgroup', token => $token);                  !!!parse-error (type => 'unmatched end tag',
6158                                    text => 'colgroup', token => $token);
6159                  ## Ignore the token                  ## Ignore the token
6160                  !!!next-token;                  !!!next-token;
6161                  next B;                  next B;
# Line 5374  sub _tree_construction_main ($) { Line 6168  sub _tree_construction_main ($) {
6168                }                }
6169              } elsif ($token->{tag_name} eq 'col') {              } elsif ($token->{tag_name} eq 'col') {
6170                !!!cp ('t266');                !!!cp ('t266');
6171                !!!parse-error (type => 'unmatched end tag:col', token => $token);                !!!parse-error (type => 'unmatched end tag',
6172                                  text => 'col', token => $token);
6173                ## Ignore the token                ## Ignore the token
6174                !!!next-token;                !!!next-token;
6175                next B;                next B;
# Line 5404  sub _tree_construction_main ($) { Line 6199  sub _tree_construction_main ($) {
6199            if ($self->{open_elements}->[-1]->[1] & HTML_EL) {            if ($self->{open_elements}->[-1]->[1] & HTML_EL) {
6200              !!!cp ('t269');              !!!cp ('t269');
6201  ## TODO: Wrong error type?  ## TODO: Wrong error type?
6202              !!!parse-error (type => 'unmatched end tag:colgroup', token => $token);              !!!parse-error (type => 'unmatched end tag',
6203                                text => 'colgroup', token => $token);
6204              ## Ignore the token              ## Ignore the token
6205              !!!nack ('t269.1');              !!!nack ('t269.1');
6206              !!!next-token;              !!!next-token;
# Line 5458  sub _tree_construction_main ($) { Line 6254  sub _tree_construction_main ($) {
6254            !!!nack ('t277.1');            !!!nack ('t277.1');
6255            !!!next-token;            !!!next-token;
6256            next B;            next B;
6257          } elsif ($token->{tag_name} eq 'select' or          } elsif ({
6258                   $token->{tag_name} eq 'input' or                     select => 1, input => 1, textarea => 1,
6259                     }->{$token->{tag_name}} or
6260                   ($self->{insertion_mode} == IN_SELECT_IN_TABLE_IM and                   ($self->{insertion_mode} == IN_SELECT_IN_TABLE_IM and
6261                    {                    {
6262                     caption => 1, table => 1,                     caption => 1, table => 1,
# Line 5467  sub _tree_construction_main ($) { Line 6264  sub _tree_construction_main ($) {
6264                     tr => 1, td => 1, th => 1,                     tr => 1, td => 1, th => 1,
6265                    }->{$token->{tag_name}})) {                    }->{$token->{tag_name}})) {
6266            ## TODO: The type below is not good - <select> is replaced by </select>            ## TODO: The type below is not good - <select> is replaced by </select>
6267            !!!parse-error (type => 'not closed:select', token => $token);            !!!parse-error (type => 'not closed', text => 'select',
6268                              token => $token);
6269            ## NOTE: As if the token were </select> (<select> case) or            ## NOTE: As if the token were </select> (<select> case) or
6270            ## as if there were </select> (otherwise).            ## as if there were </select> (otherwise).
6271            ## have an element in table scope            ## have an element in table scope
# Line 5485  sub _tree_construction_main ($) { Line 6283  sub _tree_construction_main ($) {
6283            } # INSCOPE            } # INSCOPE
6284            unless (defined $i) {            unless (defined $i) {
6285              !!!cp ('t280');              !!!cp ('t280');
6286              !!!parse-error (type => 'unmatched end tag:select', token => $token);              !!!parse-error (type => 'unmatched end tag',
6287                                text => 'select', token => $token);
6288              ## Ignore the token              ## Ignore the token
6289              !!!nack ('t280.1');              !!!nack ('t280.1');
6290              !!!next-token;              !!!next-token;
# Line 5509  sub _tree_construction_main ($) { Line 6308  sub _tree_construction_main ($) {
6308            }            }
6309          } else {          } else {
6310            !!!cp ('t282');            !!!cp ('t282');
6311            !!!parse-error (type => 'in select:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in select',
6312                              text => $token->{tag_name}, token => $token);
6313            ## Ignore the token            ## Ignore the token
6314            !!!nack ('t282.1');            !!!nack ('t282.1');
6315            !!!next-token;            !!!next-token;
# Line 5527  sub _tree_construction_main ($) { Line 6327  sub _tree_construction_main ($) {
6327              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
6328            } else {            } else {
6329              !!!cp ('t285');              !!!cp ('t285');
6330              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6331                                text => $token->{tag_name}, token => $token);
6332              ## Ignore the token              ## Ignore the token
6333            }            }
6334            !!!nack ('t285.1');            !!!nack ('t285.1');
# Line 5539  sub _tree_construction_main ($) { Line 6340  sub _tree_construction_main ($) {
6340              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
6341            } else {            } else {
6342              !!!cp ('t287');              !!!cp ('t287');
6343              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6344                                text => $token->{tag_name}, token => $token);
6345              ## Ignore the token              ## Ignore the token
6346            }            }
6347            !!!nack ('t287.1');            !!!nack ('t287.1');
# Line 5561  sub _tree_construction_main ($) { Line 6363  sub _tree_construction_main ($) {
6363            } # INSCOPE            } # INSCOPE
6364            unless (defined $i) {            unless (defined $i) {
6365              !!!cp ('t290');              !!!cp ('t290');
6366              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6367                                text => $token->{tag_name}, token => $token);
6368              ## Ignore the token              ## Ignore the token
6369              !!!nack ('t290.1');              !!!nack ('t290.1');
6370              !!!next-token;              !!!next-token;
# Line 5582  sub _tree_construction_main ($) { Line 6385  sub _tree_construction_main ($) {
6385                    tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,                    tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,
6386                   }->{$token->{tag_name}}) {                   }->{$token->{tag_name}}) {
6387  ## TODO: The following is wrong?  ## TODO: The following is wrong?
6388            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
6389                              text => $token->{tag_name}, token => $token);
6390                                
6391            ## have an element in table scope            ## have an element in table scope
6392            my $i;            my $i;
# Line 5623  sub _tree_construction_main ($) { Line 6427  sub _tree_construction_main ($) {
6427            unless (defined $i) {            unless (defined $i) {
6428              !!!cp ('t297');              !!!cp ('t297');
6429  ## TODO: The following error type is correct?  ## TODO: The following error type is correct?
6430              !!!parse-error (type => 'unmatched end tag:select', token => $token);              !!!parse-error (type => 'unmatched end tag',
6431                                text => 'select', token => $token);
6432              ## Ignore the </select> token              ## Ignore the </select> token
6433              !!!nack ('t297.1');              !!!nack ('t297.1');
6434              !!!next-token; ## TODO: ok?              !!!next-token; ## TODO: ok?
# Line 5640  sub _tree_construction_main ($) { Line 6445  sub _tree_construction_main ($) {
6445            next B;            next B;
6446          } else {          } else {
6447            !!!cp ('t299');            !!!cp ('t299');
6448            !!!parse-error (type => 'in select:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'in select:/',
6449                              text => $token->{tag_name}, token => $token);
6450            ## Ignore the token            ## Ignore the token
6451            !!!nack ('t299.3');            !!!nack ('t299.3');
6452            !!!next-token;            !!!next-token;
# Line 5678  sub _tree_construction_main ($) { Line 6484  sub _tree_construction_main ($) {
6484                    
6485          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6486            !!!cp ('t301');            !!!cp ('t301');
6487            !!!parse-error (type => 'after html:#character', token => $token);            !!!parse-error (type => 'after html:#text', token => $token);
6488    
6489            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
6490          } else {          } else {
# Line 5686  sub _tree_construction_main ($) { Line 6492  sub _tree_construction_main ($) {
6492          }          }
6493                    
6494          ## "after body" insertion mode          ## "after body" insertion mode
6495          !!!parse-error (type => 'after body:#character', token => $token);          !!!parse-error (type => 'after body:#text', token => $token);
6496    
6497          $self->{insertion_mode} = IN_BODY_IM;          $self->{insertion_mode} = IN_BODY_IM;
6498          ## reprocess          ## reprocess
# Line 5694  sub _tree_construction_main ($) { Line 6500  sub _tree_construction_main ($) {
6500        } elsif ($token->{type} == START_TAG_TOKEN) {        } elsif ($token->{type} == START_TAG_TOKEN) {
6501          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6502            !!!cp ('t303');            !!!cp ('t303');
6503            !!!parse-error (type => 'after html:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after html',
6504                              text => $token->{tag_name}, token => $token);
6505                        
6506            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
6507          } else {          } else {
# Line 5702  sub _tree_construction_main ($) { Line 6509  sub _tree_construction_main ($) {
6509          }          }
6510    
6511          ## "after body" insertion mode          ## "after body" insertion mode
6512          !!!parse-error (type => 'after body:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'after body',
6513                            text => $token->{tag_name}, token => $token);
6514    
6515          $self->{insertion_mode} = IN_BODY_IM;          $self->{insertion_mode} = IN_BODY_IM;
6516          !!!ack-later;          !!!ack-later;
# Line 5711  sub _tree_construction_main ($) { Line 6519  sub _tree_construction_main ($) {
6519        } elsif ($token->{type} == END_TAG_TOKEN) {        } elsif ($token->{type} == END_TAG_TOKEN) {
6520          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {          if ($self->{insertion_mode} == AFTER_HTML_BODY_IM) {
6521            !!!cp ('t305');            !!!cp ('t305');
6522            !!!parse-error (type => 'after html:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after html:/',
6523                              text => $token->{tag_name}, token => $token);
6524                        
6525            $self->{insertion_mode} = AFTER_BODY_IM;            $self->{insertion_mode} = AFTER_BODY_IM;
6526            ## Reprocess in the "after body" insertion mode.            ## Reprocess in the "after body" insertion mode.
# Line 5723  sub _tree_construction_main ($) { Line 6532  sub _tree_construction_main ($) {
6532          if ($token->{tag_name} eq 'html') {          if ($token->{tag_name} eq 'html') {
6533            if (defined $self->{inner_html_node}) {            if (defined $self->{inner_html_node}) {
6534              !!!cp ('t307');              !!!cp ('t307');
6535              !!!parse-error (type => 'unmatched end tag:html', token => $token);              !!!parse-error (type => 'unmatched end tag',
6536                                text => 'html', token => $token);
6537              ## Ignore the token              ## Ignore the token
6538              !!!next-token;              !!!next-token;
6539              next B;              next B;
# Line 5735  sub _tree_construction_main ($) { Line 6545  sub _tree_construction_main ($) {
6545            }            }
6546          } else {          } else {
6547            !!!cp ('t309');            !!!cp ('t309');
6548            !!!parse-error (type => 'after body:/'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'after body:/',
6549                              text => $token->{tag_name}, token => $token);
6550    
6551            $self->{insertion_mode} = IN_BODY_IM;            $self->{insertion_mode} = IN_BODY_IM;
6552            ## reprocess            ## reprocess
# Line 5763  sub _tree_construction_main ($) { Line 6574  sub _tree_construction_main ($) {
6574          if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {          if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {
6575            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6576              !!!cp ('t311');              !!!cp ('t311');
6577              !!!parse-error (type => 'in frameset:#character', token => $token);              !!!parse-error (type => 'in frameset:#text', token => $token);
6578            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {            } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6579              !!!cp ('t312');              !!!cp ('t312');
6580              !!!parse-error (type => 'after frameset:#character', token => $token);              !!!parse-error (type => 'after frameset:#text', token => $token);
6581            } else { # "after html frameset"            } else { # "after after frameset"
6582              !!!cp ('t313');              !!!cp ('t313');
6583              !!!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);  
6584            }            }
6585                        
6586            ## Ignore the token.            ## Ignore the token.
# Line 5789  sub _tree_construction_main ($) { Line 6596  sub _tree_construction_main ($) {
6596                    
6597          die qq[$0: Character "$token->{data}"];          die qq[$0: Character "$token->{data}"];
6598        } 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');  
         }  
   
6599          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6600              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6601            !!!cp ('t318');            !!!cp ('t318');
# Line 5816  sub _tree_construction_main ($) { Line 6613  sub _tree_construction_main ($) {
6613            next B;            next B;
6614          } elsif ($token->{tag_name} eq 'noframes') {          } elsif ($token->{tag_name} eq 'noframes') {
6615            !!!cp ('t320');            !!!cp ('t320');
6616            ## NOTE: As if in body.            ## NOTE: As if in head.
6617            $parse_rcdata->(CDATA_CONTENT_MODEL);            $parse_rcdata->(CDATA_CONTENT_MODEL);
6618            next B;            next B;
6619    
6620              ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
6621              ## has no parse error.
6622          } else {          } else {
6623            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6624              !!!cp ('t321');              !!!cp ('t321');
6625              !!!parse-error (type => 'in frameset:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'in frameset',
6626            } else {                              text => $token->{tag_name}, token => $token);
6627              } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6628              !!!cp ('t322');              !!!cp ('t322');
6629              !!!parse-error (type => 'after frameset:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'after frameset',
6630                                text => $token->{tag_name}, token => $token);
6631              } else { # "after after frameset"
6632                !!!cp ('t322.2');
6633                !!!parse-error (type => 'after after frameset',
6634                                text => $token->{tag_name}, token => $token);
6635            }            }
6636            ## Ignore the token            ## Ignore the token
6637            !!!nack ('t322.1');            !!!nack ('t322.1');
# Line 5833  sub _tree_construction_main ($) { Line 6639  sub _tree_construction_main ($) {
6639            next B;            next B;
6640          }          }
6641        } 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');  
         }  
   
6642          if ($token->{tag_name} eq 'frameset' and          if ($token->{tag_name} eq 'frameset' and
6643              $self->{insertion_mode} == IN_FRAMESET_IM) {              $self->{insertion_mode} == IN_FRAMESET_IM) {
6644            if ($self->{open_elements}->[-1]->[1] & HTML_EL and            if ($self->{open_elements}->[-1]->[1] & HTML_EL and
6645                @{$self->{open_elements}} == 1) {                @{$self->{open_elements}} == 1) {
6646              !!!cp ('t325');              !!!cp ('t325');
6647              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
6648                                text => $token->{tag_name}, token => $token);
6649              ## Ignore the token              ## Ignore the token
6650              !!!next-token;              !!!next-token;
6651            } else {            } else {
# Line 5874  sub _tree_construction_main ($) { Line 6671  sub _tree_construction_main ($) {
6671          } else {          } else {
6672            if ($self->{insertion_mode} == IN_FRAMESET_IM) {            if ($self->{insertion_mode} == IN_FRAMESET_IM) {
6673              !!!cp ('t330');              !!!cp ('t330');
6674              !!!parse-error (type => 'in frameset:/'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'in frameset:/',
6675            } else {                              text => $token->{tag_name}, token => $token);
6676              } elsif ($self->{insertion_mode} == AFTER_FRAMESET_IM) {
6677                !!!cp ('t330.1');
6678                !!!parse-error (type => 'after frameset:/',
6679                                text => $token->{tag_name}, token => $token);
6680              } else { # "after after html"
6681              !!!cp ('t331');              !!!cp ('t331');
6682              !!!parse-error (type => 'after frameset:/'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'after after frameset:/',
6683                                text => $token->{tag_name}, token => $token);
6684            }            }
6685            ## Ignore the token            ## Ignore the token
6686            !!!next-token;            !!!next-token;
# Line 5931  sub _tree_construction_main ($) { Line 6734  sub _tree_construction_main ($) {
6734          my $meta_el = pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.          my $meta_el = pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
6735    
6736          unless ($self->{confident}) {          unless ($self->{confident}) {
6737            if ($token->{attributes}->{charset}) { ## TODO: And if supported            if ($token->{attributes}->{charset}) {
6738              !!!cp ('t335');              !!!cp ('t335');
6739                ## NOTE: Whether the encoding is supported or not is handled
6740                ## in the {change_encoding} callback.
6741              $self->{change_encoding}              $self->{change_encoding}
6742                  ->($self, $token->{attributes}->{charset}->{value}, $token);                  ->($self, $token->{attributes}->{charset}->{value}, $token);
6743                            
# Line 5941  sub _tree_construction_main ($) { Line 6746  sub _tree_construction_main ($) {
6746                                       $token->{attributes}->{charset}                                       $token->{attributes}->{charset}
6747                                           ->{has_reference});                                           ->{has_reference});
6748            } elsif ($token->{attributes}->{content}) {            } elsif ($token->{attributes}->{content}) {
             ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.  
6749              if ($token->{attributes}->{content}->{value}              if ($token->{attributes}->{content}->{value}
6750                  =~ /\A[^;]*;[\x09-\x0D\x20]*[Cc][Hh][Aa][Rr][Ss][Ee][Tt]                  =~ /[Cc][Hh][Aa][Rr][Ss][Ee][Tt]
6751                      [\x09-\x0D\x20]*=                      [\x09-\x0D\x20]*=
6752                      [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|                      [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
6753                      ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {                      ([^"'\x09-\x0D\x20][^\x09-\x0D\x20\x3B]*))/x) {
6754                !!!cp ('t336');                !!!cp ('t336');
6755                  ## NOTE: Whether the encoding is supported or not is handled
6756                  ## in the {change_encoding} callback.
6757                $self->{change_encoding}                $self->{change_encoding}
6758                    ->($self, defined $1 ? $1 : defined $2 ? $2 : $3, $token);                    ->($self, defined $1 ? $1 : defined $2 ? $2 : $3, $token);
6759                $meta_el->[0]->get_attribute_node_ns (undef, 'content')                $meta_el->[0]->get_attribute_node_ns (undef, 'content')
# Line 5982  sub _tree_construction_main ($) { Line 6788  sub _tree_construction_main ($) {
6788          $parse_rcdata->(RCDATA_CONTENT_MODEL);          $parse_rcdata->(RCDATA_CONTENT_MODEL);
6789          next B;          next B;
6790        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
6791          !!!parse-error (type => 'in body:body', token => $token);          !!!parse-error (type => 'in body', text => 'body', token => $token);
6792                                
6793          if (@{$self->{open_elements}} == 1 or          if (@{$self->{open_elements}} == 1 or
6794              not ($self->{open_elements}->[1]->[1] & BODY_EL)) {              not ($self->{open_elements}->[1]->[1] & BODY_EL)) {
# Line 6102  sub _tree_construction_main ($) { Line 6908  sub _tree_construction_main ($) {
6908              if ($i != -1) {              if ($i != -1) {
6909                !!!cp ('t355');                !!!cp ('t355');
6910                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
6911                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
6912                                    ->manakai_local_name,                                    ->manakai_local_name,
6913                                token => $token);                                token => $token);
6914              } else {              } else {
# Line 6256  sub _tree_construction_main ($) { Line 7062  sub _tree_construction_main ($) {
7062                  xmp => 1,                  xmp => 1,
7063                  iframe => 1,                  iframe => 1,
7064                  noembed => 1,                  noembed => 1,
7065                  noframes => 1,                  noframes => 1, ## NOTE: This is an "as if in head" code clone.
7066                  noscript => 0, ## TODO: 1 if scripting is enabled                  noscript => 0, ## TODO: 1 if scripting is enabled
7067                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7068          if ($token->{tag_name} eq 'xmp') {          if ($token->{tag_name} eq 'xmp') {
# Line 6278  sub _tree_construction_main ($) { Line 7084  sub _tree_construction_main ($) {
7084            !!!next-token;            !!!next-token;
7085            next B;            next B;
7086          } else {          } else {
7087              !!!ack ('t391.1');
7088    
7089            my $at = $token->{attributes};            my $at = $token->{attributes};
7090            my $form_attrs;            my $form_attrs;
7091            $form_attrs->{action} = $at->{action} if $at->{action};            $form_attrs->{action} = $at->{action} if $at->{action};
# Line 6321  sub _tree_construction_main ($) { Line 7129  sub _tree_construction_main ($) {
7129                           line => $token->{line}, column => $token->{column}},                           line => $token->{line}, column => $token->{column}},
7130                          {type => END_TAG_TOKEN, tag_name => 'form',                          {type => END_TAG_TOKEN, tag_name => 'form',
7131                           line => $token->{line}, column => $token->{column}};                           line => $token->{line}, column => $token->{column}};
           !!!nack ('t391.1'); ## NOTE: Not acknowledged.  
7132            !!!back-token (@tokens);            !!!back-token (@tokens);
7133            !!!next-token;            !!!next-token;
7134            next B;            next B;
# Line 6369  sub _tree_construction_main ($) { Line 7176  sub _tree_construction_main ($) {
7176            ## Ignore the token            ## Ignore the token
7177          } else {          } else {
7178            !!!cp ('t398');            !!!cp ('t398');
7179            !!!parse-error (type => 'in RCDATA:#'.$token->{type}, token => $token);            !!!parse-error (type => 'in RCDATA:#eof', token => $token);
7180          }          }
7181          !!!next-token;          !!!next-token;
7182          next B;          next B;
7183          } elsif ($token->{tag_name} eq 'rt' or
7184                   $token->{tag_name} eq 'rp') {
7185            ## has a |ruby| element in scope
7186            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
7187              my $node = $self->{open_elements}->[$_];
7188              if ($node->[1] & RUBY_EL) {
7189                !!!cp ('t398.1');
7190                ## generate implied end tags
7191                while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
7192                  !!!cp ('t398.2');
7193                  pop @{$self->{open_elements}};
7194                }
7195                unless ($self->{open_elements}->[-1]->[1] & RUBY_EL) {
7196                  !!!cp ('t398.3');
7197                  !!!parse-error (type => 'not closed',
7198                                  text => $self->{open_elements}->[-1]->[0]
7199                                      ->manakai_local_name,
7200                                  token => $token);
7201                  pop @{$self->{open_elements}}
7202                      while not $self->{open_elements}->[-1]->[1] & RUBY_EL;
7203                }
7204                last INSCOPE;
7205              } elsif ($node->[1] & SCOPING_EL) {
7206                !!!cp ('t398.4');
7207                last INSCOPE;
7208              }
7209            } # INSCOPE
7210    
7211            !!!insert-element-t ($token->{tag_name}, $token->{attributes}, $token);
7212    
7213            !!!nack ('t398.5');
7214            !!!next-token;
7215            redo B;
7216        } elsif ($token->{tag_name} eq 'math' or        } elsif ($token->{tag_name} eq 'math' or
7217                 $token->{tag_name} eq 'svg') {                 $token->{tag_name} eq 'svg') {
7218          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
7219    
7220            ## "Adjust MathML attributes" ('math' only) - done in insert-element-f
7221    
7222            ## "adjust SVG attributes" ('svg' only) - done in insert-element-f
7223    
7224            ## "adjust foreign attributes" - done in insert-element-f
7225                    
7226          !!!insert-element-f ($token->{tag_name} eq 'math' ? $MML_NS : $SVG_NS, $token);          !!!insert-element-f ($token->{tag_name} eq 'math' ? $MML_NS : $SVG_NS, $token->{tag_name}, $token->{attributes}, $token);
7227                    
7228          if ($self->{self_closing}) {          if ($self->{self_closing}) {
7229            pop @{$self->{open_elements}};            pop @{$self->{open_elements}};
# Line 6399  sub _tree_construction_main ($) { Line 7245  sub _tree_construction_main ($) {
7245                  thead => 1, tr => 1,                  thead => 1, tr => 1,
7246                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7247          !!!cp ('t401');          !!!cp ('t401');
7248          !!!parse-error (type => 'in body:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'in body',
7249                            text => $token->{tag_name}, token => $token);
7250          ## Ignore the token          ## Ignore the token
7251          !!!nack ('t401.1'); ## NOTE: |<col/>| or |<frame/>| here is an error.          !!!nack ('t401.1'); ## NOTE: |<col/>| or |<frame/>| here is an error.
7252          !!!next-token;          !!!next-token;
# Line 6484  sub _tree_construction_main ($) { Line 7331  sub _tree_construction_main ($) {
7331            }            }
7332    
7333            !!!parse-error (type => 'start tag not allowed',            !!!parse-error (type => 'start tag not allowed',
7334                            value => $token->{tag_name}, token => $token);                            text => $token->{tag_name}, token => $token);
7335            ## NOTE: Ignore the token.            ## NOTE: Ignore the token.
7336            !!!next-token;            !!!next-token;
7337            next B;            next B;
# Line 6494  sub _tree_construction_main ($) { Line 7341  sub _tree_construction_main ($) {
7341            unless ($_->[1] & ALL_END_TAG_OPTIONAL_EL) {            unless ($_->[1] & ALL_END_TAG_OPTIONAL_EL) {
7342              !!!cp ('t403');              !!!cp ('t403');
7343              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7344                              value => $_->[0]->manakai_local_name,                              text => $_->[0]->manakai_local_name,
7345                              token => $token);                              token => $token);
7346              last;              last;
7347            } else {            } else {
# Line 6514  sub _tree_construction_main ($) { Line 7361  sub _tree_construction_main ($) {
7361            unless ($self->{open_elements}->[-1]->[1] & BODY_EL) {            unless ($self->{open_elements}->[-1]->[1] & BODY_EL) {
7362              !!!cp ('t406');              !!!cp ('t406');
7363              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7364                              value => $self->{open_elements}->[1]->[0]                              text => $self->{open_elements}->[1]->[0]
7365                                  ->manakai_local_name,                                  ->manakai_local_name,
7366                              token => $token);                              token => $token);
7367            } else {            } else {
# Line 6525  sub _tree_construction_main ($) { Line 7372  sub _tree_construction_main ($) {
7372            next B;            next B;
7373          } else {          } else {
7374            !!!cp ('t408');            !!!cp ('t408');
7375            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7376                              text => $token->{tag_name}, token => $token);
7377            ## Ignore the token            ## Ignore the token
7378            !!!next-token;            !!!next-token;
7379            next B;            next B;
# Line 6553  sub _tree_construction_main ($) { Line 7401  sub _tree_construction_main ($) {
7401    
7402          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7403            !!!cp ('t413');            !!!cp ('t413');
7404            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7405                              text => $token->{tag_name}, token => $token);
7406              ## NOTE: Ignore the token.
7407          } else {          } else {
7408            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7409            while ({            while ({
7410                      ## END_TAG_OPTIONAL_EL
7411                    dd => ($token->{tag_name} ne 'dd'),                    dd => ($token->{tag_name} ne 'dd'),
7412                    dt => ($token->{tag_name} ne 'dt'),                    dt => ($token->{tag_name} ne 'dt'),
7413                    li => ($token->{tag_name} ne 'li'),                    li => ($token->{tag_name} ne 'li'),
7414                    p => 1,                    p => 1,
7415                      rt => 1,
7416                      rp => 1,
7417                   }->{$self->{open_elements}->[-1]->[0]->manakai_local_name}) {                   }->{$self->{open_elements}->[-1]->[0]->manakai_local_name}) {
7418              !!!cp ('t409');              !!!cp ('t409');
7419              pop @{$self->{open_elements}};              pop @{$self->{open_elements}};
# Line 6571  sub _tree_construction_main ($) { Line 7424  sub _tree_construction_main ($) {
7424                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7425              !!!cp ('t412');              !!!cp ('t412');
7426              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7427                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7428                                  ->manakai_local_name,                                  ->manakai_local_name,
7429                              token => $token);                              token => $token);
7430            } else {            } else {
# Line 6608  sub _tree_construction_main ($) { Line 7461  sub _tree_construction_main ($) {
7461    
7462          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7463            !!!cp ('t421');            !!!cp ('t421');
7464            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7465                              text => $token->{tag_name}, token => $token);
7466              ## NOTE: Ignore the token.
7467          } else {          } else {
7468            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7469            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 6621  sub _tree_construction_main ($) { Line 7476  sub _tree_construction_main ($) {
7476                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7477              !!!cp ('t417.1');              !!!cp ('t417.1');
7478              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7479                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7480                                  ->manakai_local_name,                                  ->manakai_local_name,
7481                              token => $token);                              token => $token);
7482            } else {            } else {
# Line 6653  sub _tree_construction_main ($) { Line 7508  sub _tree_construction_main ($) {
7508    
7509          unless (defined $i) { # has an element in scope          unless (defined $i) { # has an element in scope
7510            !!!cp ('t425.1');            !!!cp ('t425.1');
7511            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7512                              text => $token->{tag_name}, token => $token);
7513              ## NOTE: Ignore the token.
7514          } else {          } else {
7515            ## Step 1. generate implied end tags            ## Step 1. generate implied end tags
7516            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {            while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
# Line 6665  sub _tree_construction_main ($) { Line 7522  sub _tree_construction_main ($) {
7522            if ($self->{open_elements}->[-1]->[0]->manakai_local_name            if ($self->{open_elements}->[-1]->[0]->manakai_local_name
7523                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7524              !!!cp ('t425');              !!!cp ('t425');
7525              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);              !!!parse-error (type => 'unmatched end tag',
7526                                text => $token->{tag_name}, token => $token);
7527            } else {            } else {
7528              !!!cp ('t426');              !!!cp ('t426');
7529            }            }
# Line 6696  sub _tree_construction_main ($) { Line 7554  sub _tree_construction_main ($) {
7554                    ne $token->{tag_name}) {                    ne $token->{tag_name}) {
7555              !!!cp ('t412.1');              !!!cp ('t412.1');
7556              !!!parse-error (type => 'not closed',              !!!parse-error (type => 'not closed',
7557                              value => $self->{open_elements}->[-1]->[0]                              text => $self->{open_elements}->[-1]->[0]
7558                                  ->manakai_local_name,                                  ->manakai_local_name,
7559                              token => $token);                              token => $token);
7560            } else {            } else {
# Line 6706  sub _tree_construction_main ($) { Line 7564  sub _tree_construction_main ($) {
7564            splice @{$self->{open_elements}}, $i;            splice @{$self->{open_elements}}, $i;
7565          } else {          } else {
7566            !!!cp ('t413.1');            !!!cp ('t413.1');
7567            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);            !!!parse-error (type => 'unmatched end tag',
7568                              text => $token->{tag_name}, token => $token);
7569    
7570            !!!cp ('t415.1');            !!!cp ('t415.1');
7571            ## As if <p>, then reprocess the current token            ## As if <p>, then reprocess the current token
# Line 6729  sub _tree_construction_main ($) { Line 7588  sub _tree_construction_main ($) {
7588          next B;          next B;
7589        } elsif ($token->{tag_name} eq 'br') {        } elsif ($token->{tag_name} eq 'br') {
7590          !!!cp ('t428');          !!!cp ('t428');
7591          !!!parse-error (type => 'unmatched end tag:br', token => $token);          !!!parse-error (type => 'unmatched end tag',
7592                            text => 'br', token => $token);
7593    
7594          ## As if <br>          ## As if <br>
7595          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
# Line 6754  sub _tree_construction_main ($) { Line 7614  sub _tree_construction_main ($) {
7614                  noscript => 0, ## TODO: if scripting is enabled                  noscript => 0, ## TODO: if scripting is enabled
7615                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
7616          !!!cp ('t429');          !!!cp ('t429');
7617          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);          !!!parse-error (type => 'unmatched end tag',
7618                            text => $token->{tag_name}, token => $token);
7619          ## Ignore the token          ## Ignore the token
7620          !!!next-token;          !!!next-token;
7621          next B;          next B;
# Line 6773  sub _tree_construction_main ($) { Line 7634  sub _tree_construction_main ($) {
7634              ## generate implied end tags              ## generate implied end tags
7635              while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {              while ($self->{open_elements}->[-1]->[1] & END_TAG_OPTIONAL_EL) {
7636                !!!cp ('t430');                !!!cp ('t430');
7637                ## ISSUE: Can this case be reached?                ## NOTE: |<ruby><rt></ruby>|.
7638                  ## ISSUE: <ruby><rt></rt> will also take this code path,
7639                  ## which seems wrong.
7640                pop @{$self->{open_elements}};                pop @{$self->{open_elements}};
7641                  $node_i++;
7642              }              }
7643                    
7644              ## Step 2              ## Step 2
# Line 6783  sub _tree_construction_main ($) { Line 7647  sub _tree_construction_main ($) {
7647                !!!cp ('t431');                !!!cp ('t431');
7648                ## NOTE: <x><y></x>                ## NOTE: <x><y></x>
7649                !!!parse-error (type => 'not closed',                !!!parse-error (type => 'not closed',
7650                                value => $self->{open_elements}->[-1]->[0]                                text => $self->{open_elements}->[-1]->[0]
7651                                    ->manakai_local_name,                                    ->manakai_local_name,
7652                                token => $token);                                token => $token);
7653              } else {              } else {
# Line 6791  sub _tree_construction_main ($) { Line 7655  sub _tree_construction_main ($) {
7655              }              }
7656                            
7657              ## Step 3              ## Step 3
7658              splice @{$self->{open_elements}}, $node_i;              splice @{$self->{open_elements}}, $node_i if $node_i < 0;
7659    
7660              !!!next-token;              !!!next-token;
7661              last S2;              last S2;
# Line 6802  sub _tree_construction_main ($) { Line 7666  sub _tree_construction_main ($) {
7666                  ($node->[1] & SPECIAL_EL or                  ($node->[1] & SPECIAL_EL or
7667                   $node->[1] & SCOPING_EL)) {                   $node->[1] & SCOPING_EL)) {
7668                !!!cp ('t433');                !!!cp ('t433');
7669                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name}, token => $token);                !!!parse-error (type => 'unmatched end tag',
7670                                  text => $token->{tag_name}, token => $token);
7671                ## Ignore the token                ## Ignore the token
7672                !!!next-token;                !!!next-token;
7673                last S2;                last S2;
# Line 6848  sub _tree_construction_main ($) { Line 7713  sub _tree_construction_main ($) {
7713    ## TODO: script stuffs    ## TODO: script stuffs
7714  } # _tree_construct_main  } # _tree_construct_main
7715    
7716  sub set_inner_html ($$$) {  sub set_inner_html ($$$;$) {
7717    my $class = shift;    my $class = shift;
7718    my $node = shift;    my $node = shift;
7719    my $s = \$_[0];    my $s = \$_[0];
7720    my $onerror = $_[1];    my $onerror = $_[1];
7721      my $get_wrapper = $_[2] || sub ($) { return $_[0] };
7722    
7723    ## ISSUE: Should {confident} be true?    ## ISSUE: Should {confident} be true?
7724    
# Line 6871  sub set_inner_html ($$$) { Line 7737  sub set_inner_html ($$$) {
7737      }      }
7738    
7739      ## Step 3, 4, 5 # MUST      ## Step 3, 4, 5 # MUST
7740      $class->parse_string ($$s => $node, $onerror);      $class->parse_char_string ($$s => $node, $onerror, $get_wrapper);
7741    } elsif ($nt == 1) {    } elsif ($nt == 1) {
7742      ## TODO: If non-html element      ## TODO: If non-html element
7743    
7744      ## NOTE: Most of this code is copied from |parse_string|      ## NOTE: Most of this code is copied from |parse_string|
7745    
7746    ## TODO: Support for $get_wrapper
7747    
7748      ## Step 1 # MUST      ## Step 1 # MUST
7749      my $this_doc = $node->owner_document;      my $this_doc = $node->owner_document;
7750      my $doc = $this_doc->implementation->create_document;      my $doc = $this_doc->implementation->create_document;
# Line 6917  sub set_inner_html ($$$) { Line 7785  sub set_inner_html ($$$) {
7785          !!!cp ('i4');          !!!cp ('i4');
7786          !!!parse-error (type => 'NULL');          !!!parse-error (type => 'NULL');
7787          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST          $self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
7788          } elsif ($self->{next_char} <= 0x0008 or
7789                   (0x000E <= $self->{next_char} and
7790                    $self->{next_char} <= 0x001F) or
7791                   (0x007F <= $self->{next_char} and
7792                    $self->{next_char} <= 0x009F) or
7793                   (0xD800 <= $self->{next_char} and
7794                    $self->{next_char} <= 0xDFFF) or
7795                   (0xFDD0 <= $self->{next_char} and
7796                    $self->{next_char} <= 0xFDDF) or
7797                   {
7798                    0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
7799                    0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
7800                    0x4FFFE => 1, 0x4FFFF => 1, 0x5FFFE => 1, 0x5FFFF => 1,
7801                    0x6FFFE => 1, 0x6FFFF => 1, 0x7FFFE => 1, 0x7FFFF => 1,
7802                    0x8FFFE => 1, 0x8FFFF => 1, 0x9FFFE => 1, 0x9FFFF => 1,
7803                    0xAFFFE => 1, 0xAFFFF => 1, 0xBFFFE => 1, 0xBFFFF => 1,
7804                    0xCFFFE => 1, 0xCFFFF => 1, 0xDFFFE => 1, 0xDFFFF => 1,
7805                    0xEFFFE => 1, 0xEFFFF => 1, 0xFFFFE => 1, 0xFFFFF => 1,
7806                    0x10FFFE => 1, 0x10FFFF => 1,
7807                   }->{$self->{next_char}}) {
7808            !!!cp ('i4.1');
7809            if ($self->{next_char} < 0x10000) {
7810              !!!parse-error (type => 'control char',
7811                              text => (sprintf 'U+%04X', $self->{next_char}));
7812            } else {
7813              !!!parse-error (type => 'control char',
7814                              text => (sprintf 'U-%08X', $self->{next_char}));
7815            }
7816        }        }
7817      };      };
7818      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7819      $p->{next_char} = -1;      $p->{next_char} = -1;
7820        
7821        $p->{getc_until} = sub {
7822          ## TODO: ...
7823          return undef;
7824        }; # $p->{getc_until};
7825    
7826      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7827        my (%opt) = @_;        my (%opt) = @_;
7828        my $line = $opt{line};        my $line = $opt{line};

Legend:
Removed from v.1.129  
changed lines
  Added in v.1.171

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24