. "$BST_LIB" require perl libxml-sax-base-perl/present # XML::SAX::Base parses nothing. It is the DISPATCHER every SAX driver and # filter inherits: hand it an event and it finds the right handler slot, calls # the callback there, and caches the lookup -- so a filter can override the two # callbacks it cares about and inherit the other thirty-odd unchanged. That # inheritance is the module's entire stated purpose ("so you don't have to, for # example, implement the characters() callback"), and it is what this suite # measures: a hand-built fourteen-event stream driven through a two-stage filter # chain into a recording sink, then compared event by event at the far end. # # 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 below was first measured against a native # x86-64 perl carrying the identical XML::SAX::Base 1.09 -- the same two pure # Perl modules this recipe ships, with no XS anywhere in the distribution, which # is why a host control is legitimate here and was not for libjson-perl. # ------------------------- 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. The distribution ships TWO modules and # the recipe is only correct if both land: XML::SAX::Base `use`s # XML::SAX::Exception at compile time, so a package carrying only the first # fails at the first `use` rather than at the first thrown error. MOD=$(ls /usr/lib/perl5/vendor_perl/*/XML/SAX/Base.pm 2>/dev/null | head -1) if [ -n "$MOD" ]; then bst_ok libxml-sax-base-perl/module-installed else bst_notok libxml-sax-base-perl/module-installed \ "no XML/SAX/Base.pm under /usr/lib/perl5/vendor_perl"; fi EXC=$(ls /usr/lib/perl5/vendor_perl/*/XML/SAX/Exception.pm 2>/dev/null | head -1) if [ -n "$EXC" ]; then bst_ok libxml-sax-base-perl/exception-installed else bst_notok libxml-sax-base-perl/exception-installed \ "no XML/SAX/Exception.pm under /usr/lib/perl5/vendor_perl -- XML::SAX::Base use's it at compile time"; fi check libxml-sax-base-perl/payload-installed \ test -f "$BST_DATA/libxml-sax-base-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::Base` 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. So the two module-load cases below place the defect in the # interpreter rather than in this port, and the filesystem facts above stay # green beside them. # # 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 # 71 cases below anyway -- measured on the sibling port (BRINTOS-1006) at 70 # reds of 70 and a 6.0 GiB host peak, which costs every suite scheduled after # this one in the same sweep. pout=$(perl -MXML::SAX::Base -e 'print "SAXBASE-OK\n"' 2>&1); prc=$? case "$pout" in *SAXBASE-OK*) bst_ok libxml-sax-base-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 (`mremap_chunk(): invalid pointer`), 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-base-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 criterion is the FILTER # CHAIN -- fourteen events through two filters, arriving in order and # unmodified except where a filter rewrites them -- and that is exactly what # could not be measured. A suite that merely stopped here would report three # greens and read as a pass. bst_notok libxml-sax-base-perl/filter-chain-unverified \ "not run: perl cannot load the module (linux-in-the-browser#154) -- event order, pass-through fidelity, the deliberate rewrites and handler-slot routing are unverified on wasm32-hwjs" exit 0 ;; esac # ------------------------- 2. the module's own answers, at values ------------ out=$(perl "$BST_DATA/libxml-sax-base-perl-selftest.pl" 2>&1); rc=$? case "$out" in *ALL-SAXBASE-OK*) all=1 ;; *) all=0 ;; esac if [ "$rc" -eq 0 ] && [ "$all" -eq 1 ]; then bst_ok libxml-sax-base-perl/all-ok else bst_notok libxml-sax-base-perl/all-ok "rc=$rc $(_bst_1line "$out")"; fi val() { printf '%s\n' "$out" | awk -v t="$1" '$1==t{ $1=""; sub(/^ /,""); print; exit }'; } # --- both modules load, from the image rather than a stray @INC dir --------- check_eq libxml-sax-base-perl/version 1.09 "$(val R1-version)" check_eq libxml-sax-base-perl/exception-version 1.09 "$(val R3-exception-version)" case "$(val R2-inc-path)" in /usr/*) bst_ok libxml-sax-base-perl/installed-path ;; *) bst_notok libxml-sax-base-perl/installed-path "Base.pm resolved to $(val R2-inc-path)" ;; esac case "$(val R4-exception-inc-path)" in /usr/*) bst_ok libxml-sax-base-perl/exception-path ;; *) bst_notok libxml-sax-base-perl/exception-path "Exception.pm resolved to $(val R4-exception-inc-path)" ;; esac # --- WHAT THE TICKET ASKS FOR: fourteen events, two filters, one sink ------- # driver -> My::Upper (rewrites text) -> My::Retag (renames one element) # -> My::Sink (records) # Every event is delivered, none is invented, and the order at the far end is # the order the driver emitted. R11 is the case that fails if any callback the # filters did NOT override was dropped -- which is the whole inheritance claim. CHAIN='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' check_eq libxml-sax-base-perl/chain-count 14 "$(val R10-chain-count)" check_eq libxml-sax-base-perl/chain-order "$CHAIN" "$(val R11-chain-order)" # the deliberate rewrites: stage 1 uppercases text, in both places check_eq libxml-sax-base-perl/filter-text-outer HELLO "$(val R12-chars-outer)" check_eq libxml-sax-base-perl/filter-text-inner 'INNER\sTEXT' "$(val R13-chars-inner)" # ...and NOWHERE else. ignorable_whitespace() carries text through a different # callback; a filter that hooked the wrong one, or a base that routed whitespace # through the text path, uppercases nothing here but would arrive rewritten. check_eq libxml-sax-base-perl/whitespace-untouched '\n\s\s' "$(val R14-ws-untouched)" # stage 2 renames exactly one element, on both the start and the end event -- # an asymmetry here would leave a document whose tags do not balance. check_eq libxml-sax-base-perl/filter-rename-start root,bee "$(val R15-elem-names)" check_eq libxml-sax-base-perl/filter-rename-end bee,root "$(val R16-end-elem-names)" # --- attributes survive both stages, byte for byte -------------------------- # The root element is touched by neither filter, so its attribute hash is the # pass-through case at its strictest: same count, same values, same keys. check_eq libxml-sax-base-perl/attrs-count 2 "$(val R17-root-attr-count)" check_eq libxml-sax-base-perl/attrs-value-id r1 "$(val R18-root-attr-id)" check_eq libxml-sax-base-perl/attrs-value-lang en "$(val R19-root-attr-lang)" check_eq libxml-sax-base-perl/attrs-elem-name root "$(val R20-root-name)" # the renamed element keeps the attribute it arrived with and gains the one the # filter injects -- a rewrite that dropped the original would still rename fine check_eq libxml-sax-base-perl/rewritten-attr-keys '{}n,{}tagged' "$(val R21-b-attr-keys)" check_eq libxml-sax-base-perl/rewritten-attr-original 7 "$(val R22-b-attr-original)" check_eq libxml-sax-base-perl/rewritten-attr-injected yes "$(val R23-b-attr-injected)" # --- the events NEITHER filter implements, compared at values --------------- # These are the inheritance claim itself: neither My::Upper nor My::Retag has a # processing_instruction(), comment(), xml_decl() or *_prefix_mapping() method, # and all four still arrive with their fields intact. check_eq libxml-sax-base-perl/pi-passthrough 'brintos|mode=test' "$(val R24-pi)" check_eq libxml-sax-base-perl/comment-passthrough '\sa\scomment\s' "$(val R25-comment)" check_eq libxml-sax-base-perl/xml-decl-passthrough '1.0|UTF-8|yes' "$(val R26-xml-decl)" check_eq libxml-sax-base-perl/prefix-mapping 'x|http://example.org/x' "$(val R27-prefix-mapping)" check_eq libxml-sax-base-perl/end-prefix-mapping x "$(val R28-end-prefix-mapping)" # --- the caller's own data is not edited under it --------------------------- # The filters copy before rewriting. A filter that edited in place would have # uppercased the driver's still-live hash and added an attribute to the driver's # attribute map -- silent corruption a downstream-only check cannot see. check_eq libxml-sax-base-perl/no-upstream-mutation hello "$(val R29-driver-hash-intact)" check_eq libxml-sax-base-perl/no-upstream-attr-mutation '{}id,{}lang' "$(val R30-driver-attrs-intact)" # --- the default behaviour, with no override anywhere ----------------------- BARE='start_document,start_element,characters,comment,end_element,end_document' check_eq libxml-sax-base-perl/bare-passthrough-order "$BARE" "$(val R31-bare-order)" check_eq libxml-sax-base-perl/bare-passthrough-text unchanged "$(val R32-bare-text)" # identity, not equality: the base forwards @_ untouched, so the sink holds the # very hashref the caller emitted. A dispatcher that copied would pass R32 and # fail this. check_eq libxml-sax-base-perl/bare-same-ref 1 "$(val R33-bare-same-ref)" # a subclass that overrides NOTHING is still a working filter SUBC='start_document,start_element,characters,end_element,end_document' check_eq libxml-sax-base-perl/subclass-order "$SUBC" "$(val R34-subclass-order)" check_eq libxml-sax-base-perl/subclass-text sub "$(val R35-subclass-text)" # --- WHICH handler slot each event goes 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. Asserting the slot by # NAME rather than asserting "something received it" is what separates the two. check_eq libxml-sax-base-perl/slot-content-first ContentHandler "$(val R40-start-element-slot)" check_eq libxml-sax-base-perl/slot-document-next DocumentHandler "$(val R41-start-element-no-content)" check_eq libxml-sax-base-perl/slot-handler-last Handler "$(val R42-start-element-handler-only)" check_eq libxml-sax-base-perl/slot-comment DocumentHandler "$(val R43-comment-slot)" check_eq libxml-sax-base-perl/slot-comment-lexical LexicalHandler "$(val R44-comment-no-document)" check_eq libxml-sax-base-perl/slot-end-entity LexicalHandler "$(val R45-end-entity-slot)" check_eq libxml-sax-base-perl/slot-notation DTDHandler "$(val R46-notation-slot)" check_eq libxml-sax-base-perl/slot-error ErrorHandler "$(val R47-error-slot)" # --- get_handler / set_handler, including the mid-stream switch ------------- check_eq libxml-sax-base-perl/get-handler-default 1 "$(val R50-get-handler-default)" check_eq libxml-sax-base-perl/get-handler-unset '' "$(val R51-get-handler-unset)" check_eq libxml-sax-base-perl/set-handler-returns 1 "$(val R52-set-handler-returns)" # The switch must invalidate the per-event method cache the first dispatch # installed. If it does not, both events land on the first handler and this # reads 2,0 -- a green "set_handler returned 1" beside a filter that never # actually switched. check_eq libxml-sax-base-perl/switch-invalidates-cache '1,1' "$(val R53-switch-counts)" check_eq libxml-sax-base-perl/switch-delivers-second second "$(val R54-switch-second)" check_eq libxml-sax-base-perl/typed-handler-roundtrip 1 "$(val R55-typed-roundtrip)" check_eq libxml-sax-base-perl/typed-handler-distinct 1 "$(val R56-typed-not-handler)" # --- no handler at all ------------------------------------------------------ # new() with no handler of any kind installs a private no-op, so a driver built # before its sink exists still runs rather than dying on an undefined method. check_eq libxml-sax-base-perl/nohandler-class XML::SAX::Base::NoHandler "$(val R60-nohandler-class)" check_eq libxml-sax-base-perl/nohandler-silent 1 "$(val R61-nohandler-silent)" # --- features: the SAX2 property surface ------------------------------------ # namespaces is turned ON by new() itself, which is the one feature every SAX2 # parser must support; everything else in the table is recognized-but-refused. check_eq libxml-sax-base-perl/feature-ns-default 1 "$(val R70-ns-default)" check_eq libxml-sax-base-perl/feature-ns-settable 0 "$(val R71-ns-after-set)" check_eq libxml-sax-base-perl/feature-table-size 13 "$(val R72-features-count)" check_eq libxml-sax-base-perl/feature-supported-size 1 "$(val R73-supported-count)" # The two refusals carry nearly the same sentence and mean opposite things to a # caller -- "I know that name and do not implement it" versus "I have never # heard of it" -- so both the CLASS and the MESSAGE are asserted. check_eq libxml-sax-base-perl/feature-unsupported-class \ XML::SAX::Exception::NotSupported "$(val R74-unsupported-get-class)" check_eq libxml-sax-base-perl/feature-unsupported-msg \ "The feature 'http://xml.org/sax/features/namespace-prefixes' is not supported by XML::SAX::Base" \ "$(val R75-unsupported-get-msg)" check_eq libxml-sax-base-perl/feature-unsupported-set-class \ XML::SAX::Exception::NotSupported "$(val R76-unsupported-set-class)" check_eq libxml-sax-base-perl/feature-unrecognized-class \ XML::SAX::Exception::NotRecognized "$(val R77-unrecognized-get-class)" check_eq libxml-sax-base-perl/feature-unrecognized-msg \ "The feature 'http://example.org/no-such-feature' is not recognized by XML::SAX::Base" \ "$(val R78-unrecognized-get-msg)" check_eq libxml-sax-base-perl/feature-unrecognized-set-class \ XML::SAX::Exception::NotRecognized "$(val R79-unrecognized-set-class)" # --- XML::SAX::Exception, the second module the recipe ships ---------------- check_eq libxml-sax-base-perl/exception-isa-notrecognized 1 "$(val R80-isa-notrecognized)" check_eq libxml-sax-base-perl/exception-isa-notsupported 1 "$(val R81-isa-notsupported)" check_eq libxml-sax-base-perl/exception-isa-parse 1 "$(val R82-isa-parse)" # stringify is an operator overload, so it is the thing a caller printing $@ # actually gets; the located form is a different branch of it. check_eq libxml-sax-base-perl/exception-stringify 'plain\strouble\n' "$(val R83-stringify-plain)" check_eq libxml-sax-base-perl/exception-stringify-located \ 'located\strouble\s[Ln:\s12,\sCol:\s34]\n' "$(val R84-stringify-located)" # throw() on an instance re-dies that object rather than wrapping it in a new one check_eq libxml-sax-base-perl/exception-throw-instance XML::SAX::Exception "$(val R85-throw-instance-class)" check_eq libxml-sax-base-perl/exception-throw-class 'thrown by class' "$(val R86-throw-class-msg)" check_eq libxml-sax-base-perl/exception-message-required 1 "$(val R87-no-message-dies)" # --- the parse() plumbing a driver and a filter each rely on ---------------- # A bare base is not a parser: parse() with a Source and no _parse_* routine # says so rather than returning empty-handed. check_eq libxml-sax-base-perl/parse-no-routine \ 'No _parse_* routine defined on this driver' "$(val R90-parse-no-routine)" # ...but a FILTER (one with a Parent) hands the merged options up the chain, # which is how parse_string on the end of a filter stack reaches the real parser. check_eq libxml-sax-base-perl/filter-delegates-to-parent PARENT-PARSED "$(val R91-filter-delegates)" check_eq libxml-sax-base-perl/filter-forwards-source '' "$(val R92-filter-source)" check_eq libxml-sax-base-perl/get-options-merge 'Extra,Handler' "$(val R93-get-options-merge)" # --- the AUTOLOAD dispatch path --------------------------------------------- # The second way a handler can answer: no callback exists by name, so ->can() # fails and the base falls through to an AUTOLOAD branch. A dispatcher carrying # only the ->can() half passes every case above and delivers nothing here. check_eq libxml-sax-base-perl/autoload-handler "$SUBC" "$(val R95-autoload-order)" check_eq libxml-sax-base-perl/no-op-returns-undef '' "$(val R96-no-op-returns)"