#!/usr/bin/perl -w
#============================================================= -*-perl-*-
#
# t/attrib.t
#
# Test the XML::Schema::Attribute 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: attribute.t,v 1.2 2001/12/20 13:26:28 abw Exp $
#
#========================================================================
use strict;
use lib qw( ./lib ../lib );
use XML::Schema::Test;
use XML::Schema::Attribute;
use XML::Schema::Type::Builtin;
$^W = 1;
my $DEBUG = grep(/-d/, @ARGV);
$XML::Schema::Scheduler::DEBUG = $DEBUG;
$XML::Schema::Attribute::DEBUG = $DEBUG;
#ntests(86);
my ($pkg, $type, $attrib);
match( XML::Schema::Attribute::FIXED, 'fixed' );
$pkg = 'XML::Schema::Type::string';
$type = $pkg->new();
ok( $type, $pkg->error() );
#------------------------------------------------------------------------
# test type/name arguments are mandatory
#------------------------------------------------------------------------
$pkg = 'XML::Schema::Attribute';
$attrib = $pkg->new();
ok( ! $attrib );
match( $pkg->error(), 'XML::Schema::Attribute: type not specified' );
$attrib = $pkg->new( name => 'myAttr');
ok( ! $attrib );
match( $pkg->error(), 'XML::Schema::Attribute: type not specified' );
$attrib = $pkg->new( type => $type);
ok( ! $attrib );
match( $pkg->error(), 'XML::Schema::Attribute: name not specified' );
$attrib = $pkg->new( name => 'myAttr', type => $type);
ok( $attrib );
match( $attrib->name(), 'myAttr' );
#------------------------------------------------------------------------
# test all basic accessors
#------------------------------------------------------------------------
$attrib = $pkg->new({
name => 'myAttr',
type => $type,
namespace => 'myNamespace',
scope => 'global',
});
ok( $attrib, $pkg->error() );
match( $attrib->name(), 'myAttr' );
match( $attrib->type(), $type );
match( $attrib->namespace(), 'myNamespace' );
match( $attrib->scope(), 'global' );
ok( $attrib->namespace('newNamespace') );
match( $attrib->namespace(), 'newNamespace' );
#------------------------------------------------------------------------
# test value constraints via fixed, default and constraint
#------------------------------------------------------------------------
$attrib = $pkg->new({
name => 'foo',
type => 'bar',
constraint => 'broken',
});
ok( ! $attrib );
match( $pkg->error(), 'constraint value must be an array ref' );
$attrib = $pkg->new({
name => 'foo',
type => 'bar',
constraint => [ broken => 99 ],
});
ok( ! $attrib );
match( $pkg->error(), "constraint type must be 'fixed' or 'default' (not 'broken')" );
$attrib = $pkg->new({
name => 'foo',
type => $type,
constraint => [ fixed => 99 ],
});
ok( $attrib );
match( $attrib->fixed(), 99 );
my ($t, $v) = $attrib->constraint();
match( $t, 'fixed' );
match( $v, 99 );
ok( ! $attrib->default() );
match( $attrib->error(), 'attribute does not define a default value' );
match( $attrib->fixed(), 99 );
match( $attrib->constraint('fixed'), 99 );
ok( $attrib->fixed(98) );
match( $attrib->fixed(), 98 );
match( $attrib->constraint('fixed'), 98 );
ok( $attrib->default(42) );
ok( ! $attrib->fixed() );
match( $attrib->error(), 'attribute does not define a fixed value' );
match( $attrib->default(), 42 );
match( $attrib->constraint('default'), 42 );
ok( $attrib->constraint( fixed => 101 ) );
match( $attrib->fixed(), 101 );
match( $attrib->constraint('fixed'), 101 );
ok( ! $attrib->default() );
match( $attrib->error(), 'attribute does not define a default value' );
$attrib = $pkg->new({
name => 'foo',
type => $type,
fixed => 201,
});
ok( $attrib );
match( $attrib->fixed(), 201 );
($t, $v) = $attrib->constraint();
match( $t, 'fixed' );
match( $v, 201 );
ok( ! $attrib->default() );
match( $attrib->error(), 'attribute does not define a default value' );
match( $attrib->fixed(), 201 );
match( $attrib->constraint('fixed'), 201 );
ok( $attrib->fixed(202) );
match( $attrib->fixed(), 202 );
match( $attrib->constraint('fixed'), 202 );
$attrib = $pkg->new({
name => 'foo',
type => $type,
default => 301,
});
ok( $attrib );
match( $attrib->default(), 301 );
($t, $v) = $attrib->constraint();
match( $t, 'default' );
match( $v, 301 );
ok( ! $attrib->fixed() );
match( $attrib->error(), 'attribute does not define a fixed value' );
match( $attrib->default(), 301 );
match( $attrib->constraint('default'), 301 );
ok( $attrib->default(302) );
match( $attrib->default(), 302 );
ok( $attrib->fixed(303) );
match( $attrib->fixed(), 303 );
#------------------------------------------------------------------------
# test case insensitivity of fixed/default options
#------------------------------------------------------------------------
use XML::Schema::Constants qw( :attribs );
ok( $attrib->constraint( FIXED => 401 ) );
match( $attrib->fixed, 401 );
ok( $attrib->constraint( Fixed => 402 ) );
match( $attrib->fixed, 402 );
ok( $attrib->constraint( FIXED, 402 ) );
match( $attrib->fixed, 402 );
ok( ! $attrib->constraint( fuxed => 402 ) );
match( $attrib->error, "constraint type must be 'fixed' or 'default' (not 'fuxed')" );
#------------------------------------------------------------------------
# test instance() method
#------------------------------------------------------------------------
$pkg = 'XML::Schema::Type::decimal';
$type = $pkg->new();
ok( $type, $pkg->error() );
$pkg = 'XML::Schema::Attribute';
$attrib = $pkg->new({
name => 'number',
type => $type,
});
$v = $attrib->instance('one two three');
ok( ! $v );
match( $attrib->error(), 'value is not a decimal' );
$v = $attrib->instance('123.45');
ok( $v );
#print STDERR "v: $v->{ value } (scale: $v->{ scale })\n";
$attrib = $pkg->new({
name => 'number',
type => $type,
});
$v = $attrib->instance('');
ok( ! $v );
match( $attrib->error(), 'value is empty' );
$attrib = $pkg->new({
name => 'number',
type => $type,
default => 3.14,
});
$v = $attrib->instance();
ok( $v, $attrib->error() );
match( $v, '3.14' );
$v = $attrib->instance(2.718);
ok( $v, $attrib->error() );
match( $v, '2.718' );
my $string = XML::Schema::Type::string->new();
ok( $string);
$attrib = $pkg->new({
name => 'number',
type => $type,
fixed => 3.14,
});
$v = $attrib->instance(3.14);
ok( $v, $attrib->error() );
$v = $attrib->instance(3.15);
ok( ! $v );
match( $attrib->error(), 'value does not match FIXED value of 3.14' );
#------------------------------------------------------------------------
$pkg = 'XML::Schema::Attribute';
$attrib = $pkg->new( name => 'foo', type => 'fooType' );
ok( $attrib, $pkg->error() );
match( $attrib->typename(), 'fooType' );
ok( ! $attrib->type() );
match( $attrib->error(), 'no such type: fooType' );
$pkg = 'XML::Schema::Type::Complex';
my $complex = $pkg->new( name => 'myComplexType', empty => 1 );
ok( $complex, $pkg->error() );
my $st1 = $complex->simpleType( name => 'mySimpleType1', base => 'string' );
ok( $st1, $complex->error() );
my $st2 = $complex->simpleType( name => 'mySimpleType2', base => 'string' );
ok( $st2, $complex->error() );
$pkg = 'XML::Schema::Attribute';
my $attr1 = $pkg->new( name => 'foo', type => 'mySimpleType1', scope => $complex );
ok( $attr1, $pkg->error() );
match( $attr1->typename(), 'mySimpleType1' );
match( $attr1->type(), $st1 );
$pkg = 'XML::Schema::Attribute';
my $attr2 = $pkg->new( name => 'foo', type => $st2, scope => $complex );
ok( $attr2, $pkg->error() );
match( $attr2->typename(), 'mySimpleType2' );
match( $attr2->type(), $st2 );