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

# XML::Parser 2.47 is the XS binding to expat -- the fast native parser most
# Perl XML tooling reaches for when it is available, and the eighth Perl module
# on this image under BRINTOS-999. It is unlike the seven before it in the one
# way that decides this suite: every earlier port was pure Perl, and this one is
# a compiled extension that has to be LOADED at runtime.
#
# It cannot be, here. The glibc arm's interpreter is built -Uusedl
# -Uuseshrplib, so the package installs as Expat.a with no shared object and no
# perl package in the feed carries DynaLoader.pm at all -- measured, not
# assumed: `DynaLoader.pm` appears in none of the feed's perl or perl-module-*
# packages, and Expat.so in none of libxml-parser-perl's four splits. XML::Parser
# has no pure-Perl fallback to degrade to, so `use XML::Parser` cannot succeed on
# this arm until BRINTOS-881 lands shared libraries. Surfacing that is part of
# this port's deliverable rather than a reason to withhold it.
#
# So the suite is built in three layers, and each is honest about what it can
# see:
#   1. filesystem facts -- what the port SHIPS. Green on target today.
#   2. the XS gap, as NAMED REDS attributed to BRINTOS-881. They flip green by
#      themselves when 881 lands, which is the regression signal this suite is
#      bought for. They are not skips: nothing here is legitimately absent.
#   3. the value battery, driven by the payload. Unreachable today behind (2)
#      and behind linux-in-the-browser#154 -- every expectation in it was
#      measured against a native perl running BYTE-IDENTICAL .pm sources (the
#      wasm32 .deb's XML/Parser.pm, XML/Parser/Expat.pm and all five
#      XML/Parser/Style/*.pm diff clean against the host's), so it is written
#      and demonstrated rather than guessed.

