public
Created

  • Download Gist
user.t
Perl
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
#!/usr/bin/env perl
use strict;
use warnings;
 
use Test::More;
 
use V6::User;
#use V6::User::Identity;
use V6::DB;
 
use Text::SimpleTable;
 
sub format_table {
my @objects = @_;
require Text::SimpleTable;
my $t = Text::SimpleTable->new( [ 60, 'Class' ], [ 8, 'Count' ] );
my %counts;
$counts{ref($_)}++ for @objects;
foreach my $class ( sort { $counts{$b} <=> $counts{$a} } keys %counts ) {
$t->row( $class, $counts{$class} );
}
return $t->draw;
}
 
my $db = V6::DB->db;
 
ok(my $scope = $db->new_scope, 'new scope');
ok(my $user = V6::User->new(identities => []), "new user");
ok($db->store($user), 'storing user');
 
#ok(my $identity = V6::User::Identity->new(identifier => 'http://test.develooper.com/', data => {}), "new identity");
#ok($user->identities([$identity]), "set identity on user");
#is($user, $identity->user, "identity has user");
 
my $l = $scope->live_objects;
my @live_objects = $l->live_objects;
my $msg = "Loaded " . scalar(@live_objects) . " objects:\n" . format_table(@live_objects);
warn "MSG: $msg";
 
undef $scope;
 
{
# anything still live at this point is a leak
if ( my @leaked_objects = $l->live_objects ) {
warn("leaked objects:\n" . format_table(@leaked_objects));
}
}
 
 
done_testing();

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.