01sort.t #7

#!/usr/local/bin/perl -w

=head1 NAME

01sort.t - test sorting of VCP::Rev

=cut

use strict ;

use Carp ;
use Test ;
use VCP::Rev ;
use VCP::Dest ;
use VCP::Debug qw( enable_debug );

enable_debug( split /,/, $ENV{VCPDEBUG} ) if defined $ENV{VCPDEBUG} ;

my @field_names=
(qw( name change_id rev_id comment )) ;

## Notes:
##    - columns are in order of @field_names
##    - Each column is in reverse expected order here.
##    - For name: '-' < '/' < 'a' in ASCII.
my @rev_data = (
[qw( aa/b/c         5 1.20   d  )],
[qw( a-c            4 1.10   c  )],
[qw( a/b/c          3 1.2    b  )],
[qw( a/b/a          2 1.1.1  aa )],
[qw( a/b/a          2 1.1    aa )],
[qw( a              1 1.0    a  )],
[(   "",            0,"",    "" )],
#[], ## All fields undefined.
) ;

my @revs = map {
   my @a ;
   for my $i ( 0..$#field_names ) {
      push @a, $field_names[$i], $_->[$i] ;
   }
   VCP::Rev->new( @a ) ;
} @rev_data ;

my $d = VCP::Dest->new ;

sub _get_field {
    my $field_name = shift ;
    my $sub = VCP::Rev->can( $field_name ) ;
    die "Can't call VCP::Rev->$field_name()" unless defined $sub ;
    map defined $_ ? length $_ ? $_ : '""' : "<undef>", map $sub->( $_ ), @_ ;
}

my @tests = (
sub {
   ## This hides @revs
   my @revs = map
      VCP::Rev->new( name => $_, change_id => $_, time => $_ * 10 ),
      qw( 5 4 3 2 1 );

   ## This hides $d
   my $d = VCP::Dest->new;

   for ( my $i = 0; $i <= $#revs - 1; ++$i ) {
      $revs[$i]->previous( $revs[$i+1] );
   }

   my $r = VCP::Rev->new( name => "3a", change_id => 2, previous => $revs[-3] );
   push @revs, $r;
   $r =  VCP::Rev->new( name => "3b", change_id => 3, previous => $r );
   push @revs, $r;

   my $revs = VCP::Revs->new ;
   $revs->set( @revs ) ;
   $d->sort_revs( $revs ) ;

   my $exp_order = join ",", sort map $_->name, @revs ;
   my $got_order = join ",",      map $_->name, $revs->get;
   ok $got_order, $exp_order, "natural sort" ;
},

) ;

plan tests => scalar( @tests ) ;

$_->() for @tests ;