view release on metacpan or  search on metacpan

t/g_void.t  view on Meta::CPAN

#!/usr/bin/perl

# Verify that all callback handlers work correctly with G_VOID|G_DISCARD.
# Each handler modified by the G_VOID change is exercised and checked
# for correct invocation and argument passing.

use strict;
use warnings;

use Test::More;
use XML::Parser;

# Track which handlers were called and with what arguments
my %called;

# --- Handler subs ---

sub h_start {
    my ($p, $el, %atts) = @_;
    $called{Start}++;
    $called{Start_el} = $el if $el eq 'root' || $el eq 'child';
    $called{Start_att} = $atts{id} if defined $atts{id};
}

sub h_end {
    my ($p, $el) = @_;
    $called{End}++;
    $called{End_el} = $el if $el eq 'root';
}

sub h_char {
    my ($p, $str) = @_;
    $called{Char}++ if $str =~ /\S/;
    $called{Char_data} .= $str;
}

sub h_proc {
    my ($p, $target, $data) = @_;
    $called{Proc}++;
    $called{Proc_target} = $target;
    $called{Proc_data} = $data;
}

sub h_comment {
    my ($p, $str) = @_;
    $called{Comment}++;
    $called{Comment_data} = $str;
}

sub h_cdata_start {
    my ($p) = @_;
    $called{CdataStart}++;
}

sub h_cdata_end {
    my ($p) = @_;
    $called{CdataEnd}++;
}

sub h_default {
    my ($p, $str) = @_;
    $called{Default}++;
}

# --- Test 1: Basic handlers (Char, Start, End, Proc, Comment, CdataStart, CdataEnd, Default) ---

my $doc1 = <<'XML';
<?xml version="1.0"?>
<root id="test1">
  <?mytarget mydata?>
  <!-- a comment -->
  <child>Hello world</child>
  <![CDATA[cdata content]]>
</root>
XML

%called = ();
my $p1 = XML::Parser->new(
    Handlers => {
        Start      => \&h_start,
        End        => \&h_end,
        Char       => \&h_char,
        Proc       => \&h_proc,
        Comment    => \&h_comment,
        CdataStart => \&h_cdata_start,
        CdataEnd   => \&h_cdata_end,
    }
);
$p1->parse($doc1);

ok($called{Start} && $called{Start} >= 2, 'Start handler called for elements');
is($called{Start_att}, 'test1', 'Start handler receives attributes');
ok($called{End} && $called{End} >= 2, 'End handler called');
is($called{End_el}, 'root', 'End handler receives element name');
ok($called{Char}, 'Char handler called');
like($called{Char_data}, qr/Hello world/, 'Char handler receives text content');
like($called{Char_data}, qr/cdata content/, 'Char handler receives CDATA text');
is($called{Proc}, 1, 'Proc handler called once');
is($called{Proc_target}, 'mytarget', 'Proc handler receives target');
like($called{Proc_data}, qr/mydata/, 'Proc handler receives data');
is($called{Comment}, 1, 'Comment handler called once');
like($called{Comment_data}, qr/a comment/, 'Comment handler receives comment text');
is($called{CdataStart}, 1, 'CdataStart handler called');
is($called{CdataEnd}, 1, 'CdataEnd handler called');

# --- Test 2: Default handler ---

%called = ();
my $p2 = XML::Parser->new(
    Handlers => {
        Default => \&h_default,
    }
);
$p2->parse('<root>text</root>');
ok($called{Default} && $called{Default} > 0, 'Default handler called');

# --- Test 3: Declaration handlers (Entity, Element, Attlist, Doctype, DoctypeFin, XMLDecl) ---

my %decl;

sub h_entity {
    my ($p, $name, $val, $sys, $pub, $notation) = @_;
    $decl{Entity}++;
    $decl{Entity_name} = $name if defined $name;
    $decl{Entity_val}  = $val  if defined $val && $name eq 'myent';
}

sub h_element {
    my ($p, $name, $model) = @_;
    $decl{Element}++;
    $decl{Element_name} = $name if $name eq 'item';
}

sub h_attlist {
    my ($p, $elname, $attname, $type, $default, $fixed) = @_;
    $decl{Attlist}++;
    $decl{Attlist_el}  = $elname;
    $decl{Attlist_att} = $attname;
}

sub h_doctype {
    my ($p, $name, $sys, $pub, $internal) = @_;
    $decl{Doctype}++;
    $decl{Doctype_name} = $name;
}

sub h_doctype_fin {
    my ($p) = @_;
    $decl{DoctypeFin}++;
}

sub h_xmldecl {
    my ($p, $version, $encoding, $standalone) = @_;
    $decl{XMLDecl}++;
    $decl{XMLDecl_version} = $version;
}