1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
use strict;
use warnings;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
use Data::Dumper;
sub _chomp {
my $s = shift;
chomp $s;
return $s;
}
use TM::PSI;
#== TESTS =====================================================================
require_ok ('TM::PSI');
require_ok ('TM');
#&TM::_prime_infrastructure;
##warn Dumper $TM::infrastructure;
{
ok (keys %{ $TM::infrastructure->{mid2iid} }, 'toplets infrastructure created');
ok (keys %{ $TM::infrastructure->{assertions} }, 'asserts infrastructure created');
is (scalar keys %{ $TM::infrastructure->{mid2iid} },
scalar (keys %{$TM::PSI::core->{mid2iid}})
+ scalar (keys %{$TM::PSI::topicmaps_inc->{mid2iid}})
+ scalar (keys %{$TM::PSI::tmql_inc->{mid2iid}})
+ scalar (keys %{$TM::PSI::astma_inc->{mid2iid}})
,
'predefined concepts in map');
}
{
my $tm = new TM;
ok (eq_set ([ $tm->toplets (\ '+infrastructure') ],
[ values %{ $TM::infrastructure->{mid2iid} } ]),
'infrastructure toplets in map');
ok (eq_set ([ $tm->toplets (\ '+all -infrastructure') ],
[ ]),
'all - infrastructure toplets in map');
is (grep (!defined $_, $tm->tids (keys %{$TM::PSI::core->{mid2iid}})), 0, 'no undefined iid (core)');
ok (eq_array ([
$tm->tids (qw(thing is-subclass-of isa us))
],
[
'thing',
'is-subclass-of',
'isa',
'us',
]
), 'found predefined');
ok (eq_array ([
$tm->mids (\ 'http://psi.topicmaps.org/sam/1.0/#type-instance',
\ 'http://www.topicmaps.org/xtm/#psi-superclass-subclass')
],
[
'isa',
'is-subclass-of',
]
), 'found predefined 2');
is (scalar $tm->match (TM->FORALL, type => 'isa', iplayer => 'assertion-type'), 2, 'assertion-type: all instances');
}
{
my $tm = new TM;
ok ($tm->isa ('TM'), 'class');
is ($tm->baseuri, 'tm://nirvana/', 'baseuri default');
ok ($tm->{created}, 'created there');
}
{ # baseuri
my $tm = new TM (baseuri => 'xxx:yyy');
is ($tm->baseuri, 'xxx:yyy#', 'baseuri set');
$tm->baseuri ('xxx');
is ($tm->baseuri, 'xxx:yyy#', 'baseuri immutable');
}
{ # consistency accessors
my $tm = new TM;
ok (eq_set([ $tm->consistency ],
[ TM->Subject_based_Merging,
TM->Indicator_based_Merging ] ), 'default consistency');
$tm = new TM (consistency => [ TM->Subject_based_Merging ]);
ok (eq_set([ $tm->consistency ],
[ TM->Subject_based_Merging ] ), 'explicit consistency');
$tm->consistency (TM->Indicator_based_Merging);
ok (eq_set([ $tm->consistency ],
[ TM->Indicator_based_Merging ] ), 'changed consistency');
}
__END__
|
