#!/usr/bin/perl
# Payload for tests/36-libxml-sax-base-perl.test. Prints one tagged line per
# measurement (R<n>-<name> <value>) plus ALL-SAXBASE-OK when every internal
# check held, so the .test can both gate on the whole and compare each value by
# name.
#
# XML::SAX::Base is not a parser and parses nothing: it is the DISPATCHER every
# SAX driver and filter inherits. Its whole contract is that an event handed to
# a filter arrives at the far end of the chain -- in order, unchanged, and at
# the right handler slot -- without the filter having implemented the callback.
# So what this payload measures is a hand-built event stream driven through a
# two-stage filter chain into a recording sink: what arrives, in what order,
# which of it the filters rewrote, and which slot each event was routed to.
#
# Everything printed is ASCII and single-line: this runs on an xterm.js console
# read back through a tty, so whitespace inside a measured value is escaped by
# vis() rather than emitted raw.
use strict;
use warnings;

use XML::SAX::Base;
use XML::SAX::Exception;

my $fail = 0;
sub emit { my ($tag, $val) = @_; $val = '<undef>' unless defined $val; print "$tag $val\n" }
sub ck   { my ($cond, $why) = @_; $fail++, print "CHECK-FAILED $why\n" unless $cond; $cond }

# Whitespace is data here -- one of the measurements is that a filter which
# rewrites characters() leaves ignorable_whitespace() alone -- so it is made
# visible rather than printed, and an empty string is named rather than blank.
sub vis {
    my $s = shift;
    return '<undef>' unless defined $s;
    $s =~ s/\\/\\\\/g; $s =~ s/\n/\\n/g; $s =~ s/\t/\\t/g; $s =~ s/ /\\s/g;
    return length($s) ? $s : '<empty>';
}

# A die message is normalised to its text alone: perl appends " at FILE line N."
# to any message not ending in a newline, and FILE is the payload's install
# path, which is not a property of the module under test. An XML::SAX::Exception
# stringifies through its own overload, so the same normaliser serves both.
sub caught {
    my $code = shift;
    my $ok = eval { $code->(); 1 };
    return '<no-die>' if $ok;
    my $m = "$@";
    $m =~ s/ at \S+ line \d+\.?\s*$//;
    $m =~ s/\s+/ /g;
    $m =~ s/^\s+|\s+$//g;
    return $m;
}

# A field of an event that may not have arrived at all. Every measurement below
# reaches into the sink's log, and the failure this suite exists to catch is an
# event going MISSING -- so a bare ->{Data} on the absent event would die and
# take the remaining forty measurements with it, turning one real defect into a
# wholesale red. Reaching through fld() keeps a dropped event to the one case
# that named it. (Found by mutation: removing the method-cache invalidation from
# set_handler reddened 31 cases instead of 2.)
sub fld {
    my ($ev, @path) = @_;
    for my $k (@path) {
        return undef unless ref($ev) eq 'HASH';
        $ev = $ev->{$k};
    }
    return $ev;
}

# The sorted keys of a hash-valued field, or a name for its absence -- the same
# guard as fld(), for the two places that count and list attributes.
sub fkeys {
    my $h = fld(@_);
    return '<undef>' unless ref($h) eq 'HASH';
    return keys %$h ? join(',', sort keys %$h) : '<empty>';
}
sub fcount {
    my $h = fld(@_);
    return ref($h) eq 'HASH' ? scalar keys %$h : '<undef>';
}

# The class of what was thrown, which is the half of an exception contract that
# a message comparison cannot see: NotSupported and NotRecognized carry nearly
# the same sentence and mean opposite things to a caller.
sub caught_class {
    my $code = shift;
    my $ok = eval { $code->(); 1 };
    return '<no-die>' if $ok;
    return ref($@) || '<not-an-object>';
}

