/XML-TreePP/t/48_blobref.t

 1# ----------------------------------------------------------------
 2    use strict;
 3    use Test::More tests => 8;
 4    BEGIN { use_ok('XML::TreePP') };
 5## ----------------------------------------------------------------
 6{
 7    my $scalar = 'value';
 8    my $obj = MyObject->new( elem => 'value' );
 9    my $tree1 = { hashref   => { elem => 'value' } };
10    my $tree2 = { arrayref  => { elem => [ 'first', 'last' ] }};
11    my $tree3 = { scalarref => \$scalar };
12    my $tree4 = { coderef   => sub {} };
13    my $tree5 = { object    => $obj };
14    my $tree6 = { blob      => *STDIN };
15    my $tree7 = { blobref   => \*STDIN };
16
17    my $tpp = XML::TreePP->new();
18
19    local $SIG{__WARN__} = sub {};  # ignore warn messages
20
21    my $xml1 = $tpp->write( $tree1 );
22    like( $xml1, qr#<elem>value</elem>#, 'no1: HASHREF - child node' );
23
24    my $xml2 = $tpp->write( $tree2 );
25    like( $xml2, qr#<elem>first</elem>\s*<elem>last</elem>#s, 'no2: ARRAYREF - multiple nodes' );
26
27    my $xml3 = $tpp->write( $tree3 );
28    my $exp3 = '<scalarref><![CDATA[value]]></scalarref>';
29    like( $xml3, qr#\Q$exp3\E#, 'no3: SCALARREF - cdata node' );
30
31    my $xml4 = $tpp->write( $tree4 );
32    like( $xml4, qr#xml#, 'no4: CODEREF - undefined behavior rather than die' );
33
34    my $xml5 = $tpp->write( $tree5 );
35    like( $xml5, qr#<elem>value</elem>#, 'no5: OBJECT - as a normal child node' );
36
37    my $xml6 = $tpp->write( $tree6 );
38    like( $xml6, qr#xml#, 'no6: BLOB - undefined behavior rather than die' );
39
40    my $xml7 = $tpp->write( $tree7 );
41    like( $xml7, qr#xml#, 'no7: BLOBREF - undefined behavior rather than die' );
42}
43# ----------------------------------------------------------------
44package MyObject;
45
46sub new {
47    my $class = shift;
48    my $hash = { @_ };
49    bless $hash, $class;
50}
51# ----------------------------------------------------------------
52;1;
53# ----------------------------------------------------------------