#!/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");