fu

• t/atom-post.t
• t/cleaner-link.t
• t/directorysearch.t
• t/jabber-presence.t
• t/paid-time.t
• t/protocol.t
• t/synsuck.t
• t/user-infoshow-migrate.t

--------------------------------------------------------------------------------
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/atom-post.t
--- a/t/atom-post.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/atom-post.t	Tue Mar 01 16:59:00 2011 +0800
@@ -64,41 +64,45 @@ sub check_entry {
 sub check_entry {
     my ( $atom_entry, $entry_info, $journal ) = @_;
 
-    ok( $atom_entry, "Got an atom entry back from the server" );
-    is( $atom_entry->title, $entry_info->{title}, "atom entry has right title" )
-        if defined $entry_info->{title};
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-    # having the content body be of type HTML
-    # causes newlines to appear for some reason when we try to extract the content as a string
-    # so let's just work around it; it should be harmless (as_xml doesn't contain the extra newlines)
-    my $event_raw = $entry_info->{content};
-    like( $atom_entry->content->body, qr/\s*$event_raw\s*/, "atom entry has right content" )
-        if defined $entry_info->{content};
+    subtest "check_entry $entry_info->{id} - $entry_info->{title}"  => sub {
+        ok( $atom_entry, "Got an atom entry back from the server" );
+        is( $atom_entry->title, $entry_info->{title}, "atom entry has right title" )
+            if defined $entry_info->{title};
 
-    is( $atom_entry->id, $entry_info->{atom_id}, "atom id" )
-        if defined $entry_info->{atom_id};
+        # having the content body be of type HTML
+        # causes newlines to appear for some reason when we try to extract the content as a string
+        # so let's just work around it; it should be harmless (as_xml doesn't contain the extra newlines)
+        my $event_raw = $entry_info->{content};
+        like( $atom_entry->content->body, qr/\s*$event_raw\s*/, "atom entry has right content" )
+            if defined $entry_info->{content};
 
-    is( $atom_entry->author->name, $entry_info->{author}, "atom entry author" )
-        if defined $entry_info->{author};
+        is( $atom_entry->id, $entry_info->{atom_id}, "atom id" )
+            if defined $entry_info->{atom_id};
 
-    if ( defined $entry_info->{url} ) {
-        my @links = $atom_entry->link;
-        is( scalar @links, 2, "got back two links" );
-        foreach my $link( @links ) {
-            if ( $link->rel eq "edit" ) {
-                is( $link->href, $journal->atom_base . "/entries/$entry_info->{id}", "edit link" );
-            } else { # alternate
-                is( $link->href, $entry_info->{url}, "entry link" );
+        is( $atom_entry->author->name, $entry_info->{author}, "atom entry author" )
+            if defined $entry_info->{author};
+
+        if ( defined $entry_info->{url} ) {
+            my @links = $atom_entry->link;
+            is( scalar @links, 2, "got back two links" );
+            foreach my $link( @links ) {
+                if ( $link->rel eq "edit" ) {
+                    is( $link->href, $journal->atom_base . "/entries/$entry_info->{id}", "edit link" );
+                } else { # alternate
+                    is( $link->href, $entry_info->{url}, "entry link" );
+                }
             }
         }
-    }
 
-    if ( defined $entry_info->{categories} ) {
-        my %tags = map { $_ => 1 } @{ $entry_info->{categories} || [] };
-        my %categories = map { $_->term => 1 } $atom_entry->category;
-        is( scalar keys %categories, 2, "got back multiple categories" );
-        is_deeply( { %categories }, { %tags }, "got back the categories we sent in" );
-    }
+        if ( defined $entry_info->{categories} ) {
+            my %tags = map { $_ => 1 } @{ $entry_info->{categories} || [] };
+            my %categories = map { $_->term => 1 } $atom_entry->category;
+            is( scalar keys %categories, 2, "got back multiple categories" );
+            is_deeply( { %categories }, { %tags }, "got back the categories we sent in" );
+        }
+    };
 }
 
 
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/cleaner-link.t
--- a/t/cleaner-link.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/cleaner-link.t	Tue Mar 01 16:59:00 2011 +0800
@@ -20,6 +20,8 @@ sub clean {
 }
 
 sub is_cleaned {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $input = shift;
     my $type = shift;
     my $output = clean($input);
@@ -27,6 +29,8 @@ sub is_cleaned {
 }
 
 sub not_cleaned {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $input = shift;
     my $type = shift;
     my $output = clean($input);
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/directorysearch.t
--- a/t/directorysearch.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/directorysearch.t	Tue Mar 01 16:59:00 2011 +0800
@@ -22,6 +22,8 @@ my @args;
 my @args;
 
 my $is = sub {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my ($name, $str, @good_cons) = @_;
     my %args = map { LJ::durl($_) } split(/[=&]/, $str);
     my @cons = sort { ref($a) cmp ref($b) } LJ::Directory::Constraint->constraints_from_formargs(\%args);
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/jabber-presence.t
--- a/t/jabber-presence.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/jabber-presence.t	Tue Mar 01 16:59:00 2011 +0800
@@ -70,70 +70,96 @@ delobj_all( $one );
 } );
 
 sub add {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
     my $args = shift;
     my $obj = LJ::Jabber::Presence->create( %$args );
 
-    $presence{$args->{resource}} = 1;
-
-    ok( $obj, "Object create" );
-    checkattrs( $obj, $args );
-    checkres( $args->{u}, scalar( keys %presence ) );
+    subtest "add $args->{resource} - $args->{client}" => sub {
+        $presence{$args->{resource}} = 1;
+    
+        ok( $obj, "Object create" );
+        checkattrs( $obj, $args );
+        checkres( $args->{u}, scalar( keys %presence ) );
+    };
 
     return $obj;
 }
 
 sub load {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $args = shift;
     my $obj = LJ::Jabber::Presence->new( $args->{u}, $args->{resource} );
 
-    ok( $obj, "Object load" );
-    checkattrs( $obj, $args );
-    checkres( $args->{u}, scalar( keys %presence ) );
+    subtest "load $args->{resource} - $args->{client}" => sub {
+        ok( $obj, "Object load" );
+        checkattrs( $obj, $args );
+        checkres( $args->{u}, scalar( keys %presence ) );
+    };
 
     return $obj;
 }
 
 sub del {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $args = shift;
-    LJ::Jabber::Presence->delete( $args->{u}->id, $args->{resource} );
 
-    delete $presence{$args->{resource}};
-
-    checkres( $args->{u}, scalar( keys %presence ) );
+    subtest "del $args->{resource} - $args->{client}" => sub {
+        LJ::Jabber::Presence->delete( $args->{u}->id, $args->{resource} );
+    
+        delete $presence{$args->{resource}};
+    
+        checkres( $args->{u}, scalar( keys %presence ) );
+    };
 }
 
 sub delobj {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $args = shift;
     my $obj = load( $args );
 
-    delete $presence{$args->{resource}};
-    $obj->delete;
-
-    checkres( $args->{u}, scalar( keys %presence ) );
+    subtest "delobj $args->{resource} - $args->{client}" => sub {
+        delete $presence{$args->{resource}};
+        $obj->delete;
+    
+        checkres( $args->{u}, scalar( keys %presence ) );
+    };
 }
 
 sub del_all {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $u = shift;
-    LJ::Jabber::Presence->delete_all( $u->id );
 
-    %presence = ();
-
-    checkres( $u, 0 );
+    subtest "delall" => sub {
+        LJ::Jabber::Presence->delete_all( $u->id );
+    
+        %presence = ();
+    
+        checkres( $u, 0 );
+    };
 }
 
 sub delobj_all {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $args = shift;
     my $obj = load( $args );
 
-    %presence = ();
-    $obj->delete_all;
-
-    checkres( $args->{u}, 0 );
+    subtest "delobj_all $args->{resource} - $args->{client}" => sub {
+        %presence = ();
+        $obj->delete_all;
+    
+        checkres( $args->{u}, 0 );
+    };
 }
 
 sub checkattrs {
     my $obj = shift;
     my $check = shift;
+
     is( $obj->u, $check->{u}, "User matches" );
     is( $obj->resource, $check->{resource}, "Resource matches" );
     is( $obj->cluster, $check->{cluster}, "cluster matches" );
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/paid-time.t
--- a/t/paid-time.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/paid-time.t	Tue Mar 01 16:59:00 2011 +0800
@@ -7,7 +7,7 @@ use DW::Pay;
 use DW::Pay;
 use LJ::Test qw (temp_user);
 
-plan tests => 29;
+plan tests => 8;
 
 my $u1 = temp_user();
 my $paidmos = 0;
@@ -26,15 +26,23 @@ sub rst {
 }
 
 sub assert {
-    my ( $u, $type ) = @_;
-    my ($typeid) = grep { $LJ::CAP{$_}->{_account_type} eq $type } keys %LJ::CAP;
-    ok( $typeid, 'valid class' );
+    my ( $u, $type, $testname ) = @_;
 
-    my $ps = DW::Pay::get_paid_status( $u );
-    my $secs = 86400 * $paidmos;
-    ok( $ps, 'got paid status' );
-    ok( $ps->{typeid} == $typeid, 'typeids match' );
-    ok( abs( $ps->{expiresin} - $secs) < 60, 'secs match within a minute' );
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    subtest $testname => sub {
+        plan tests => 4;
+
+        my ($typeid) = grep { $LJ::CAP{$_}->{_account_type} eq $type } keys %LJ::CAP;
+        ok( $typeid, 'valid class' );
+
+        my $ps = DW::Pay::get_paid_status( $u );
+        my $secs = 86400 * $paidmos;
+        ok( $ps, 'got paid status' );
+        ok( $ps->{typeid} == $typeid, 'typeids match' );
+        ok( abs( $ps->{expiresin} - $secs) < 60, 'secs match within a minute' );
+
+    }
 }
 
 ################################################################################
@@ -45,14 +53,14 @@ DW::Pay::add_paid_time( $u1, 'paid', 1 )
     or die DW::Pay::error_text();
 $paidmos += $mdays;  # 30
 
-assert( $u1, 'paid' );
+assert( $u1, 'paid', "free->paid 1 month" );
 
 # paid +1 month
 DW::Pay::add_paid_time( $u1, 'paid', 1 )
     or die DW::Pay::error_text();
 $paidmos += $mdays;  # 60
 
-assert( $u1, 'paid' );
+assert( $u1, 'paid', "paid +1 month" );
 
 # premium +1 month
 DW::Pay::add_paid_time( $u1, 'premium', 1 )
@@ -62,21 +70,21 @@ DW::Pay::add_paid_time( $u1, 'premium', 
 # should be 72 days... they bought 1 month of premium time (30 days)
 # and they had 60 days of paid.  60 days of paid converts to 42 days
 # of premium, 42+30 = 72 days premium.
-assert( $u1, 'premium' );
+assert( $u1, 'premium', "premium +1 month" );
 
 # premium +1 month
 DW::Pay::add_paid_time( $u1, 'premium', 1 )
     or die DW::Pay::error_text();
 $paidmos += $mdays;  # 102
 
-assert( $u1, 'premium' );
+assert( $u1, 'premium', "premium +1 month" );
 
 # paid +1 month == premium +21 days
 DW::Pay::add_paid_time( $u1, 'paid', 1 )
     or die DW::Pay::error_text();
 $paidmos += int( $mdays * 0.7 );  # 123
 
-assert( $u1, 'premium' );
+assert( $u1, 'premium', "paid +1 month == premium +21 days" );
 
 ################################################################################
 
@@ -85,10 +93,10 @@ DW::Pay::add_paid_time( $u1, 'seed', 99 
     or die DW::Pay::error_text();
 $paidmos = 0;  # never expires
 
-assert( $u1, 'seed' );
+assert( $u1, 'seed', "seed account" );
 
 ok( ! DW::Pay::add_paid_time( $u1, 'paid', 1 ), 'adding paid time fails' );
 
-assert( $u1, 'seed' );
+assert( $u1, 'seed', "seed account after trying to add paid time" );
 
 ################################################################################
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/protocol.t
--- a/t/protocol.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/protocol.t	Tue Mar 01 16:59:00 2011 +0800
@@ -49,6 +49,8 @@ my $do_request = sub {
 
 
 my $check_err = sub {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my ( $expectedcode, $testmsg ) = @_;
 
     # code is either in the form of ###, or ###:description
@@ -57,6 +59,8 @@ my $check_err = sub {
 };
 
 my $success = sub {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my ( $testmsg ) = @_;
 
     is( $err, 0, "$testmsg (success)" );
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/synsuck.t
--- a/t/synsuck.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/synsuck.t	Tue Mar 01 16:59:00 2011 +0800
@@ -1,6 +1,6 @@
 # -*-perl-*-
 use strict;
-use Test::More tests => 26;
+use Test::More tests => 24;
 
 use lib "$ENV{LJHOME}/cgi-bin";
 require 'ljlib.pl';
@@ -9,19 +9,33 @@ use LJ::SynSuck;
 
 
 sub err {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my ( $content, $type, $test ) = @_;
 
-    my ( $ok, $rv ) = LJ::SynSuck::parse_items_from_feed( $content );
-    ok( ! $ok, $test );
-    is( $rv->{type}, $type, $rv->{message} ? " $test - $rv->{message}" : $test );
+    subtest "$test (expect err)" => sub {
+        plan tests => 2;
+
+        my ( $ok, $rv ) = LJ::SynSuck::parse_items_from_feed( $content );
+        ok( ! $ok, "returned status is an error" );
+        is( $rv->{type}, $type, $rv->{message} ? "$rv->{message}" : "(no response message)" );
+    };
 }
 
 sub success {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my ( $content, $test, %opts ) = @_;
 
-    my ( $ok, $rv ) = LJ::SynSuck::parse_items_from_feed( $content, $opts{num_items} );
-    ok( $ok, $test );
-    die $rv->{message} unless $ok;
+    my ( $ok, $rv );
+
+    subtest "$test (expect ok)" => sub {
+        plan tests => 1;
+
+        ( $ok, $rv ) = LJ::SynSuck::parse_items_from_feed( $content, $opts{num_items} );
+        ok( $ok, "returned status is ok" );
+        die $rv->{message} unless $ok;
+    };
 
     return @{$rv->{items}};
 };
diff -r 5fe1dc7c915a -r f7b821ec9d41 t/user-infoshow-migrate.t
--- a/t/user-infoshow-migrate.t	Tue Mar 01 15:22:55 2011 +0800
+++ b/t/user-infoshow-migrate.t	Tue Mar 01 16:59:00 2011 +0800
@@ -6,24 +6,31 @@ require 'ljlib.pl';
 require 'ljlib.pl';
 
 
-plan tests => 228;
+plan tests => 156;
 
 use LJ::Test qw(temp_user memcache_stress);
 
 $LJ::DISABLED{infoshow_migrate} = 0;
 
 sub new_temp_user {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
     my $u = temp_user();
-    ok(LJ::isu($u), 'temp user created');
 
-    # force it to Y, since we're testing migration here
-    $u->update_self( { allow_infoshow => 'Y' } );
-    $u->clear_prop("opt_showlocation");
-    $u->clear_prop("opt_showbday");
+    subtest "created new temp user" => sub {
+        plan tests => 4;
 
-    is($u->{'allow_infoshow'}, 'Y', 'allow_infoshow set to Y');
-    ok(! defined $u->{'opt_showbday'}, 'opt_showbday not set');
-    ok(! defined $u->{'opt_showlocation'}, 'opt_showlocation not set');
+        ok(LJ::isu($u), 'temp user created');
+
+        # force it to Y, since we're testing migration here
+        $u->update_self( { allow_infoshow => 'Y' } );
+        $u->clear_prop("opt_showlocation");
+        $u->clear_prop("opt_showbday");
+
+        is($u->{'allow_infoshow'}, 'Y', 'allow_infoshow set to Y');
+        ok(! defined $u->{'opt_showbday'}, 'opt_showbday not set');
+        ok(! defined $u->{'opt_showlocation'}, 'opt_showlocation not set');
+    };
 
     return $u;
 }
--------------------------------------------------------------------------------