← Back to branch summary

~ubuntu-branches/ubuntu/precise/libtangram-perl/precise

« back to all changes in this revision

Viewing changes to t/array.t

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2001-09-21 10:20:34 UTC
  • Revision ID: james.westby@ubuntu.com-20010921102034-tohkprbnz4n1aua0
Tags: upstream-2.04
Import upstream version 2.04

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/array.t
 
1
# (c) Sound Object Logic 2000-2001
 
2
 
 
3
use strict;
 
4
use t::Springfield;
 
5
 
 
6
use vars qw( $intrusive );
 
7
 
 
8
my $children = $intrusive ? 'ia_children' : 'children';
 
9
 
 
10
my %id;
 
11
my @kids = qw( Bart Lisa Maggie );
 
12
 
 
13
# $Tangram::TRACE = \*STDOUT;   
 
14
 
 
15
sub NaturalPerson::children
 
16
{
 
17
        my ($self) = @_;
 
18
        join(' ', map { $_->{firstName} || '' } @{ $self->{$children} } )
 
19
}
 
20
 
 
21
sub marge_test
 
22
{
 
23
        my $storage = shift;
 
24
        Springfield::test( $intrusive
 
25
                                           || $storage->load( $id{Marge} )->children eq 'Bart Lisa Maggie' );
 
26
}
 
27
 
 
28
Springfield::begin_tests(45);
 
29
 
 
30
sub stdpop
 
31
{
 
32
        my $storage = Springfield::connect_empty;
 
33
 
 
34
        my @children = map { NaturalPerson->new( firstName => $_ ) } @kids;
 
35
        @id{ @kids } = $storage->insert( @children );
 
36
 
 
37
        my $homer = NaturalPerson->new( firstName => 'Homer', $children => [ @children ] );
 
38
        $id{Homer} = $storage->insert($homer);
 
39
 
 
40
        my $marge = NaturalPerson->new( firstName => 'Marge' );
 
41
        $marge->{$children} = [ @children ] unless $intrusive;
 
42
        $id{Marge} = $storage->insert($marge);
 
43
 
 
44
        $storage->disconnect;
 
45
}
 
46
 
 
47
#############################################################################
 
48
 
 
49
stdpop();
 
50
 
 
51
Springfield::leaktest;
 
52
 
 
53
{
 
54
        my $storage = Springfield::connect;
 
55
        my $homer = $storage->load( $id{Homer} );
 
56
 
 
57
        Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
58
        marge_test( $storage );
 
59
 
 
60
        @{ $homer->{$children} }[0, 2] = @{ $homer->{$children} }[2, 0];
 
61
        $storage->update( $homer );
 
62
 
 
63
        $storage->disconnect;
 
64
}
 
65
 
 
66
Springfield::leaktest;
 
67
 
 
68
{
 
69
        my $storage = Springfield::connect;
 
70
        my $homer = $storage->load( $id{Homer} );
 
71
 
 
72
        Springfield::test( $homer->children eq 'Maggie Lisa Bart' );
 
73
        marge_test( $storage );
 
74
 
 
75
        pop @{ $homer->{$children} };
 
76
        $storage->update( $homer );
 
77
 
 
78
        $storage->disconnect;
 
79
}
 
80
 
 
81
###############################################
 
82
# insert
 
83
 
 
84
{
 
85
        my $storage = Springfield::connect;
 
86
 
 
87
        my $homer = $storage->load($id{Homer}) or die;
 
88
 
 
89
        Springfield::test( $homer->children eq 'Maggie Lisa' );
 
90
 
 
91
        shift @{ $homer->{$children} };
 
92
        $storage->update($homer);
 
93
 
 
94
        $storage->disconnect;
 
95
}
 
96
 
 
97
Springfield::leaktest;
 
98
 
 
99
{
 
100
        my $storage = Springfield::connect;
 
101
        my $homer = $storage->load($id{Homer}) or die;
 
102
        Springfield::test( $homer->children eq 'Lisa' );
 
103
        $storage->disconnect;
 
104
}
 
105
 
 
106
Springfield::leaktest;
 
107
 
 
108
{
 
109
        my $storage = Springfield::connect;
 
110
        my $homer = $storage->load($id{Homer}) or die;
 
111
        shift @{ $homer->{$children} };
 
112
        $storage->update($homer);
 
113
        $storage->disconnect;
 
114
}
 