# ------------------------- 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. XS modules land under
# the ARCH subdirectory of vendor_perl, not beside the pure-Perl ports.
V=$(ls -d /usr/lib/perl5/vendor_perl/*/*-linux 2>/dev/null | head -1)
check libxml-parser-perl/vendor-arch-dir test -n "$V"

check libxml-parser-perl/module-installed test -f "$V/XML/Parser.pm"
check libxml-parser-perl/expat-installed  test -f "$V/XML/Parser/Expat.pm"

# The styles are the module's public surface, and two of them are this ticket's
# own subject: Tree (section 3's structure assertions) and Subs (its callback
# sequence). A package shipping Parser.pm alone would install fine and die on
# the first `Style => 'Tree'`.
check libxml-parser-perl/style-tree test -f "$V/XML/Parser/Style/Tree.pm"
check libxml-parser-perl/style-subs test -f "$V/XML/Parser/Style/Subs.pm"
NST=$(find "$V/XML/Parser/Style" -name '*.pm' 2>/dev/null | wc -l)
check_eq libxml-parser-perl/style-tree-complete 5 "$NST"

# The encoding maps are data files the parser loads on demand for any document
# whose declared encoding is not one of expat's four built-ins. They are easy to
# drop from a package split and impossible to notice until a koi8-r document
# arrives, so the count is asserted.
NENC=$(find "$V/XML/Parser/Encodings" -name '*.enc' 2>/dev/null | wc -l)
check_eq libxml-parser-perl/encodings 22 "$NENC"

# THE XS ARTIFACT ITSELF. This is what the compile produced -- the port did
# reach the compiler and did build, which is worth asserting separately from
# whether it can be loaded.
check libxml-parser-perl/xs-archive test -f "$V/auto/XML/Parser/Expat/Expat.a"

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

# ------------------- 2. the XS gap, named rather than skipped ----------------
# Tracked by BRINTOS-881 (migrate to shared libraries and dynamic linking,
# glibc arm) -- named in prose rather than as a BRINTOS-WORKAROUND: marker, and
# deliberately: that marker's grammar is <repo>#<n>, a brintos.io issue for
# brintos_reconcile.py to chase, and a JIRA key put in its place parses as
# MALFORMED -- which leaves the artifact reading as tracked while nothing
# tracks it. This gap is OURS (--disable-shared is distro policy; brintOS has a
# working dynamic arm and this image deliberately is not it), so there is no
# forge issue to chase. Same treatment as 90-intltool.test, which carries the
# same gap.
#
# The glibc arm is built -Uusedl -Uuseshrplib, so there is no shared object to
# load and no DynaLoader to load it with. Both cases below are the ticket's
# "confirm the XS layer is really loaded" clause, asserted as filesystem facts
# so they are measured on target even while the interpreter cannot run; delete
# this section when 881 lands and section 4's R10-R15 assert the same thing at
# runtime, which is stronger.
#
# They are written in the direction that FLIPS: each asserts what must become
# true, so the pair goes green the day shared libraries arrive, rather than
# going red and reading as a regression. Asserting the absence instead -- "there
# is no Expat.so" -- would pass today and fail on success, which is the wrong
# way round for a pin whose whole purpose is to notice the fix.
if [ -f "$V/auto/XML/Parser/Expat/Expat.so" ]; then
  bst_ok libxml-parser-perl/xs-shared-object
else
  bst_notok libxml-parser-perl/xs-shared-object \
    "no Expat.so beside Expat.a -- this arm is -Uusedl -Uuseshrplib, so the XS layer cannot be loaded (BRINTOS-881)"
fi
DLP=$(ls /usr/lib/perl5/*/DynaLoader.pm /usr/lib/perl5/*/*-linux/DynaLoader.pm 2>/dev/null | head -1)
if [ -n "$DLP" ]; then
  bst_ok libxml-parser-perl/dynaloader-present
else
  bst_notok libxml-parser-perl/dynaloader-present \
    "DynaLoader.pm is in no perl package in the feed, so no separately-loadable XS module can load on this arm (BRINTOS-881)"
fi

# ------------------ 3. can perl LOAD this 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 the guard below is needed on top of the
# 881 gap; delete it and the battery in section 4 runs unconditionally again
# once BOTH close. Two independent blocks sit between this port and its own
# value battery and the guard names whichever one it actually met, because
# attributing this port's reds to the wrong one is exactly the error a later
# reader cannot detect.
pout=$(perl -MXML::Parser -e 'print "XP-OK\n"' 2>&1); prc=$?
case "$pout" in
  *XP-OK*) bst_ok libxml-parser-perl/import-load ;;
  *)
    # The interpreter's locale warning is a four-line preamble on this image and
    # is NOT the failure: it precedes the real diagnostic and would otherwise
    # fill the 100-char detail field, leaving the red reading "Setting locale
    # failed" -- the wrong diagnosis in the one field a later reader has to
    # attribute by.
    pdiag=$(printf '%s\n' "$pout" |
            awk '/^perl: warning/ { skip=1; next } /^[ \t]/ && skip { next } { skip=0; print }')
    [ -n "$pdiag" ] || pdiag=$pout
    case "$pdiag" in
      *DynaLoader*|*"Can't load"*|*"object file"*)
        why="BRINTOS-881 -- no DynaLoader on this -Uusedl arm, so the XS layer cannot load" ;;
      *mremap_chunk*|*"corrupted size"*|*"free(): "*|*"malloc(): "*)
        why="linux-in-the-browser#154 -- perl aborts in glibc's allocator while compiling a module" ;;
      *)
        why="unclassified -- neither BRINTOS-881's DynaLoader signature nor #154's allocator abort" ;;
    esac
    bst_notok libxml-parser-perl/import-load "rc=$prc $(_bst_1line "$pdiag") -- $why"
    # Named rather than silent. This ticket's headline criteria are the Tree
    # parse, the Subs callback sequence, the live XS-load proof and the expat
    # diagnostic on a malformed document, and those are exactly what could not
    # be measured. A suite that merely stopped here would report ten greens and
    # read as a pass.
    bst_notok libxml-parser-perl/parse-unverified \
      "not run: perl cannot load XML::Parser ($why) -- the Tree-style structure, the Subs-style callback sequence, the live XS-layer proof and expat's own diagnostic on a malformed document are unverified on wasm32-hwjs"
    exit 0
    ;;
esac

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

case "$out" in *ALL-XMLPARSER-OK*) all=1 ;; *) all=0 ;; esac
if [ "$rc" -eq 0 ] && [ "$all" -eq 1 ]; then bst_ok libxml-parser-perl/all-ok
else bst_notok libxml-parser-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 module loads, from the image rather than a stray @INC dir ----------
check_eq libxml-parser-perl/version       2.47 "$(val R1-version)"
check_eq libxml-parser-perl/expat-version 2.47 "$(val R3-expat-version)"
for t in R2-inc-path R4-expat-inc-path; do
  case "$(val $t)" in
    /usr/*) bst_ok libxml-parser-perl/installed-path-$t ;;
    *) bst_notok libxml-parser-perl/installed-path-$t "$t resolved to $(val $t)" ;;
  esac
done

# --- WHAT THE TICKET ASKS (1/4): the XS layer is REALLY loaded --------------
# Four independent proofs, because "the module loaded" is the thing a pure-Perl
# reimplementation would also satisfy. The XSUB flag is set by newXS at
# bootstrap and by nothing else; the DynaLoader record names the object actually
# mapped; the census catches a PARTIAL bootstrap; and the error table is
# libexpat's own strings, reachable only through the compiled library.
check_eq libxml-parser-perl/xs-parsercreate  1 "$(val R10-xsub-ParserCreate)"
check_eq libxml-parser-perl/xs-parserfree    1 "$(val R10-xsub-ParserFree)"
check_eq libxml-parser-perl/xs-parserrelease 1 "$(val R10-xsub-ParserRelease)"
check_eq libxml-parser-perl/xs-dynaloaded    1 "$(val R11-dynaloader-count)"
check_eq libxml-parser-perl/xs-object-name   Expat.so "$(val R12-dynaloader-basename)"
check_eq libxml-parser-perl/xs-census        1 "$(val R13-xsub-census)"
check_eq libxml-parser-perl/xs-expat-strings \
  'not well-formed (invalid token)' "$(val R14-expat-errorstring-4)"
check_eq libxml-parser-perl/xs-expat-strings-2 \
  'no element found' "$(val R15-expat-errorstring-3)"

# --- WHAT THE TICKET ASKS (2/4): Tree style, asserted as STRUCTURE -----------
# Not "it parsed": the depth-marked shape, the child counts, the attribute
# hashes and the text at each level, so one wrong answer names which part of the
# tree is wrong.
check_eq libxml-parser-perl/tree-root  doc "$(val R20-tree-root)"
check_eq libxml-parser-perl/tree-shape \
  '0:doc,1:item,1:item,2:b,1:empty' "$(val R21-tree-shape)"
check_eq libxml-parser-perl/tree-root-attrs 'id=r1,lang=en' "$(val R22-tree-root-attrs)"
check_eq libxml-parser-perl/tree-child-count 3 "$(val R23-tree-child-count)"
check_eq libxml-parser-perl/tree-child-tags 'item,item,empty' "$(val R24-tree-child-tags)"
check_eq libxml-parser-perl/tree-item-attrs 'n=1'   "$(val R25-tree-item1-attrs)"
check_eq libxml-parser-perl/tree-item-text  alpha   "$(val R26-tree-item1-text)"
# MIXED CONTENT is the case a naive tree walk gets wrong: <item n="2"> holds
# text, then <b>, then more text, and the two runs are SEPARATE entries around
# the child rather than one concatenated string. A walker that merged them would
# pass tree-item2-text and fail tree-item2-runs.
check_eq libxml-parser-perl/tree-mixed-text  prepost "$(val R27-tree-item2-text)"
check_eq libxml-parser-perl/tree-mixed-runs  2       "$(val R28-tree-item2-runs)"
check_eq libxml-parser-perl/tree-mixed-child b       "$(val R29-tree-item2-child)"
check_eq libxml-parser-perl/tree-nested-text beta    "$(val R30-tree-b-text)"
check_eq libxml-parser-perl/tree-empty-tag   empty   "$(val R31-tree-empty-tag)"
check_eq libxml-parser-perl/tree-empty-len   1       "$(val R32-tree-empty-len)"
# Tree style drops comments and PIs. Pinned because a reimplementation that
# "helpfully" kept them would shift every existing caller's child indices.
check_eq libxml-parser-perl/tree-drops-comment 1 "$(val R33-tree-no-comment)"

# --- WHAT THE TICKET ASKS (3/4): Subs style, asserted as the SEQUENCE --------
check_eq libxml-parser-perl/subs-event-count 12 "$(val R40-subs-event-count)"
check_eq libxml-parser-perl/subs-event-order \
  'start:doc,start:item,end:item,start:item,start:b,end:b,end:item,start:empty,end:empty,comment,pi,end:doc' \
  "$(val R41-subs-event-order)"
check_eq libxml-parser-perl/subs-root-attrs 'id=r1,lang=en' "$(val R42-subs-doc-attrs)"
check_eq libxml-parser-perl/subs-item-attrs 'n=1;n=2'       "$(val R43-subs-item-attrs)"
check_eq libxml-parser-perl/subs-chars 'alpha|pre|beta|post' "$(val R44-subs-chars)"
# comments and PIs reach ordinary handlers even though Tree style discards them
check_eq libxml-parser-perl/subs-comment '_a_comment_'      "$(val R45-subs-comment)"
check_eq libxml-parser-perl/subs-pi      'brintos|mode=test' "$(val R46-subs-pi)"
# an empty element fires BOTH handlers, adjacently -- the case a handler written
# only for <empty></empty> misses
check_eq libxml-parser-perl/subs-empty-pair 'start:empty,end:empty' "$(val R47-subs-empty-pair)"
# the two styles agree about the document they were both given
check_eq libxml-parser-perl/styles-agree 1 "$(val R48-styles-agree)"

# --- WHAT THE TICKET ASKS (4/4): malformed dies in EXPAT'S OWN WORDS ---------
# Every case asserts three things: it died, no tree came back, and the message
# is the entry from libexpat's own table. "It threw" alone is compatible with a
# parser that had already handed a whole document over and then complained.
check_eq libxml-parser-perl/illformed-mismatch-dies    1 "$(val R50-mismatch-died)"
check_eq libxml-parser-perl/illformed-mismatch-no-tree 1 "$(val R51-mismatch-no-tree)"
check_eq libxml-parser-perl/illformed-mismatch-msg 'mismatched tag' "$(val R52-mismatch-msg)"
check_eq libxml-parser-perl/illformed-unclosed-dies    1 "$(val R53-unclosed-died)"
check_eq libxml-parser-perl/illformed-unclosed-no-tree 1 "$(val R54-unclosed-no-tree)"
check_eq libxml-parser-perl/illformed-unclosed-msg 'no element found' "$(val R55-unclosed-msg)"
check_eq libxml-parser-perl/illformed-entity-dies    1 "$(val R56-entity-died)"
check_eq libxml-parser-perl/illformed-entity-no-tree 1 "$(val R57-entity-no-tree)"
check_eq libxml-parser-perl/illformed-entity-msg 'undefined entity' "$(val R58-entity-msg)"
check_eq libxml-parser-perl/illformed-tworoots-dies    1 "$(val R59-tworoots-died)"
check_eq libxml-parser-perl/illformed-tworoots-no-tree 1 "$(val R60-tworoots-no-tree)"
check_eq libxml-parser-perl/illformed-tworoots-msg \
  'junk after document element' "$(val R61-tworoots-msg)"
check_eq libxml-parser-perl/illformed-badattr-dies    1 "$(val R62-badattr-died)"
check_eq libxml-parser-perl/illformed-badattr-no-tree 1 "$(val R63-badattr-no-tree)"
check_eq libxml-parser-perl/illformed-badattr-msg \
  'not well-formed (invalid token)' "$(val R64-badattr-msg)"
# expat's position triple on EVERY one of the five, and the text of the last is
# byte-identical to the entry read straight out of the library in section 4 --
# together, that is what makes the diagnostic expat's rather than a Perl guess
check_eq libxml-parser-perl/illformed-positions '1,1,1,1,1' "$(val R65-msg-has-position)"
check_eq libxml-parser-perl/illformed-msg-from-table 1 "$(val R66-msg-is-expat-table)"

# --- the controls: without these, a parser that refused EVERYTHING passes ----
check_eq libxml-parser-perl/wellformed-parses 1 "$(val R70-wellformed-parses)"
check_eq libxml-parser-perl/reparse-stable    1 "$(val R71-reparse-stable)"
check_eq libxml-parser-perl/no-warnings       0        "$(val R80-warning-count)"
check_eq libxml-parser-perl/no-warnings-text  '<none>' "$(val R81-warnings)"