annotate Lib/IMPL/Test.pm @ 25:9dd67fa91ee3

small fix in the dom schema works under text schema
author Sergey
date Tue, 13 Oct 2009 17:51:25 +0400
parents 2e546a5175dd
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Test;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use warnings;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 require Exporter;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 our @ISA = qw(Exporter);
3
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
7 our @EXPORT_OK = qw(&test &shared &failed &cmparray);
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 require IMPL::Test::Unit;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10 use IMPL::Class::Member;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 sub test($$) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 my ($name,$code) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 my $class = caller;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 $class->set_meta(
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 new IMPL::Test::Unit::TestInfo( $name, $code )
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 sub shared($) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 my ($propInfo) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 my $class = caller;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 die new IMPL::Exception("Only properties could be declared as shared",$propInfo->Name) unless eval {$propInfo->isa('IMPL::Class::PropertyInfo')};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 die new IMPL::Exception("You can't mark the readonly property as shared",$propInfo->Name) unless $propInfo->canSet;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 die new IMPL::Exception("Only public properties could be declared as shared",$propInfo->Name) unless $propInfo->Access == IMPL::Class::Member::MOD_PUBLIC;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 $class->set_meta(new IMPL::Test::Unit::SharedData($propInfo->Name));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 }
3
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
32
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
33 sub failed($;@) {
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
34 die new IMPL::Test::FailException(@_);
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
35 }
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
36
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
37 sub cmparray {
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
38 my ($a,$b) = @_;
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
39
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
40 return 0 unless @$a == @$b;
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
41
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
42 for (my $i=0; $i < @$a; $i++ ) {
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
43 return 0 unless $a->[$i] eq $b->[$i];
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
44 }
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
45
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
46 return 1;
2e546a5175dd in developing
Sergey
parents: 0
diff changeset
47 }
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 1;