view release on metacpan or  search on metacpan

t/builtin.t  view on Meta::CPAN

package XML::Schema::Test::Binary::Good;
use base qw( XML::Schema::Type::binary );
use vars qw( @FACETS );

@FACETS = (
    encoding => 'base64',
    length   => 4,
);

package main;

$pkg = 'XML::Schema::Test::Binary::Good';
$bin = $pkg->new();
ok( $bin );
ok( $bin->instance(pack('C4', 65, 66, 67, 68)) );
ok( ! $bin->instance(pack('C5', 65, 66, 67, 68, 69)) );
match( $bin->error(), "string has 5 characters (required length: 4)" );

#------------------------------------------------------------------------
# uriReference

#------------------------------------------------------------------------
# ID 

#------------------------------------------------------------------------
# IDREF

#------------------------------------------------------------------------
# ENTITY

#------------------------------------------------------------------------
# QName

$pkg = 'XML::Schema::Type::QName';
my $qname = $pkg->new();
my $q;
ok( $q = $qname->instance("foo") );
match( $q->{ prefix }, '' );
match( $q->{ local }, 'foo' );
ok( $q = $qname->instance("foo:bar") );
match( $q->{ prefix }, 'foo' );
match( $q->{ local }, 'bar' );
ok( $q = $qname->instance("foo-bar:biz-baz") );
match( $q->{ prefix }, 'foo-bar' );
match( $q->{ local }, 'biz-baz' );

ok( ! $qname->instance('') );
match( $qname->error(), 'value is empty' );
ok( ! $qname->instance("999") );
match( $qname->error(), 'value is not a valid QName' );


#========================================================================
# Derived datatypes
#========================================================================

#------------------------------------------------------------------------
# CDATA

$pkg = 'XML::Schema::Type::CDATA';
my $cdata = $pkg->new();
ok( $cdata );
match( $cdata->name(), 'CDATA' );

$item = $cdata->instance("  \tThe cat\n\tsat on\r\tthe mat\n\t  ");
ok( $item );
match( $item->{ value }, "   The cat  sat on  the mat    ");

#------------------------------------------------------------------------
# token

$pkg = 'XML::Schema::Type::token';
my $token = $pkg->new();
ok( $token );
match( $token->name(), 'token' );

$item = $token->instance("  \tThe cat\n\tsat on\r\tthe mat\n\t  ");
ok( $item );
match( $item->{ value }, "The cat sat on the mat");

#------------------------------------------------------------------------
# language

$pkg = 'XML::Schema::Type::language';
my $lang = $pkg->new();
$item = $lang->instance("not a language");
ok( !$item );
match( $lang->error(), 'value is not a language' );
ok( $lang->instance("en-GB") );

#------------------------------------------------------------------------
# IDREFS
# ENTITIES

#------------------------------------------------------------------------
# NMTOKEN

$pkg = 'XML::Schema::Type::NMTOKEN';
$token = $pkg->new();
ok( $token );
ok( $token->instance('foo_bar:baz') );
ok( $token->instance('_foo-bar:baz.wiz_') );
ok( $token->instance('_foo-bar:baz.wiz_') );
match( $token->instance('  99-flake  ')->{ value }, '99-flake' );
ok( !$token->instance('foo!bar') );
match( $token->error(), 'value is not a valid NMTOKEN' );

#------------------------------------------------------------------------
# NMTOKENS

#------------------------------------------------------------------------
# Name

$pkg = 'XML::Schema::Type::Name';
my $name = $pkg->new();
ok( $name->instance("foo") );
ok( $name->instance(":foo") );
ok( $name->instance("  _foo_bar.baz-wiz:wax  ") );
ok( ! $name->instance("-foo") );
match( $name->error(), 'value is not a valid Name' );

#------------------------------------------------------------------------
# NCName

$pkg = 'XML::Schema::Type::NCName';