. "$BST_LIB"
require perl libxml-sax-perl/present

# XML::SAX 1.02 is the SAX2 framework itself: the parser REGISTRY
# (ParserDetails.ini + XML::SAX->parsers), the FACTORY that hands an application
# a parser without naming one, and the built-in pure-Perl backend
# XML::SAX::PurePerl that this port accepts on. It sits on top of
# libxml-sax-base-perl (the dispatcher) and libxml-namespacesupport-perl (the
# prefix resolver), both ported earlier in this Epic.
#
# The payload does the driving and prints one tagged line per value; this file
# names and compares them, so a single wrong answer is one red case rather than
# one red suite. Every expectation was first measured against a native x86-64
# perl running the IDENTICAL XML::SAX 1.02 source with the identical
# ParserDetails.ini -- a legitimate control here because the distribution is
# pure Perl end to end, PurePerl backend included, with no XS anywhere and no
# alternative parser installed to change the factory's answer.
#
# Emission ORDER of start/end_prefix_mapping is hash-order dependent and was
# measured to vary run to run (20 host runs split 10/10), so the mapping
# assertions below are SORTED SETS and the order string sorts each contiguous
# prefix-mapping run. The payload is otherwise byte-identical across 20 runs.
# ------------------------- 1. what the port SHIPS: filesystem facts ----------
# Asserted before anything starts perl, so the deliverable is measured even on a
# boot where the interpreter cannot load a module at all (section 1a). These are
# packaging facts and hold either way -- and for this port one of them IS a
# headline requirement: the ticket asks that the parser registry list the
# built-in backend, and the registry is a FILE.
V=$(ls -d /usr/lib/perl5/vendor_perl/*/XML 2>/dev/null | head -1)
check libxml-sax-perl/vendor-dir test -n "$V"

check libxml-sax-perl/module-installed  test -f "$V/SAX.pm"
check libxml-sax-perl/factory-installed test -f "$V/SAX/ParserFactory.pm"
check libxml-sax-perl/backend-installed test -f "$V/SAX/PurePerl.pm"
check libxml-sax-perl/locator-installed test -f "$V/SAX/DocumentLocator.pm"

# The backend is a TREE, not one file: PurePerl.pm dispatches into fifteen
# further modules (the productions, the DTD decls, the encoding detector and
# five readers). A package that shipped only PurePerl.pm would install fine and
# die on the first parse, so the count is asserted rather than the head module.
NPP=$(find "$V/SAX/PurePerl" -name '*.pm' 2>/dev/null | wc -l)
check_eq libxml-sax-perl/backend-tree 15 "$NPP"

# THE PARSER REGISTRY, as a file. Upstream generates this from an install-time
# hook (`install_sax_pureperl`) that Makefile.PL hangs off the `install` target
# -- and Yocto's cpan.bbclass runs `install_vendor`, which does not depend on
# it. Stock, the package therefore ships NO registry: XML::SAX->parsers()
# returns an empty list and warns. The recipe's bbappend writes it at
# do_install, so these two cases are what that fix is for.
#
# BRINTOS-UPSTREAM-FIX: the registry is generated by an install-time hook wired
# only to `install`, so no cross build can produce it. Ours is written by the
# bbappend; if these go red the bbappend stopped applying.
check libxml-sax-perl/registry-installed test -f "$V/SAX/ParserDetails.ini"
if grep -q '^\[XML::SAX::PurePerl\]$' "$V/SAX/ParserDetails.ini" 2>/dev/null
then bst_ok libxml-sax-perl/registry-names-backend
else bst_notok libxml-sax-perl/registry-names-backend \
  "ParserDetails.ini does not carry a [XML::SAX::PurePerl] section"; fi

check libxml-sax-perl/payload-installed \
  test -f "$BST_DATA/libxml-sax-perl-selftest.pl"

# ------------------ 1a. can perl LOAD a module on this boot at all? ----------
# BRINTOS-WORKAROUND: linux-in-the-browser#154 remove -- perl aborts in glibc's
# allocator while COMPILING a module, so `use XML::SAX` dies before a line of
# this port's code runs; delete this guard and the battery below runs
# unconditionally again the day #154 closes.
#
# The abort is glibc's own -- `mremap_chunk(): invalid pointer` or `corrupted
# size vs. prev_size`, rc=134 -- and is not specific to this module: measured on
# the same boot, `perl -Mstrict`, `perl -Mconstant`, `perl -MJSON` and
# `perl -MURI` abort identically, while `perl -Mwarnings` and `perl -Mvars`
# return 0. It reddens the five Perl ports already landed in this Epic and the
# interpreter's own 35-perl alike, so the case below places the defect in the
# interpreter rather than in this port, and the filesystem facts above -- the
# registry included -- stay green beside it.
#
# This is a guard, NOT a skip of an inconvenient case: the probe is left FAILING
# and attributed, so it flips green by itself when #154 closes, which is the
# regression signal this suite is bought for. What it prevents is running the
# 60-odd cases below anyway -- measured on the sibling ports at every case red
# and a multi-GiB host peak, which costs every suite scheduled after this one in
# the same sweep.
pout=$(perl -MXML::SAX -e 'print "SAX-OK\n"' 2>&1); prc=$?
case "$pout" in
  *SAX-OK*)
    bst_ok libxml-sax-perl/import-load
    ;;
  *)
    # The interpreter's locale warning is a four-line preamble on this image and
    # it is NOT the failure: it precedes the abort, fills the 100-char detail
    # field, and leaves the red reading "Setting locale failed" -- the wrong
    # diagnosis, in the one field a later reader has to tell #154 from something
    # new. Drop the warning and its indented continuation lines so the detail
    # carries glibc's own words, and fall back to the raw output if that leaves
    # nothing.
    pdiag=$(printf '%s\n' "$pout" |
            awk '/^perl: warning/ { skip=1; next } /^[ \t]/ && skip { next } { skip=0; print }')
    [ -n "$pdiag" ] || pdiag=$pout
    bst_notok libxml-sax-perl/import-load \
      "rc=$prc $(_bst_1line "$pdiag") -- perl cannot compile a module on this arm (linux-in-the-browser#154)"
    # Named rather than silent: this ticket's headline criteria are the
    # NAMESPACED PARSE and the ILL-FORMED REFUSAL, and those are exactly what
    # could not be measured. A suite that merely stopped here would report eight
    # greens and read as a pass.
    bst_notok libxml-sax-perl/parse-unverified \
      "not run: perl cannot load the module (linux-in-the-browser#154) -- the namespaced parse (element, attribute and character events), the live registry lookup and the not-well-formed refusal are unverified on wasm32-hwjs"
    exit 0
    ;;
esac

# ------------------------- 2. the module's own answers, at values ------------
out=$(perl "$BST_DATA/libxml-sax-perl-selftest.pl" 2>&1); rc=$?

case "$out" in *ALL-SAX-OK*) all=1 ;; *) all=0 ;; esac
if [ "$rc" -eq 0 ] && [ "$all" -eq 1 ]; then bst_ok libxml-sax-perl/all-ok
else bst_notok libxml-sax-perl/all-ok "rc=$rc $(_bst_1line "$out")"; fi

val() { printf '%s\n' "$out" | awk -v t="$1" '$1==t{ $1=""; sub(/^ /,""); print; exit }'; }

# --- the three modules load, from the image rather than a stray @INC dir -----
check_eq libxml-sax-perl/version          1.02 "$(val R1-version)"
check_eq libxml-sax-perl/factory-version  1.02 "$(val R3-factory-version)"
check_eq libxml-sax-perl/backend-version  1.02 "$(val R4-pureperl-version)"
for t in R2-inc-path R5-factory-inc-path R6-pureperl-inc-path; do
  case "$(val $t)" in
    /usr/*) bst_ok libxml-sax-perl/installed-path-$t ;;
    *) bst_notok libxml-sax-perl/installed-path-$t "$t resolved to $(val $t)" ;;
  esac
done

# --- WHAT THE TICKET ASKS FOR (1/3): the registry lists the backend ----------
# The file-level half is asserted in section 1; this is the half that matters to
# a caller -- XML::SAX->parsers() actually parsing that file and returning the
# backend, with no "could not find ParserDetails.ini" warning behind it. Without
# the bbappend this reads 0 / <empty> / 1 while the factory still works, which
# is precisely the silent half-port the file check alone would miss.
check_eq libxml-sax-perl/registry-count  1                   "$(val R10-registry-count)"
check_eq libxml-sax-perl/registry-names  XML::SAX::PurePerl  "$(val R11-registry-names)"
check_eq libxml-sax-perl/registry-quiet  0                   "$(val R12-registry-warned)"
check_eq libxml-sax-perl/registry-backend 1                  "$(val R13-registry-has-pureperl)"
# the feature the registry records must be the one the backend actually claims
check_eq libxml-sax-perl/registry-features \
  'http://xml.org/sax/features/namespaces=1' "$(val R14-registry-pureperl-features)"
check_eq libxml-sax-perl/registry-file      1 "$(val R15-ini-exists)"
check_eq libxml-sax-perl/registry-file-names 1 "$(val R16-ini-names-pureperl)"
check_eq libxml-sax-perl/backend-features \
  'http://xml.org/sax/features/namespaces' "$(val R17-pureperl-supported)"

# --- the factory: an application gets a parser without naming one ------------
check_eq libxml-sax-perl/factory-class    XML::SAX::PurePerl "$(val R20-factory-class)"
check_eq libxml-sax-perl/factory-isa-base 1                  "$(val R21-factory-isa-base)"
# $XML::SAX::ParserPackage outranks the registry. The payload pins it to a class
# the registry does NOT list, precisely so a factory that ignored the variable
# and fell through to its backup plan would answer PurePerl and fail here.
check_eq libxml-sax-perl/factory-parserpackage \
  Bst::FakeParser "$(val R22-factory-parserpackage)"

# --- WHAT THE TICKET ASKS FOR (2/3): the namespaced parse, event by event ----
# One document carrying a default namespace AND a prefixed one, two attributes
# in two different namespaces, prefixed and unprefixed children, text, a comment
# and a PI. Asserted at values, not "it parsed".
ORDER='set_document_locator,start_document,comment,processing_instruction,start_prefix_mapping,start_prefix_mapping,start_element,characters,start_element,characters,end_element,characters,start_element,characters,end_element,characters,end_element,end_prefix_mapping,end_prefix_mapping,end_document'
check_eq libxml-sax-perl/event-count 20       "$(val R30-event-count)"
check_eq libxml-sax-perl/event-order "$ORDER" "$(val R31-event-order)"

# the ELEMENT events: the namespace triple, resolved three different ways
check_eq libxml-sax-perl/root-localname doc                          "$(val R32-root-localname)"
check_eq libxml-sax-perl/root-nsuri     http://example.org/default   "$(val R33-root-nsuri)"
check_eq libxml-sax-perl/root-prefix    '<empty>'                    "$(val R34-root-prefix)"
check_eq libxml-sax-perl/root-name      doc                          "$(val R35-root-name)"
# a PREFIXED element: LocalName drops the prefix, Name keeps it
check_eq libxml-sax-perl/prefixed-localname item                     "$(val R47-item-localname)"
check_eq libxml-sax-perl/prefixed-nsuri     http://example.org/x     "$(val R48-item-nsuri)"
check_eq libxml-sax-perl/prefixed-prefix    x                        "$(val R49-item-prefix)"
check_eq libxml-sax-perl/prefixed-name      x:item                   "$(val R50-item-name)"
# an UNPREFIXED child inherits the default namespace rather than none --
# the case that fails if the resolver treats "no prefix" as "no namespace"
check_eq libxml-sax-perl/inherits-default-ns http://example.org/default "$(val R54-plain-nsuri)"
check_eq libxml-sax-perl/inherits-no-prefix  '<empty>'                  "$(val R55-plain-prefix)"
check_eq libxml-sax-perl/plain-localname     plain                      "$(val R53-plain-localname)"
# end_element carries the same triple as its start; an asymmetry here leaves a
# document whose tags do not balance in namespace terms
check_eq libxml-sax-perl/end-prefixed-triple \
  'x|item|http://example.org/x' "$(val R57-end-item-triple)"
check_eq libxml-sax-perl/end-root-triple \
  '<empty>|doc|http://example.org/default' "$(val R58-end-root-triple)"

# the ATTRIBUTE events, keyed {NamespaceURI}LocalName
check_eq libxml-sax-perl/attr-count 4 "$(val R36-root-attr-count)"
# the xmlns declarations are reported AS ATTRIBUTES beside the real ones, which
# is the non-obvious half: four keys, not two.
check_eq libxml-sax-perl/attr-keys \
  '{http://example.org/x}lang,{http://www.w3.org/2000/xmlns/}x,{}id,{}xmlns' \
  "$(val R37-root-attr-keys)"
check_eq libxml-sax-perl/attr-plain-value r1        "$(val R38-attr-id-value)"
check_eq libxml-sax-perl/attr-plain-nsuri '<empty>' "$(val R39-attr-id-nsuri)"
# a NAMESPACED attribute keeps all four fields distinct
check_eq libxml-sax-perl/attr-ns-value     en                     "$(val R40-attr-xlang-value)"
check_eq libxml-sax-perl/attr-ns-localname lang                   "$(val R41-attr-xlang-localname)"
check_eq libxml-sax-perl/attr-ns-uri       http://example.org/x   "$(val R42-attr-xlang-nsuri)"
check_eq libxml-sax-perl/attr-ns-prefix    x                      "$(val R43-attr-xlang-prefix)"
check_eq libxml-sax-perl/attr-ns-name      x:lang                 "$(val R44-attr-xlang-name)"
check_eq libxml-sax-perl/attr-xmlns-default \
  http://example.org/default "$(val R45-attr-xmlns-default)"
check_eq libxml-sax-perl/attr-xmlns-prefixed \
  http://example.org/x       "$(val R46-attr-xmlns-x)"
check_eq libxml-sax-perl/attr-on-prefixed-elem 7 "$(val R51-item-attr-n)"
check_eq libxml-sax-perl/attr-count-prefixed   1 "$(val R52-item-attr-count)"
check_eq libxml-sax-perl/attr-count-none       0 "$(val R56-plain-attr-count)"

# the CHARACTER events
check_eq libxml-sax-perl/chars-count 5             "$(val R60-chars-count)"
check_eq libxml-sax-perl/chars-text  'hello|world' "$(val R61-chars-text)"
# inter-element whitespace arrives through characters(), NOT
# ignorable_whitespace(): with no DTD the parser cannot know it is ignorable.
# A backend that routed it to the other callback would pass chars-text and fail
# both of these.
check_eq libxml-sax-perl/chars-whitespace '\n__\n__\n' "$(val R62-chars-whitespace)"
check_eq libxml-sax-perl/no-ignorable-ws  0            "$(val R63-ignorable-ws-count)"

# the PREFIX MAPPINGS, as sorted sets (emission order is hash-order dependent --
# see the header note; asserting the raw order was measured flaky 10/20)
MAPS='<empty>=http://example.org/default,x=http://example.org/x'
check_eq libxml-sax-perl/prefix-mappings     "$MAPS" "$(val R64-start-prefix-mappings)"
check_eq libxml-sax-perl/end-prefix-mappings "$MAPS" "$(val R65-end-prefix-mappings)"

# the events that are neither element nor text
check_eq libxml-sax-perl/comment '\sa\scomment\s'  "$(val R66-comment)"
check_eq libxml-sax-perl/pi      'brintos|mode=test' "$(val R67-pi)"
# PurePerl does NOT surface the XML declaration as an xml_decl() callback, so a
# handler must not wait for one. Pinned because it is the kind of thing a
# reimplementation "fixes" and thereby breaks every handler written against it.
check_eq libxml-sax-perl/no-xml-decl-callback 0 "$(val R68-xml-decl-count)"
check_eq libxml-sax-perl/document-completed   1 "$(val R69-end-document-count)"

# --- WHAT THE TICKET ASKS FOR (3/3): ill-formed raises, never a partial tree --
# Each case asserts BOTH halves. "It threw" alone is compatible with a parser
# that had already pushed a whole document at the handler and then complained,
# so every case also asserts that end_document never arrived -- and the mismatch
# case asserts the exact prefix of events that DID, which is what "partial tree"
# means concretely.
check_eq libxml-sax-perl/illformed-mismatch-dies  1 "$(val R70-mismatch-died)"
check_eq libxml-sax-perl/illformed-mismatch-class \
  XML::SAX::Exception::Parse "$(val R71-mismatch-class)"
check_eq libxml-sax-perl/illformed-mismatch-msg \
  'End tag mismatch (a != b)' "$(val R72-mismatch-msg)"
check_eq libxml-sax-perl/illformed-mismatch-trace \
  'set_document_locator,start_document,start_element,start_element' \
  "$(val R73-mismatch-trace)"
check_eq libxml-sax-perl/illformed-mismatch-no-tree 1 "$(val R74-mismatch-no-end-document)"

check_eq libxml-sax-perl/illformed-unclosed-dies  1 "$(val R75-unclosed-died)"
check_eq libxml-sax-perl/illformed-unclosed-msg 'No close tag marker' "$(val R76-unclosed-msg)"
check_eq libxml-sax-perl/illformed-unclosed-trace \
  'set_document_locator,start_document,start_element,start_element,characters' \
  "$(val R77-unclosed-trace)"
check_eq libxml-sax-perl/illformed-unclosed-no-tree 1 "$(val R78-unclosed-no-end-document)"

check_eq libxml-sax-perl/illformed-entity-dies  1 "$(val R79-entity-died)"
check_eq libxml-sax-perl/illformed-entity-class \
  XML::SAX::Exception::Parse "$(val R80-entity-class)"
check_eq libxml-sax-perl/illformed-entity-msg 'Undeclared entity' "$(val R81-entity-msg)"
check_eq libxml-sax-perl/illformed-entity-no-tree 1 "$(val R82-entity-no-end-document)"

check_eq libxml-sax-perl/illformed-tworoots-dies 1 "$(val R83-tworoots-died)"
check_eq libxml-sax-perl/illformed-tworoots-msg \
  'Only Comments, PIs and whitespace allowed at end of document' "$(val R84-tworoots-msg)"
check_eq libxml-sax-perl/illformed-tworoots-no-tree 1 "$(val R85-tworoots-no-end-document)"

# a NAMESPACE error rather than a syntax one: raised by XML::NamespaceSupport,
# which is a different port's code reached through this one. Only the message
# substring is asserted -- the full string carries a host @INC path.
check_eq libxml-sax-perl/illformed-badprefix-dies 1 "$(val R86-badprefix-died)"
check_eq libxml-sax-perl/illformed-badprefix-msg  1 "$(val R87-badprefix-msg-has-undeclared)"
check_eq libxml-sax-perl/illformed-badprefix-no-tree 1 "$(val R88-badprefix-no-end-document)"

# the control for all six: the well-formed document DID complete. Without it,
# a parser that refused everything would pass every case above.
check_eq libxml-sax-perl/wellformed-completes 1 "$(val R89-wellformed-completed)"

# --- the other entry points reach the same parser ---------------------------
# parse_file drives PurePerl::Reader::Stream where parse_string drives ::String
# -- a different reader, and the one a real caller uses on a file.
check_eq libxml-sax-perl/factory-parses       20   "$(val R90-factory-parse-count)"
check_eq libxml-sax-perl/factory-parses-root  doc  "$(val R91-factory-parse-root)"
check_eq libxml-sax-perl/parse-file-ok        1    "$(val R92-parse-file-ok)"
check_eq libxml-sax-perl/parse-file-count     20   "$(val R93-parse-file-count)"

# nothing warned anywhere in the run. The registry check above is the one place
# a warning carries meaning and is asserted there; anything else is a defect.
check_eq libxml-sax-perl/no-warnings 0        "$(val R95-warning-count)"
check_eq libxml-sax-perl/no-warnings-text '<none>' "$(val R96-warnings)"