#!/usr/bin/perl # test facets on list elements use warnings; use strict; use lib 'lib','t'; use TestTools; use XML::Compile::Schema; use XML::Compile::Tester; use Test::More; use XML::LibXML; BEGIN { # old libxml2 versions break on regex 123\\s+(\\d+\\s)*456 # there are so many bugs in old libxml2 releases! my $xml2_version = XML::LibXML::LIBXML_DOTTED_VERSION(); $xml2_version lt '2.7' and plan skip_all => "Your libxml2 is too old (version $xml2_version)"; plan tests => 60; } set_compile_defaults elements_qualified => 'NONE' , sloppy_integers => 1; my $schema = XML::Compile::Schema->new( <<__SCHEMA__ ); __SCHEMA__ ok(defined $schema); ### test length my $error = error_r($schema, test1 => <<_XML); 9 10 11 _XML is($error, "list `9 10 11' does not have required length 2 at {http://test-types}test1#facet"); $error = error_r($schema, test1 => <<_XML); 12 _XML is($error, "list `12' does not have required length 2 at {http://test-types}test1#facet"); $error = error_w($schema, test1 => [13]); is($error, "list `13' does not have required length 2 at {http://test-types}test1#facet"); $error = error_w($schema, test1 => [14, 15, 16]); is($error, "list `14 15 16' does not have required length 2 at {http://test-types}test1#facet"); test_rw($schema, test1 => <<_XML, [17, 18]); 17 18 _XML ### test patterns test_rw($schema, test2 => <<_XML, [123, 456]); 123 456 _XML test_rw($schema, test2 => <<_XML, [123, 987, 456]); 123 987 456 _XML test_rw($schema, test2 => <<_XML, [123, 987, 567, 456]); 123 987 567 456 _XML $error = error_r($schema, test2 => <<_XML); 999 _XML is($error, "string `999' does not match pattern `123\\s+(\\d+\\s)*456' at {http://test-types}test2#facet"); $error = error_w($schema, test2 => [111, 999]); is($error, "string `111 999' does not match pattern `123\\s+(\\d+\\s)*456' at {http://test-types}test2#facet");