# ---------------------------------------------------------------------------
# The recording sink: the far end of every chain below. It implements each
# callback the driver emits, so a missing event is a missing LOG line rather
# than a silently-swallowed dispatch -- XML::SAX::Base installs an empty sub for
# a callback the handler cannot ->can(), which is exactly the failure mode a
# sink built out of AUTOLOAD would hide.
# ---------------------------------------------------------------------------
{
    package My::Sink;
    sub new { my $c = shift; bless { log => [], refs => [] }, $c }
    sub _rec {
        my ($self, $name, $data) = @_;
        push @{ $self->{log} }, [ $name, $data ];
        push @{ $self->{refs} }, "$data" if ref $data;
        return 1;
    }
    sub start_document        { $_[0]->_rec('start_document',        $_[1]) }
    sub end_document          { $_[0]->_rec('end_document',          $_[1]) }
    sub xml_decl              { $_[0]->_rec('xml_decl',              $_[1]) }
    sub start_element         { $_[0]->_rec('start_element',         $_[1]) }
    sub end_element           { $_[0]->_rec('end_element',           $_[1]) }
    sub characters            { $_[0]->_rec('characters',            $_[1]) }
    sub ignorable_whitespace  { $_[0]->_rec('ignorable_whitespace',  $_[1]) }
    sub comment               { $_[0]->_rec('comment',               $_[1]) }
    sub processing_instruction{ $_[0]->_rec('processing_instruction',$_[1]) }
    sub start_prefix_mapping  { $_[0]->_rec('start_prefix_mapping',  $_[1]) }
    sub end_prefix_mapping    { $_[0]->_rec('end_prefix_mapping',    $_[1]) }
    sub notation_decl         { $_[0]->_rec('notation_decl',         $_[1]) }
    sub error                 { $_[0]->_rec('error',                 $_[1]) }
    sub end_entity            { $_[0]->_rec('end_entity',            $_[1]) }

    sub names { join(',', map { $_->[0] } @{ $_[0]->{log} }) }
    sub first {
        my ($self, $name) = @_;
        for (@{ $self->{log} }) { return $_->[1] if $_->[0] eq $name }
        return undef;
    }
    sub nth {
        my ($self, $name, $n) = @_;
        my $i = 0;
        for (@{ $self->{log} }) { return $_->[1] if $_->[0] eq $name and ++$i == $n }
        return undef;
    }
    sub count { scalar @{ $_[0]->{log} } }
}

# Stage 1 of the chain: rewrites text and NOTHING else. It overrides exactly one
# callback and inherits the other thirty-odd -- the module's stated reason for
# existing ("so you don't have to implement the characters() callback").
{
    package My::Upper;
    our @ISA = ('XML::SAX::Base');
    # A copy, not an in-place edit: a filter that rewrote the caller's hash
    # would corrupt a driver that still holds it, which R26 measures.
    sub characters {
        my ($self, $data) = @_;
        my %e = %$data;
        $e{Data} = uc $e{Data};
        return $self->SUPER::characters(\%e);
    }
}

# Stage 2: renames one element and injects an attribute onto it, passing every
# other element and every other event through untouched.
{
    package My::Retag;
    our @ISA = ('XML::SAX::Base');
    sub _retag {
        my ($self, $data) = @_;
        return $data unless ($data->{LocalName} || '') eq 'b';
        my %e = %$data;
        $e{LocalName} = 'bee';
        $e{Name}      = 'bee';
        if ($e{Attributes}) {
            my %a = %{ $e{Attributes} };
            $a{'{}tagged'} = { Name => 'tagged', LocalName => 'tagged',
                               Prefix => '', NamespaceURI => '', Value => 'yes' };
            $e{Attributes} = \%a;
        }
        return \%e;
    }
    sub start_element { my ($s, $d) = @_; $s->SUPER::start_element($s->_retag($d)) }
    sub end_element   { my ($s, $d) = @_; $s->SUPER::end_element($s->_retag($d))   }
}

# A subclass that overrides nothing at all: the pass-through claim in its purest
# form.
{ package My::Passthru; our @ISA = ('XML::SAX::Base'); }

# A handler that implements no callback by name and answers through AUTOLOAD --
# the second dispatch path XML::SAX::Base carries, and the one a ->can() check
# alone would miss. DESTROY is defined so global destruction does not reach
# AUTOLOAD and record a phantom event.
{
    package My::Autoload;
    our $AUTOLOAD;
    sub new { bless { log => [] }, shift }
    sub AUTOLOAD {
        my $self = shift;
        my $n = $AUTOLOAD; $n =~ s/.*:://;
        push @{ $self->{log} }, $n;
        return 1;
    }
    sub DESTROY { }
    sub names { join(',', @{ $_[0]->{log} }) }
}

# A stand-in parent for the filter-delegation case: parse() on a filter with a
# Parent must hand the merged options up, not try to parse anything itself.
{
    package My::Parent;
    sub new { bless { seen => undef }, shift }
    sub parse { my ($s, $o) = @_; $s->{seen} = $o; return 'PARENT-PARSED' }
}

