#!/usr/bin/env perl

use warnings;
use strict;

use lib 'lib','t';
use TestTools;

use XML::Compile::Schema;
use XML::Compile::Tester;

use Test::More tests => 182;

set_compile_defaults
    elements_qualified => 'NONE';

my $schema   = XML::Compile::Schema->new( <<__SCHEMA__ );
<schema targetNamespace="$TestNS"
        xmlns="$SchemaNS"
        xmlns:me="$TestNS">

<!-- all with one element -->

<element name="test1" type="me:t1" />
<complexType name="t1">
  <all>
    <element name="t1_a" type="int" />
  </all>
</complexType>

<element name="test2">
  <complexType>
    <all>
       <element name="t2_a" type="int" />
    </all>
  </complexType>
</element>

<!-- all with more elements -->

<element name="test3" type="me:t3" />
<complexType name="t3">
  <all>
    <element name="t3_a" type="int" />
    <element name="t3_b" type="int" />
    <element name="t3_c" type="int" />
  </all>
</complexType>

<element name="test4" type="me:t4" />
<complexType name="t4">
  <all>
    <element name="t4_a" type="int" />
    <sequence>
       <element name="t4_b" type="int" />
       <element name="t4_c" type="int" />
    </sequence>
    <element name="t4_d" type="int" />
  </all>
</complexType>

<!-- multiple picks -->

<element name="test5">
  <complexType name="t5">
    <all minOccurs="0" maxOccurs="unbounded">
      <element name="t5_a" type="int" />
      <element name="t5_b" type="int" />
      <element name="t5_c" type="int" />
    </all>
  </complexType>
</element>

<element name="test6">
  <complexType name="t6">
    <all minOccurs="1" maxOccurs="3">
      <element name="t6_a" type="int" />
      <element name="t6_b" type="int" />
      <element name="t6_c" type="int" />
    </all>
  </complexType>
</element>

</schema>
__SCHEMA__

ok(defined $schema);
my $error;

test_rw($schema, test1 => <<__XML, {t1_a => 10});
<test1><t1_a>10</t1_a></test1>
__XML

$error = error_r($schema, test1 => <<__XML);
<test1><t1_a>8</t1_a><extra>9</extra></test1>
__XML
is($error, "element `extra' not processed for {http://test-types}test1 at /test1/extra");

# all itself is not a all, unless minOccurs=0
$error = error_r($schema, test1 => <<__XML);
<test1 />
__XML
is($error, "data for element or block starting with `t1_a' missing at {http://test-types}test1");

test_rw($schema, test1 => undef, {});

test_rw($schema, test2 => <<__XML, {t2_a => 11});
<test2><t2_a>11</t2_a></test2>
__XML

# test 3

foreach my $f
 ( [qw/t3_a t3_b t3_c/ ]
 , [qw/t3_a t3_c t3_b/ ]
 , [qw/t3_b t3_a t3_c/ ]
 , [qw/t3_b t3_c t3_a/ ]
 , [qw/t3_c t3_a t3_b/ ]
 , [qw/t3_c t3_b t3_a/ ]
 )
{   my %f = ( $f->[0] => 13, $f->[1] => 14, $f->[2] => 15 );
    ok(1, "try $f->[0], $f->[1], $f->[2]");

    test_rw($schema, test3 => <<__XML, \%f, <<__XMLWriter);
<test3>
   <$f->[0]>13</$f->[0]>
   <$f->[1]>14</$f->[1]>
   <$f->[2]>15</$f->[2]>
</test3>
__XML
<test3>
   <t3_a>$f{t3_a}</t3_a>
   <t3_b>$f{t3_b}</t3_b>
   <t3_c>$f{t3_c}</t3_c>
</test3>
__XMLWriter

    $error = error_r($schema, test3 => <<__XML);
<test3>
   <$f->[0]>13</$f->[0]>
   <$f->[1]>14</$f->[1]>
</test3>
__XML

    is($error, "data for element or block starting with `$f->[2]' missing at {http://test-types}test3");

    $error = error_r($schema, test3 => <<__XML);
<test3>
   <$f->[0]>13</$f->[0]>
</test3>
__XML

    like($error, qr/^data for element or block starting with `.*' missing at \{http\:\/\/test-types\}test3$/);
}

# test 4

test_rw($schema, test4 => <<__XML, {t4_a=>16, t4_b=>17, t4_c=>18, t4_d=>19});
<test4><t4_a>16</t4_a><t4_b>17</t4_b><t4_c>18</t4_c><t4_d>19</t4_d></test4>
__XML

my %t4b = (t4_a=>20, t4_b=>22, t4_c=>23, t4_d=>21);
test_rw($schema, test4 => <<__XML, \%t4b, <<__XML2);
<test4><t4_a>20</t4_a><t4_d>21</t4_d><t4_b>22</t4_b><t4_c>23</t4_c></test4>
__XML
<test4><t4_a>20</t4_a><t4_b>22</t4_b><t4_c>23</t4_c><t4_d>21</t4_d></test4>
__XML2

$error = error_r($schema, test4 => <<__XML);
<test4><t4_a>24</t4_a><t4_d>25</t4_d><t4_c>26</t4_c><t4_b>27</t4_b></test4>
__XML
is($error, "data for element or block starting with `t4_b' missing at {http://test-types}test4");

# test 5

my %t5_a =
 ( all_t5_a => [ { t5_a => 23
               , t5_b => 24
               , t5_c => 25
               } ]
 );

test_rw($schema, test5 => <<__XML, \%t5_a);
<test5><t5_a>23</t5_a><t5_b>24</t5_b><t5_c>25</t5_c></test5>
__XML

my %t5_b = (all_t5_a =>
  [ { t5_a => 30
    , t5_b => 31
    , t5_c => 32
    }
  , { t5_a => 35
    , t5_b => 34
    , t5_c => 33
    }
  ]);

test_rw($schema, test5 => <<__XML, \%t5_b, <<__XML2);
<test5>
  <t5_a>30</t5_a><t5_b>31</t5_b><t5_c>32</t5_c>
  <t5_c>33</t5_c><t5_b>34</t5_b><t5_a>35</t5_a>
</test5>
__XML
<test5>
  <t5_a>30</t5_a><t5_b>31</t5_b><t5_c>32</t5_c>
  <t5_a>35</t5_a><t5_b>34</t5_b><t5_c>33</t5_c>
</test5>
__XML2

test_rw($schema, test5 => '<test5/>', {});

# test 6

$error = error_r($schema, test6 => '<test6 />');
like($error, qr[data for element or block starting with `t6_[abc]' missing at \{http://test-types\}test6]);

$error = error_w($schema, test6 => {});
is($error, "found 0 blocks for `all_t6_a', must be between 1 and 3 inclusive at {http://test-types}test6");