annotate _test/Test/DOM/Schema.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 6d33f75c6e1f
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
1 package Test::DOM::Schema;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
2 use strict;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
3 use warnings;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
4
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
5 use base qw(IMPL::Test::Unit);
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
6 use IMPL::Test qw(test failed shared);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
7 use IMPL::Class::Property;
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
8
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
9 __PACKAGE__->PassThroughArgs;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
10
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
11 require IMPL::DOM::Schema;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
12
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
13 BEGIN {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
14 shared public property SampleSchema => prop_all;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
15 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
16
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
17 test GetMetaSchema => sub {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
18 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
19 };
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
20
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
21 test AutoverifyMetaSchema => sub {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
22 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
28
6d33f75c6e1f ORM in works
Sergey
parents: 24
diff changeset
23
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
24 if (my @errors = $metaSchema->Validate($metaSchema)) {
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
25 failed "Self verification failed", map $_ ? $_->Message : 'unknown', @errors;
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
26 }
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
27 };
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
28
24
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
29 test VerifyCorrectSchema => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
30 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
31 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
32
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
33 my $schema = new IMPL::DOM::Schema;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
34 $schema->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
35 IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
36 IMPL::DOM::Schema::NodeSet->new()->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
37 new IMPL::DOM::Schema::SimpleNode( name => 'firstName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
38 new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
39 new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
40 IMPL::DOM::Schema::NodeSet->new()->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
41 new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
42 new IMPL::DOM::Schema::SimpleNode( name => 'line', minOccur => 0 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
43 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
44 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
45 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
46 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
47 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
48
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
49 $this->SampleSchema($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
50
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
51 my @errors = $metaSchema->Validate($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
52 failed "Failed to validate a wellformed schema", map $_->Message, @errors if @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
53 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
54
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
55 test VerifyWrongSchema => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
56 my $metaSchema = IMPL::DOM::Schema->MetaSchema();
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
57
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
58 my $schema = new IMPL::DOM::Schema;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
59 $schema->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
60 IMPL::DOM::Schema::ComplexNode->new( name => 'personInfo' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
61 new IMPL::DOM::Schema::ComplexType( type => 'someType' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
62 new IMPL::DOM::Schema::SimpleNode( name => 'lastName' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
63 new IMPL::DOM::Schema::ComplexNode( name => 'address' )->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
64 new IMPL::DOM::Schema::SimpleNode( name => 'street' ),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
65 new IMPL::DOM::Schema::SimpleNode( name => 'line' )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
66 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
67 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
68 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
69
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
70 my @errors = $metaSchema->Validate($schema);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
71 failed "A not wellformed schema validated correctly" unless @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
72 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
73
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
74 test ValidateCorrectData => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
75 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
76
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
77 my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
78 IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
79 IMPL::DOM::Node->new(nodeName => 'lastName', nodeValue => 'Smith'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
80 IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
81 IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
82 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
83 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
84
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
85 if (my @errors = $this->SampleSchema->Validate($data)) {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
86 failed "Failed to validate a correct data", map $_->Message , @errors;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
87 }
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
88 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
89
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
90 test ValidateWrongData => sub {
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
91 my ($this) = @_;
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
92
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
93 my $data = IMPL::DOM::Node->new(nodeName => 'personInfo')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
94 IMPL::DOM::Node->new(nodeName => 'firstName', nodeValue => 'John'),
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
95 IMPL::DOM::Node->new(nodeName => 'address')->appendRange(
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
96 IMPL::DOM::Node->new(nodeName => 'street', nodeValue => 'main road')
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
97 )
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
98 );
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
99
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
100 failed "A wrong data validated corretly" unless $this->SampleSchema->Validate($data);
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
101 };
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
102
7f00786f8210 Первая рабочая реазизация схемы и навигаторов
Sergey
parents: 19
diff changeset
103
19
1ca530e5c9c5 DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
Sergey
parents:
diff changeset
104 1;