# ---------------------------------------------------------------------------
# 1. identity: the two modules this distribution ships, and where they resolved
# ---------------------------------------------------------------------------
emit('R1-version',            $XML::SAX::Base::VERSION);
emit('R2-inc-path',           $INC{'XML/SAX/Base.pm'});
emit('R3-exception-version',  $XML::SAX::Exception::VERSION);
emit('R4-exception-inc-path', $INC{'XML/SAX/Exception.pm'});

# ---------------------------------------------------------------------------
# 2. THE TICKET'S HEADLINE: a hand-built stream through a two-stage chain
#
#    driver -> My::Upper -> My::Retag -> My::Sink
#
# Fourteen events covering the document lifecycle, the element lifecycle with
# attributes, text, and the three event kinds a filter is most likely to drop
# because it never implemented them (PI, comment, prefix mapping).
# ---------------------------------------------------------------------------
my $sink  = My::Sink->new;
my $retag = My::Retag->new(Handler => $sink);
my $upper = My::Upper->new(Handler => $retag);

my $ROOT_ATTRS = {
    '{}id'   => { Name => 'id',   LocalName => 'id',   Prefix => '', NamespaceURI => '', Value => 'r1' },
    '{}lang' => { Name => 'lang', LocalName => 'lang', Prefix => '', NamespaceURI => '', Value => 'en' },
};
my $B_ATTRS = {
    '{}n' => { Name => 'n', LocalName => 'n', Prefix => '', NamespaceURI => '', Value => '7' },
};
# Kept by the driver after the run, so a filter that edited in place is caught.
my $OUTER_CHARS = { Data => 'hello' };

$upper->start_document({});
$upper->xml_decl({ Version => '1.0', Encoding => 'UTF-8', Standalone => 'yes' });
$upper->processing_instruction({ Target => 'brintos', Data => 'mode=test' });
$upper->start_prefix_mapping({ Prefix => 'x', NamespaceURI => 'http://example.org/x' });
$upper->start_element({ Name => 'root', LocalName => 'root', Prefix => '',
                        NamespaceURI => '', Attributes => $ROOT_ATTRS });
$upper->characters($OUTER_CHARS);
$upper->start_element({ Name => 'b', LocalName => 'b', Prefix => '',
                        NamespaceURI => '', Attributes => $B_ATTRS });
$upper->characters({ Data => 'inner text' });
$upper->end_element({ Name => 'b', LocalName => 'b', Prefix => '', NamespaceURI => '' });
$upper->comment({ Data => ' a comment ' });
$upper->ignorable_whitespace({ Data => "\n  " });
$upper->end_element({ Name => 'root', LocalName => 'root', Prefix => '', NamespaceURI => '' });
$upper->end_prefix_mapping({ Prefix => 'x' });
$upper->end_document({});

emit('R10-chain-count', $sink->count);
emit('R11-chain-order', $sink->names);

# text: rewritten by stage 1, in both places, and nowhere else
emit('R12-chars-outer',  vis(fld($sink->nth('characters', 1), 'Data')));
emit('R13-chars-inner',  vis(fld($sink->nth('characters', 2), 'Data')));
# stage 1 overrode characters() only, so ignorable_whitespace() is untouched --
# the case that fails if a filter hooks the wrong callback or the base routes
# whitespace through the text path.
emit('R14-ws-untouched', vis(fld($sink->first('ignorable_whitespace'), 'Data')));

