#!/usr/bin/perl -w
#============================================================= -*-perl-*-
#
# t/complex.t
#
# Test the XML::Schema::Type::Complex module.
#
# Written by Andy Wardley <abw@kfs.org>
#
# Copyright (C) 2001 Canon Research Centre Europe Ltd.
# All Rights Reserved.
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# $Id: complex.t,v 1.2 2001/12/20 13:26:28 abw Exp $
#
#========================================================================
$^W = 1;
use strict;
use lib qw( ./lib ../lib );
use XML::Schema::Test;
use XML::Schema::Type;
use XML::Schema;
my $DEBUG = 0;
$XML::Schema::Type::Complex::DEBUG = $DEBUG;
#ntests(86);
my $package = 'XML::Schema::Type::Complex';
my $complex = $package->new( );
assert( $complex, $package->error() );
#------------------------------------------------------------------------
# flag denoting mixed content models
#------------------------------------------------------------------------
ok( ! $complex->mixed() );
$complex = $package->new( empty => 1 );
ok( $complex, $package->error() );
ok( ! $complex->mixed() );
$complex->mixed(0);
ok( ! $complex->mixed() );
$complex->mixed(1);
ok( $complex->mixed() );
#------------------------------------------------------------------------
# attributes
#------------------------------------------------------------------------
ok( ! $complex->attribute() );
match( $complex->error(), 'XML::Schema::Attribute: type not specified' );
ok( ! $complex->attribute( name => 'id' ) );
match( $complex->error(), 'XML::Schema::Attribute: type not specified' );
my $attr = $complex->attribute( name => 'id', type => 'foo' );
ok( $attr, $complex->error() );
match( $attr->name(), 'id' );
ok( ! $attr->type() );
match( $attr->error(), 'no such type: foo' );
my $factory = $XML::Schema::FACTORY;
my $foo = $factory->create(
simple => { base => 'string', name => 'fooString', maxLength => 6 }
);
ok( $foo, $factory->error() );
my $bar = $factory->create(
simple => { base => 'string', name => 'barString', maxLength => 12 }
);
ok( $bar, $factory->error() );
my $schema = XML::Schema->new();
ok( $schema, $XML::Schema::ERROR );
$schema->type( fooType => $foo );
$schema->type( barType => $bar );
$attr = $factory->create( attribute => {
name => 'foo',
type => 'fooType',
scope => $schema,
} );
ok( $attr, $factory->error() );
match( $attr->scope(), $schema );
my $cattr = $complex->attribute( $attr );
ok( $cattr, $complex->error() );
match( $attr, $cattr );
match( $cattr->name(), 'foo' );
match( $cattr->typename(), 'fooType' );
match( $cattr->type->name(), 'fooString' );
$cattr = $complex->attribute( 'foo' );
ok( $cattr, $complex->error() );
match( $cattr->name(), 'foo' );
match( $cattr->typename(), 'fooType' );
match( $cattr->type->name(), 'fooString' );
$cattr = $complex->attribute( 'no_such_attr' );
ok( ! $cattr );
match( $complex->error(), 'no such attribute: no_such_attr' );
#------------------------------------------------------------------------
$package = 'XML::Schema::Type::string';
my $string = $package->new( );
ok( $string );
$string->constrain( maxLength => 12 );
$package = 'XML::Schema::Attribute';
$foo = $package->new( name => 'foo', type => $string );
$bar = { type => $string };
$package = 'XML::Schema::Type::Complex';
my $complex2 = $package->new( attributes => { foo => $foo, bar => $bar },
empty => 1 );
ok( $complex2, $package->error() );
my $fooref = $complex2->attribute('foo');
match( $fooref, $foo );
my $barref = $complex2->attribute('bar');
ok( $factory->isa( attribute => $barref ) );
ok( $complex2->attribute( name => 'baz', type => $string ),
$complex2->error() );
my $bzrref = $complex2->attribute('baz');
ok( $factory->isa( attribute => $barref ) );
#------------------------------------------------------------------------
# simpleType creation
#------------------------------------------------------------------------
my $email = $complex->simpleType( name => 'email', base => 'string' );
ok( $email );
$email->constrain( pattern => '\w+@\w+(\.\w+)+' );
my $instance = $email->instance('foo');
ok( ! $instance );
match( $email->error(),
'string mismatch (required pattern: \w+@\w+(\.\w+)+)' );
$instance = $email->instance('foo@bar.com');
ok( $instance );
$email = $complex->simpleType( 'email' );
ok( $email, $complex->error() );
$instance = $email->instance('foo');
ok( ! $instance );
match( $email->error(),
'string mismatch (required pattern: \w+@\w+(\.\w+)+)' );
$instance = $email->instance('foo@bar.com');
ok( $instance, $email->error() );
#------------------------------------------------------------------------
# mixed(), empty() and element_only()
#------------------------------------------------------------------------
$package = 'XML::Schema::Type::Complex';
$complex = $package->new( empty => 1 );
ok( ! $complex->mixed() );
ok( $complex->mixed(1) );
ok( $complex->mixed() );
$complex = $package->new( mixed => 0, empty => 1 );
ok( ! $complex->mixed() );
ok( $complex->mixed(1) );
ok( $complex->mixed() );
# NOTE: ignores mixed because no particle/element/model/etc defined
$complex = $package->new( mixed => 1 );
ok( $complex, $package->error() );
ok( $complex->mixed() );
ok( ! $complex->mixed(0) );
ok( ! $complex->mixed() );
ok( $complex->element_only() );
ok( ! $complex->element_only(0) );
ok( ! $complex->element_only() );
ok( $complex->mixed() );
ok( $complex->element_only(1) );
ok( $complex->element_only() );
ok( ! $complex->mixed() );
ok( $complex->empty() );
#------------------------------------------------------------------------
$package = 'XML::Schema::Type::Complex';
my $inner = $package->new( name => 'inner', type => $string );
ok( $inner, $package->error() );