115
 
 
116
Springfield::leaktest;
 
117
 
 
118
{
 
119
        my $storage = Springfield::connect;
 
120
        my $homer = $storage->load($id{Homer}) or die;
 
121
 
 
122
        Springfield::test( $homer->children eq '' );
 
123
 
 
124
        push @{ $homer->{$children} }, $storage->load( $id{Bart} );
 
125
        $storage->update($homer);
 
126
 
 
127
        $storage->disconnect;
 
128
}
 
129
 
 
130
Springfield::leaktest;
 
131
 
 
132
{
 
133
        my $storage = Springfield::connect;
 
134
        my $homer = $storage->load($id{Homer}) or die;
 
135
 
 
136
        Springfield::test( $homer->children eq 'Bart' );
 
137
 
 
138
        push @{ $homer->{$children} }, $storage->load( @id{qw( Lisa Maggie )} );
 
139
        $storage->update($homer);
 
140
 
 
141
        $storage->disconnect;
 
142
}
 
143
 
 
144
Springfield::leaktest;
 
145
 
 
146
{
 
147
        my $storage = Springfield::connect;
 
148
        my $homer = $storage->load( $id{Homer} );
 
149
 
 
150
        Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
151
        marge_test( $storage );
 
152
 
 
153
        $storage->disconnect;
 
154
}
 
155
 
 
156
Springfield::leaktest;
 
157
 
 
158
{
 
159
        my $storage = Springfield::connect;
 
160
        my $homer = $storage->load( $id{Homer} );
 
161
 
 
162
        Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
163
        marge_test( $storage );
 
164
 
 
165
        $storage->unload();
 
166
        undef $homer;
 
167
 
 
168
        Springfield::leaktest;
 
169
 
 
170
        $storage->disconnect;
 
171
}
 
172
 
 
173
{
 
174
        my $storage = Springfield::connect;
 
175
        my $bart = $storage->load( $id{Bart} );
 
176
 
 
177
        Springfield::test( !$intrusive || $bart->{ia_parent}{firstName} eq 'Homer' );
 
178
        marge_test( $storage );
 
179
 
 
180
        $storage->disconnect;
 
181
}
 
182
 
 
183
Springfield::leaktest;
 
184
 
 
185
##########
 
186
# prefetch
 
187
 
 
188
{
 
189
        my $storage = Springfield::connect;
 
190
 
 
191
        my @prefetch = $storage->prefetch( 'NaturalPerson', $children );
 
192
 
 
193
        my $homer = $storage->load( $id{Homer} );
 
194
 
 
195
        Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
196
        marge_test( $storage );
 
197
 
 
198
        $storage->disconnect();
 
199
}      
 
200
 
 
201
Springfield::leaktest;
 
202
 
 
203
{
 
204
        my $storage = Springfield::connect;
 
205
 
 
206
        my $person = $storage->remote('NaturalPerson');
 
207
 
 
208
        my @prefetch = $storage->prefetch( 'NaturalPerson', $children );
 
209
 
 
210
        my $homer = $storage->load( $id{Homer} );
 
211
 
 
212
        Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
213
        marge_test( $storage );
 
214
 
 
215
        $storage->disconnect();
 
216
}      
 
217
 
 
218
Springfield::leaktest;
 
219
 
 
220
#########
 
221
# queries
 
222
 
 
223
my $parents = $intrusive ? 'Homer' : 'Homer Marge';
 
224
 
 
225
{
 
226
        my $storage = Springfield::connect;
 
227
        my ($parent, $child) = $storage->remote(qw( NaturalPerson NaturalPerson ));
 
228
 
 
229
        my @results = $storage->select( $parent, $parent->{$children}->includes( $child )
 
230
                                                                        & $child->{firstName} eq 'Bart' );
 
231
 
 
232
        Springfield::test( join( ' ', sort map { $_->{firstName} } @results ) eq $parents );
 
233
        $storage->disconnect();
 
234
}      
 
235
 
 
236
Springfield::leaktest;
 
