"Fossies" - the Fresh Open Source Software Archive

Member "Archive-Tar-2.38/t/05_iter.t" (12 May 2013, 1600 Bytes) of package /linux/privat/Archive-Tar-2.38.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 BEGIN { chdir 't' if -d 't' }
    2 
    3 use Test::More 'no_plan';
    4 use strict;
    5 use lib '../lib';
    6 
    7 my $Class   = 'Archive::Tar';
    8 my $FClass  = 'Archive::Tar::File';
    9 my $File    = 'src/long/bar.tar';
   10 my @Expect = (
   11     qr|^c$|,
   12     qr|^d$|,
   13     qr|^directory/$|,
   14     qr|^directory/really.*name/$|,
   15     qr|^directory/.*/myfile$|,
   16 );
   17 
   18 use_ok( $Class );
   19 
   20 ### crazy ref to special case 'all'
   21 for my $index ( \0, 0 .. $#Expect ) {
   22 
   23     my %opts    = ();
   24     my @expect  = ();
   25 
   26     my $dotest = sub {
   27 	my $desc = shift;
   28 	my $next = $Class->iter( $File, 0, \%opts );
   29 
   30 	my $pp_opts = join " => ", %opts;
   31 	ok( $next,                  "Iterator created from $File ($pp_opts $desc)" );
   32 	isa_ok( $next, "CODE",      "   Iterator $desc" );
   33 
   34 	my @names;
   35 	while( my $f = $next->() ) {
   36 	    ok( $f,                 "       File object retrieved $desc" );
   37 	    isa_ok( $f, $FClass,    "           Object $desc" );
   38 
   39 	    push @names, $f->name;
   40 	}
   41 
   42 	is( scalar(@names), scalar(@expect),
   43 				    "   Found correct number of files $desc" );
   44 
   45 	my $i = 0;
   46 	for my $name ( @names ) {
   47 	    ok( 1,                  "   Inspecting '$name'  $desc" );
   48 	    like($name, $expect[$i],"       Matches $Expect[$i] $desc" );
   49 	    $i++;
   50 	}
   51     };
   52 
   53     ### do a full test vs individual filters
   54     if( not ref $index ) {
   55         my $regex       = $Expect[$index];
   56         @expect         = ($regex);
   57 	%opts		= ( filter => $regex );
   58 	$dotest->("filter $regex");
   59 	%opts		= ( filter_cb => sub { my ($entry) = @_; $entry->name() =~ /$regex/ } );
   60 	$dotest->("filter_cb $regex");
   61     } else {
   62         @expect         = @Expect;
   63 	$dotest->("all");
   64     }
   65 }