#!/usr/bin/perl
use warnings;
use strict;
use lib 'lib','t';
use TestTools;
use XML::Compile::Schema;
use XML::Compile::Tester;
use Test::More tests => 230;
use Log::Report 'try';
set_compile_defaults
elements_qualified => 'NONE';
my $schema = XML::Compile::Schema->new( <<__SCHEMA__ );
__SCHEMA__
ok(defined $schema);
#
# sequence as direct type
#
ok(1, "** Testing sequence with 1 element");
test_rw($schema, test1 => <<__XML, {t1_a => 41});
41
__XML
test_rw($schema, test3 => <<__XML, {t3_a => 43});
43
__XML
ok(1, "** Testing sequence with 2 elements");
test_rw($schema, test5 => <<__XML, {t5_a => 47, t5_b => 48});
4748
__XML
test_rw($schema, test6 => <<__XML, {t6_a => 48, t6_b => 49});
4849
__XML
{ set_compile_defaults
check_occurs => 1
, elements_qualified => 'NONE';
my $error = error_r($schema, test6 => <<__XML);
50
__XML
is($error, "data for element or block starting with `t6_a' missing at {http://test-types}test6");
}
# The next is not correct, but when we do not check occurrences it is...
{ set_compile_defaults
check_occurs => 0
, elements_qualified => 'NONE';
test_rw($schema, test7 => <<__XML, {t7_b => [16], t7_c => [17]});
16
17
__XML
}
set_compile_defaults
elements_qualified => 'NONE';
{ my $error = error_r($schema, test7 => <<__XML);
16
17
__XML
is($error, "data for element or block starting with `t7_c' missing at {http://test-types}test7");
}
my %r7 = (t7_a => 20, t7_b => [21,22], t7_c => [23,24], t7_d => [25],
t7_e => [26,27,28]);
test_rw($schema, test7 => <<__XML, \%r7);
20
21
22
23
24
25
26
27
28
__XML
my %r8a = qw/t8_a 30 t8_b 31 t8_c 32 t8_d 33 t8_e 34 t8_f 35/;
test_rw($schema, test8 => <<__XML, \%r8a);
30
31
32
33
34
35
__XML
my %r9a = qw/t9_a 30 t9_b 31 t9_c 32 t9_d 33 t9_e 34 t9_f 35/;
test_rw($schema, test9 => <<__XML, \%r9a);
30
31
32
33
34
35
__XML
##### test 2
my %r2a = qw/t2_a 30 t2_b 31 t2_c 32 t2_d 33 t2_e 34 t2_f 35/;
test_rw($schema, test2 => <<__XML, \%r2a);
30
31
32
33
34
35
__XML
#### test 4
my %t4a =
( t4_a => 40
, seq_t4_b => [ {t4_b => 41, t4_c => [42]} ]
, t4_d => 43
);
test_rw($schema, test4 => <<__XML, \%t4a);
40
41
42
43
__XML
my %t4b =
( t4_a => 50
, seq_t4_b => [ {t4_b => 51, t4_c => [52, 53]}
, {t4_b => 54}
, {t4_b => 55, t4_c => [56]}
]
, t4_d => 57
);
test_rw($schema, test4 => <<__XML, \%t4b);
50
51
52
53
54
55
56
57
__XML
my %t4c = (t4_a => 60, t4_d => 61);
test_rw($schema, test4 => <<__XML, \%t4c);
60
61
__XML
##### test 11
my %t11a = (t11_a => 20, seq_t11_b => [ {t11_b => 21, t11_c => 22 } ] );
test_rw($schema, test11 => <<__XML, \%t11a);
20
21
22
__XML
my %t11b = (seq_t11_b =>
[ {t11_b => 30, t11_c => 31 }
, {t11_b => 32, t11_c => 33 }
, {t11_b => 34, t11_c => 35 }
]
);
test_rw($schema, test11 => <<__XML, \%t11b);
30
31
32
33
34
35
__XML
my %t11c = (seq_t11_b =>
[ { t11_c => 40 }
, {t11_b => 41, t11_c => 42 }
, { t11_c => 43 }
, {t11_b => 44, t11_c => 45 }
, { t11_c => 46 }
]
);
test_rw($schema, test11 => <<__XML, \%t11c);
40
41
42
43
44
45
46
__XML
### test 12
test_rw($schema, test12 => <<__XML, {t12 => 50});
50
__XML
test_rw($schema, test12 => <<__XML, {});
__XML
### test 13
test_rw($schema, test13 => <<__XML, {});
__XML
### test 14
try { error_r($schema, test14 => '') };
my $e14 = $@->wasFatal;
is("$e14", "error: complexType contains particles, simpleContent or complexContent, not `element' at {http://test-types}test14\n");
### test 15
try { error_r($schema, test15 => '') };
my $e15 = $@->wasFatal;
is("$e15", "error: complexContent needs extension or restriction, not `element' at {http://test-types}test15\n");
### test 16
test_rw($schema, test16 => <<__XML, {t16b => 51});
51
__XML
### test 17
test_rw($schema, test17 => <<__XML, {t17a => 52});
52
__XML
test_rw($schema, test17 => '', {});
### test 18
test_rw($schema, test18 => <<__XML, {t18a => {t17a => 52}});
52
__XML
### test 19
test_rw($schema, test19 => <<__XML, {test19a => {}} );
__XML
test_rw($schema, test19 => <<__XML, {test19b => {}} );
__XML
### test 20
test_rw($schema, test20 => <<__XML, {a => 1, b => 2, c => 3} );
123
__XML
test_rw($schema, test20 => <<__XML, {a => 4} );
4
__XML
my $error = error_r($schema, test20 => "56");
is($error, "data for element or block starting with `c' missing at {http://test-types}test20");
$error = error_w($schema, test20 => {a => 7, b => 8});
is($error, "required value for element `c' missing at {http://test-types}test20");