237
 
 
238
{
 
239
        my $storage = Springfield::connect;
 
240
        my $parent = $storage->remote( 'NaturalPerson' );
 
241
        my $bart = $storage->load( $id{Bart} );
 
242
 
 
243
        my @results = $storage->select( $parent, $parent->{$children}->includes( $bart ) );
 
244
 
 
245
        Springfield::test( join( ' ', sort map { $_->{firstName} } @results ) eq $parents );
 
246
        $storage->disconnect();
 
247
}      
 
248
 
 
249
Springfield::leaktest;
 
250
 
 
251
{
 
252
        my $storage = Springfield::connect_empty;
 
253
 
 
254
        my @children = map { NaturalPerson->new( firstName => $_ ) } @kids;
 
255
 
 
256
        my $homer = NaturalPerson->new( firstName => 'Homer',
 
257
                                                                        children => [ map { NaturalPerson->new( firstName => $_ ) } @kids ] );
 
258
 
 
259
        my $abe = NaturalPerson->new( firstName => 'Abe',
 
260
                                                                  $children => [ $homer ] );
 
261
 
 
262
        $id{Abe} = $storage->insert($abe);
 
263
 
 
264
        $storage->disconnect();
 
265
}      
 
266
 
 
267
Springfield::leaktest;
 
268
 
 
269
{
 
270
        my $storage = Springfield::connect;
 
271
 
 
272
        $storage->erase( $storage->load( $id{Abe} ) );
 
273
 
 
274
        my @pop = $storage->select('NaturalPerson');
 
275
        Springfield::test( @pop == 0 );
 
276
 
 
277
        $storage->disconnect();
 
278
}      
 
279
 
 
280
Springfield::leaktest;
 
281
 
 
282
#############################################################################
 
283
# Tx
 
284
 
 
285
Springfield::tx_tests(8, sub {
 
286
 
 
287
                                                  stdpop();
 
288
 
 
289
                                                  # check rollback of DB tx
 
290
 
 
291
                                                  Springfield::leaktest;
 
292
                                                  {
 
293
                                                          my $storage = Springfield::connect;
 
294
                                                          my $homer = $storage->load( $id{Homer} );
 
295
 
 
296
                                                          $storage->tx_start();
 
297
 
 
298
                                                          shift @{ $homer->{$children} };
 
299
                                                          $storage->update( $homer );
 
300
 
 
301
                                                          $storage->tx_rollback();
 
302
 
 
303
                                                          $storage->disconnect;
 
304
                                                  }
 
305
 
 
306
                                                  Springfield::leaktest;
 
307
 
 
308
                                                  # storage should still contain 3 children
 
309
 
 
310
                                                  {
 
311
                                                          my $storage = Springfield::connect;
 
312
                                                          my $homer = $storage->load( $id{Homer} );
 
313
 
 
314
                                                          Springfield::test( $homer->children eq 'Bart Lisa Maggie' );
 
315
                                                          marge_test( $storage );
 
316
 
 
317
                                                          $storage->disconnect;
 
318
                                                  }
 
319
 
 
320
                                                  Springfield::leaktest;
 
321
 
 
322
                                                  # check that DB and collection state remain in synch in case of rollback
 
323
 
 
324
                                                  {
 
325
                                                          my $storage = Springfield::connect;
 
326
                                                          my $homer = $storage->load( $id{Homer} );
 
327
 
 
328
                                                          $storage->tx_start();
 
329
 
 
330
                                                          shift @{ $homer->{$children} };
 
331
                                                          $storage->update( $homer );
 
332
 
 
333
                                                          $storage->tx_rollback();
 
334
 
 
335
                                                          $storage->update( $homer );
 
336
 
 
337
                                                          $storage->disconnect;
 
338
                                                  }
 
339
 
 
340
                                                  # Bart should no longer be Homer's child
 
341
 
 
342
                                                  {
 
343
                                                          my $storage = Springfield::connect;
 
344
                                                          my $homer = $storage->load( $id{Homer} );
 
345
 
 
346
                                                          Springfield::test( $homer->children eq 'Lisa Maggie' );
 
347
                                                          marge_test( $storage );
 
348
 
 
349
                                                          $storage->disconnect;
 
350
                                                  }
 
351
 
 
352
                                                  Springfield::leaktest;
 
353
 
 
354
                                          } );          # tx_tests
 
355
 
 
356
1;