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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
# -*- cperl -*-
use strict;
use lib 't/springfield';
use Springfield;
use Data::Lazy;
use Scalar::Util qw(refaddr);
BEGIN {
eval "use Scalar::Util";
eval "use WeakRef" if $@;
if ($@) {
eval 'use Test::More skip_all => "No WeakRef / Scalar::Util"';
exit;
} else {
eval 'use Test::More tests => 4;';
}
}
my $VERBOSE;
if ( @ARGV and $ARGV[0] eq "-v" ) {
$VERBOSE = 1;
$SpringfieldObject::VERBOSE = 1;
}
# $Tangram::TRACE = \*STDOUT;
my $tests = 3;
{
my $storage = Springfield::connect_empty;
$storage->insert( NaturalPerson->new( firstName => 'Homer' ));
is(leaked, 0, "WeakRef works");
$storage->disconnect();
}
{
my $storage = Springfield::connect;
{
my ($homer) = $storage->select('Person');
is($SpringfieldObject::pop, 1,
"Objects not lost until they fall out of scope");
}
is(leaked, 0, "WeakRef still works");
$storage->disconnect();
}
sub sameid {
my $obj;
for (1..2) {
$obj = {};
diag("got ".sprintf("0x%.8x",refaddr($obj))
.", looking for ".sprintf("0x%.8x",$_[0]||0)) if $VERBOSE;
last if refaddr($obj) == ($_[0] ||= refaddr($obj));
$obj = undef;
}
$obj;
}
sub homer {
my ($homer) = $_[0]->select('Person');
return $homer;
}
SKIP:
{
my $storage = Springfield::connect;
my ($sameid,$refaddr, $test) = (undef, 0, undef);
{
homer($storage);
}
$storage->{schema}{make_object} = sub { my $x = $sameid;
bless $x, (shift);
$SpringfieldObject::pop++;
return $sameid;
};
diag("leaked is: ".leaked) if $VERBOSE;
# note - this loop is fragile, but worksforme on perl 5.8.4, Ubuntu
# hoary on amd64. Reports of other successes welcome.
LOOP:
for my $x ( 1..5 ) {
{
$refaddr = 0 unless $x > 2;
diag("undef(\$sameid = $sameid)") if $VERBOSE;
undef($sameid);
undef($test);
diag("done undef") if $VERBOSE;
$test = sameid($refaddr) or next;
tie $sameid, 'Data::Lazy' => sub { $test };
diag("test is: ".$test) if $VERBOSE;
diag("sameid is: ".$sameid) if $VERBOSE;
if ( $x <= 2 ) {
homer($storage);
} else {
diag("wohoo! I got ".sprintf("0x%.8x",refaddr($sameid)
)) if $VERBOSE;
diag ("calling last") if $VERBOSE;
last LOOP;
}
}
diag("leaked is: ".leaked) if $VERBOSE;
}
skip "failed to get an object with the same refid", 1
unless $sameid;
is($storage->id($sameid), undef, "hmm!");
$storage->disconnect();
}
|
