File: 41-storable.t

package info (click to toggle)
libtangram-perl 2.10-1.1
  • links: PTS
  • area: main
  • in suites: lenny, squeeze, wheezy
  • size: 1,064 kB
  • ctags: 703
  • sloc: perl: 9,665; makefile: 35
file content (77 lines) | stat: -rw-r--r-- 1,514 bytes parent folder | download | duplicates (6)
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
#!/usr/bin/perl -w

use strict;

use Test::More tests => 4;

use_ok("Tangram::Dump");

use Data::Dumper;
use lib 't/springfield';
use Springfield;
use Set::Object qw(is_overloaded blessed);

SKIP:{
    #skip "Storable broken on Pg - see lib/Tangram/Pg.pod", 3
	#if $Springfield::vendor eq "Pg";
my $homer_id;

{

    my $storage = Springfield::connect_empty();

    my $homer = 
	NaturalPerson->new( firstName => 'Homer',
			    name => 'Simpson',
			  );

    my $marge = NaturalPerson->new( firstName => 'Marge',
				    name => 'Simpson' );

    $homer->{partner} = $marge;
    $marge->{partner} = $homer;

    $homer_id = $storage->insert($homer);

    delete $homer->{partner};
    delete $marge->{partner};
}

is(leaked, 0, "leaktest");

# now test putting it in the database...
{
    my $storage = Springfield::connect;

    my $homer = $storage->load($homer_id);

    $homer->{thought} = {
			 me => $homer,
			 marge => $homer->{partner},
			 beer => "good",
			 beer_from => "fridge",
			 beer_fetched_by => \\$homer->{partner},
			 # fails leaktest ... more investigation required
			 #family => Set::Object->new($homer,
						    #$homer->{partner})
		       };

    $storage->update($homer);
    delete $homer->{partner};
    delete $homer->{thought};
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;

    my $homer = $storage->load($homer_id);

    my $marge = $homer->{partner};

    is($homer->{thought}->{marge}, $marge,
       "Storable can store Tangram objects!");

}
}