# elements: renamed by stage 2 where it said it would, unchanged elsewhere
emit('R15-elem-names', join(',', map { fld($_->[1], 'Name') // '<undef>' }
                            grep { $_->[0] eq 'start_element' } @{ $sink->{log} }));
emit('R16-end-elem-names', join(',', map { fld($_->[1], 'Name') // '<undef>' }
                                grep { $_->[0] eq 'end_element' } @{ $sink->{log} }));

# attributes: the root's survive both stages byte for byte; the renamed
# element's original attribute survives the rename and the injected one arrives.
my $root_in = $sink->nth('start_element', 1);
emit('R17-root-attr-count', fcount($root_in, 'Attributes'));
emit('R18-root-attr-id',    fld($root_in, 'Attributes', '{}id', 'Value'));
emit('R19-root-attr-lang',  fld($root_in, 'Attributes', '{}lang', 'Value'));
emit('R20-root-name',       fld($root_in, 'Name'));
my $b_in = $sink->nth('start_element', 2);
emit('R21-b-attr-keys',     fkeys($b_in, 'Attributes'));
emit('R22-b-attr-original', fld($b_in, 'Attributes', '{}n', 'Value'));
emit('R23-b-attr-injected', fld($b_in, 'Attributes', '{}tagged', 'Value'));

# the events neither filter claims to touch, compared at values
emit('R24-pi', join('|', map { defined() ? $_ : '<undef>' }
                     fld($sink->first('processing_instruction'), 'Target'),
                     fld($sink->first('processing_instruction'), 'Data')));
emit('R25-comment', vis(fld($sink->first('comment'), 'Data')));
emit('R26-xml-decl', join('|', map { fld($sink->first('xml_decl'), $_) // '<undef>' }
                                qw(Version Encoding Standalone)));
emit('R27-prefix-mapping', join('|', map { defined() ? $_ : '<undef>' }
                     fld($sink->first('start_prefix_mapping'), 'Prefix'),
                     fld($sink->first('start_prefix_mapping'), 'NamespaceURI')));
emit('R28-end-prefix-mapping', fld($sink->first('end_prefix_mapping'), 'Prefix'));

# the driver's own hash is intact: a filter that rewrote in place would have
# uppercased the caller's data under it
emit('R29-driver-hash-intact', vis($OUTER_CHARS->{Data}));
# and the root Attributes hash the driver still holds gained nothing
emit('R30-driver-attrs-intact', join(',', sort keys %$ROOT_ATTRS));

# ---------------------------------------------------------------------------
# 3. the default behaviour, with no override anywhere
# ---------------------------------------------------------------------------
{
    my $s2   = My::Sink->new;
    my $bare = XML::SAX::Base->new(Handler => $s2);
    my $ev   = { Data => 'unchanged' };
    $bare->start_document({});
    $bare->start_element({ Name => 'p', LocalName => 'p', Prefix => '', NamespaceURI => '' });
    $bare->characters($ev);
    $bare->comment({ Data => 'c' });
    $bare->end_element({ Name => 'p', LocalName => 'p', Prefix => '', NamespaceURI => '' });
    $bare->end_document({});
    emit('R31-bare-order', $s2->names);
    emit('R32-bare-text',  vis(fld($s2->first('characters'), 'Data')));
    # identity, not equality: the base passes @_ straight through, so the sink
    # holds the very hashref the caller emitted.
    my $got = $s2->first('characters');
    emit('R33-bare-same-ref', (defined($got) && "$ev" eq "$got") ? 1 : 0);

    my $s3  = My::Sink->new;
    my $sub = My::Passthru->new(Handler => $s3);
    $sub->start_document({});
    $sub->start_element({ Name => 'p', LocalName => 'p', Prefix => '', NamespaceURI => '' });
    $sub->characters({ Data => 'sub' });
    $sub->end_element({ Name => 'p', LocalName => 'p', Prefix => '', NamespaceURI => '' });
    $sub->end_document({});
    emit('R34-subclass-order', $s3->names);
    emit('R35-subclass-text',  vis(fld($s3->first('characters'), 'Data')));
}

# ---------------------------------------------------------------------------
# 4. which handler slot each event is routed to
#
# The slot order is per-event and is the part of this module a reimplementation
# gets wrong silently: comment() prefers DocumentHandler over LexicalHandler,
# while end_entity() has no DocumentHandler branch at all.
# ---------------------------------------------------------------------------
{
    my ($ch, $dh, $h) = (My::Sink->new, My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(ContentHandler => $ch, DocumentHandler => $dh, Handler => $h);
    $f->start_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
    emit('R40-start-element-slot',
         $ch->count ? 'ContentHandler' : $dh->count ? 'DocumentHandler'
                    : $h->count ? 'Handler' : 'none');
}
{
    my ($dh, $h) = (My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(DocumentHandler => $dh, Handler => $h);
    $f->start_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
    emit('R41-start-element-no-content',
         $dh->count ? 'DocumentHandler' : $h->count ? 'Handler' : 'none');
}
{
    my $h = My::Sink->new;
    my $f = XML::SAX::Base->new(Handler => $h);
    $f->start_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
    emit('R42-start-element-handler-only', $h->count ? 'Handler' : 'none');
}
{
    my ($dh, $lh, $h) = (My::Sink->new, My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(DocumentHandler => $dh, LexicalHandler => $lh, Handler => $h);
    $f->comment({ Data => 'c' });
    emit('R43-comment-slot',
         $dh->count ? 'DocumentHandler' : $lh->count ? 'LexicalHandler'
                    : $h->count ? 'Handler' : 'none');
}
{
    my ($lh, $h) = (My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(LexicalHandler => $lh, Handler => $h);
    $f->comment({ Data => 'c' });
    emit('R44-comment-no-document', $lh->count ? 'LexicalHandler' : $h->count ? 'Handler' : 'none');
    # end_entity has no DocumentHandler branch, so the same pair routes it the
    # same way for a different reason -- and would route it to Handler if the
    # LexicalHandler branch were missing.
    my $f2 = XML::SAX::Base->new(LexicalHandler => $lh, Handler => $h);
    $f2->end_entity({ Name => 'ent' });
    emit('R45-end-entity-slot', $lh->count == 2 ? 'LexicalHandler' : 'Handler');
}
{
    my ($th, $h) = (My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(DTDHandler => $th, Handler => $h);
    $f->notation_decl({ Name => 'n', PublicId => 'p', SystemId => 's' });
    emit('R46-notation-slot', $th->count ? 'DTDHandler' : $h->count ? 'Handler' : 'none');
}
{
    my ($eh, $h) = (My::Sink->new, My::Sink->new);
    my $f = XML::SAX::Base->new(ErrorHandler => $eh, Handler => $h);
    $f->error({ Message => 'bad' });
    emit('R47-error-slot', $eh->count ? 'ErrorHandler' : $h->count ? 'Handler' : 'none');
}

# ---------------------------------------------------------------------------
# 5. get_handler / set_handler, including the mid-stream switch
# ---------------------------------------------------------------------------
{
    my $a = My::Sink->new;
    my $b = My::Sink->new;
    my $f = XML::SAX::Base->new(Handler => $a);
    emit('R50-get-handler-default', (("" . $f->get_handler) eq ("" . $a)) ? 1 : 0);
    emit('R51-get-handler-unset',   defined($f->get_lexical_handler) ? 'set' : '<undef>');

    $f->start_element({ Name => 'first', LocalName => 'first', Prefix => '', NamespaceURI => '' });
    emit('R52-set-handler-returns', $f->set_handler($b));
    $f->start_element({ Name => 'second', LocalName => 'second', Prefix => '', NamespaceURI => '' });
    # The switch has to invalidate the per-event method cache the first dispatch
    # installed; if it does not, 'second' lands on $a and this reads 2,0.
    emit('R53-switch-counts', $a->count . ',' . $b->count);
    emit('R54-switch-second', fld($b->first('start_element'), 'Name'));

    my $lex = My::Sink->new;
    $f->set_lexical_handler($lex);
    emit('R55-typed-roundtrip', (("" . $f->get_lexical_handler) eq ("" . $lex)) ? 1 : 0);
    emit('R56-typed-not-handler', (("" . $f->get_handler) eq ("" . $b)) ? 1 : 0);
}

# ---------------------------------------------------------------------------
# 6. no handler at all
# ---------------------------------------------------------------------------
{
    my $f = XML::SAX::Base->new();
    emit('R60-nohandler-class', ref($f->get_handler));
    my $ok = eval {
        $f->start_document({});
        $f->start_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
        $f->characters({ Data => 'x' });
        $f->end_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
        $f->end_document({});
        1;
    };
    emit('R61-nohandler-silent', $ok ? 1 : 0);
}

# ---------------------------------------------------------------------------
# 7. features -- the SAX2 property surface, and the two exception classes that
#    separate "I do not know that name" from "I know it and do not do it"
# ---------------------------------------------------------------------------
{
    my $f = XML::SAX::Base->new(Handler => My::Sink->new);
    my $NS  = 'http://xml.org/sax/features/namespaces';
    my $NSP = 'http://xml.org/sax/features/namespace-prefixes';
    my $BOGUS = 'http://example.org/no-such-feature';

    emit('R70-ns-default', $f->get_feature($NS));
    $f->set_feature($NS, 0);
    emit('R71-ns-after-set', $f->get_feature($NS));
    my %all = $f->get_features();
    emit('R72-features-count', scalar keys %all);
    emit('R73-supported-count', scalar(() = $f->supported_features()));

    emit('R74-unsupported-get-class', caught_class(sub { $f->get_feature($NSP) }));
    emit('R75-unsupported-get-msg',   caught(sub { $f->get_feature($NSP) }));
    emit('R76-unsupported-set-class', caught_class(sub { $f->set_feature($NSP, 1) }));
    emit('R77-unrecognized-get-class', caught_class(sub { $f->get_feature($BOGUS) }));
    emit('R78-unrecognized-get-msg',   caught(sub { $f->get_feature($BOGUS) }));
    emit('R79-unrecognized-set-class', caught_class(sub { $f->set_feature($BOGUS, 1) }));
}

# ---------------------------------------------------------------------------
# 8. XML::SAX::Exception -- the second module the recipe ships
# ---------------------------------------------------------------------------
{
    emit('R80-isa-notrecognized', XML::SAX::Exception::NotRecognized->isa('XML::SAX::Exception') ? 1 : 0);
    emit('R81-isa-notsupported',  XML::SAX::Exception::NotSupported->isa('XML::SAX::Exception')  ? 1 : 0);
    emit('R82-isa-parse',         XML::SAX::Exception::Parse->isa('XML::SAX::Exception')         ? 1 : 0);

    my $plain = XML::SAX::Exception->new(Message => 'plain trouble');
    emit('R83-stringify-plain', vis("$plain"));
    my $located = XML::SAX::Exception->new(Message => 'located trouble',
                                           LineNumber => 12, ColumnNumber => 34);
    emit('R84-stringify-located', vis("$located"));
    # throw() on an instance re-dies the same object rather than wrapping it
    emit('R85-throw-instance-class', caught_class(sub { $plain->throw }));
    emit('R86-throw-class-msg', caught(sub {
        XML::SAX::Exception::Parse->throw(Message => 'thrown by class') }));
    # Message is mandatory: new() without it confesses rather than building a
    # half-formed exception.
    emit('R87-no-message-dies', caught(sub { XML::SAX::Exception->new(Other => 1) }) =~ /^Invalid options/ ? 1 : 0);
}

# ---------------------------------------------------------------------------
# 9. the parse() plumbing a driver and a filter each rely on
# ---------------------------------------------------------------------------
{
    my $f = XML::SAX::Base->new(Handler => My::Sink->new);
    my $m = caught(sub { $f->parse(Source => {}) });
    $m =~ s/ \(.*//;
    emit('R90-parse-no-routine', $m);

    my $parent = My::Parent->new;
    my $filter = XML::SAX::Base->new(Handler => My::Sink->new, Parent => $parent);
    emit('R91-filter-delegates', $filter->parse_string('<a/>'));
    emit('R92-filter-source', fld($parent->{seen}, 'Source', 'String'));
    # get_options merges the object's own options under the call's, which is how
    # a filter's Handler reaches the parent's parse.
    my $opts = $f->get_options(Extra => 'e');
    emit('R93-get-options-merge', join(',', sort grep { /^(Extra|Handler)$/ } keys %$opts));
}

# ---------------------------------------------------------------------------
# 10. the AUTOLOAD dispatch path
# ---------------------------------------------------------------------------
{
    my $auto = My::Autoload->new;
    my $f = XML::SAX::Base->new(Handler => $auto);
    $f->start_document({});
    $f->start_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
    $f->characters({ Data => 'a' });
    $f->end_element({ Name => 'e', LocalName => 'e', Prefix => '', NamespaceURI => '' });
    $f->end_document({});
    emit('R95-autoload-order', $auto->names);
}
{
    # no_op is the documented "do nothing and say nothing" callback
    my $r = XML::SAX::Base->no_op(1, 2, 3);
    emit('R96-no-op-returns', defined($r) ? "'$r'" : '<undef>');
}

# ---------------------------------------------------------------------------
# internal invariants -- these gate ALL-SAXBASE-OK. They restate the headline
# claim in one place so a wholesale failure is one loud line rather than
# something a reader has to reconstruct from forty values.
# ---------------------------------------------------------------------------
ck($sink->count == 14, 'chain delivered 14 events');
ck($sink->names eq join(',', qw(start_document xml_decl processing_instruction
                                start_prefix_mapping start_element characters
                                start_element characters end_element comment
                                ignorable_whitespace end_element
                                end_prefix_mapping end_document)),
   'chain preserved event order');
ck((fld($sink->nth('characters', 1), 'Data') // '') eq 'HELLO', 'stage 1 rewrote outer text');
ck((fld($sink->first('ignorable_whitespace'), 'Data') // '') eq "\n  ", 'stage 1 left whitespace alone');
ck((fld($sink->nth('start_element', 2), 'Name') // '') eq 'bee', 'stage 2 renamed the element');
ck($OUTER_CHARS->{Data} eq 'hello', 'the driver hash was not mutated');

print "ALL-SAXBASE-OK\n" unless $fail;
exit($fail ? 1 : 0);