t/large.t

   1 #!/usr/local/bin/perl -w
   2
   3 use strict ;
   4
   5 use Test::More ;
   6 use Carp ;
   7
   8 BEGIN{
   9         use_ok( 'File::Slurp', ) ;
  10 }
  11
  12 my $file = 'slurp.data' ;
  13 unlink $file ;
  14
  15 my @text_data = (
  16         [],
  17         [ 'a' x 8 ],
  18         [ ("\n") x 5 ],
  19         [ map( "aaaaaaaa\n", 1 .. 3 ) ],
  20         [ map( "aaaaaaaa\n", 1 .. 3 ), 'aaaaaaaa' ],
  21         [ map ( 'a' x 100 . "\n", 1 .. 1024 ) ],
  22         [ map ( 'a' x 100 . "\n", 1 .. 1024 ), 'a' x 100 ],
  23         [ map ( 'a' x 1024 . "\n", 1 .. 1024 ) ],
  24         [ map ( 'a' x 1024 . "\n", 1 .. 1024 ), 'a' x 10240 ],
  25         [],
  26 ) ;
  27
  28 my @bin_sizes = ( 1000, 1024 * 1024 ) ;
  29
  30 my @bin_stuff = ( "\012", "\015", "\012\015", "\015\012",
  31                 map chr, 0 .. 32 ) ;
  32
  33 my @bin_data ;
  34
  35 foreach my $size ( @bin_sizes ) {
  36
  37         my $data = '' ;
  38
  39         while ( length( $data ) < $size ) {
  40
  41                 $data .= $bin_stuff[ rand @bin_stuff ] ;
  42         }
  43
  44         push @bin_data, $data ;
  45 }
  46
  47 plan( tests => 16 * @text_data + 8 * @bin_data ) ;
  48
  49 #print "# text slurp\n" ;
  50
  51 foreach my $data ( @text_data ) {
  52
  53         test_text_slurp( $data ) ;
  54 }
  55
  56 #print "# BIN slurp\n" ;
  57
  58 foreach my $data ( @bin_data ) {
  59
  60         test_bin_slurp( $data ) ;
  61 }
  62
  63 unlink $file ;
  64
  65 exit ;
  66
  67 sub test_text_slurp {
  68
  69         my( $data_ref ) = @_ ;
  70
  71         my @data_lines = @{$data_ref} ;
  72         my $data_text = join( '', @data_lines ) ;
  73
  74
  75         my $err = write_file( $file, $data_text ) ;
  76         ok( $err, 'write_file - ' . length $data_text ) ;
  77         my $text = read_file( $file ) ;
  78         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  79
  80         $err = write_file( $file, \$data_text ) ;
  81         ok( $err, 'write_file ref arg - ' . length $data_text ) ;
  82         $text = read_file( $file ) ;
  83         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  84
  85         $err = write_file( $file, { buf_ref => \$data_text } ) ;
  86         ok( $err, 'write_file buf ref opt - ' . length $data_text ) ;
  87         $text = read_file( $file ) ;
  88         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  89
  90         my $text_ref = read_file( $file, scalar_ref => 1 ) ;
  91         ok( ${$text_ref} eq $data_text,
  92                 'scalar ref read_file - ' . length $data_text ) ;
  93
  94         read_file( $file, buf_ref => \my $buffer ) ;
  95         ok( $buffer eq $data_text,
  96                 'buf_ref read_file - ' . length $data_text ) ;
  97
  98 #       my @data_lines = split( m|(?<=$/)|, $data_text ) ;
  99
 100         $err = write_file( $file, \@data_lines ) ;
 101         ok( $err, 'write_file list ref arg - ' . length $data_text ) ;
 102         $text = read_file( $file ) ;
 103         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
 104
 105 #print map "[$_]\n", @data_lines ;
 106 #print "DATA <@data_lines>\n" ;
 107
 108         my @array = read_file( $file ) ;
 109
 110 #print map "{$_}\n", @array ;
 111 #print "ARRAY <@array>\n" ;
 112
 113         ok( eq_array( \@array, \@data_lines ),
 114                         'array read_file - ' . length $data_text ) ;
 115
 116         print "READ:\n", map( "[$_]\n", @array ),
 117                  "EXP:\n", map( "[$_]\n", @data_lines )
 118                         unless eq_array( \@array, \@data_lines ) ;
 119
 120         my $array_ref = read_file( $file, array_ref => 1 ) ;
 121         ok( eq_array( $array_ref, \@data_lines ),
 122                         'array ref read_file - ' . length $data_text ) ;
 123
 124         $err = write_file( $file, { append => 1 }, $data_text ) ;
 125         ok( $err, 'write_file append - ' . length $data_text ) ;
 126
 127         my $text2 = read_file( $file ) ;
 128         ok( $text2 eq $data_text x 2, 'read_file append - ' . length $data_text ) ;
 129
 130         $err = append_file( $file, $data_text ) ;
 131         ok( $err, 'append_file - ' . length $data_text ) ;
 132
 133         my $bin3 = read_file( $file ) ;
 134         ok( $bin3 eq $data_text x 3, 'read_file append_file - ' . length $data_text ) ;
 135
 136         return ;
 137 }
 138
 139 sub test_bin_slurp {
 140
 141         my( $data ) = @_ ;
 142
 143         my $err = write_file( $file, {'binmode' => ':raw'}, $data ) ;
 144         ok( $err, 'write_file bin - ' . length $data ) ;
 145
 146         my $bin = read_file( $file, 'binmode' => ':raw' ) ;
 147         ok( $bin eq $data, 'scalar read_file bin - ' . length $data ) ;
 148
 149         my $bin_ref = read_file( $file, scalar_ref => 1, 'binmode' => ':raw' ) ;
 150         ok( ${$bin_ref} eq $data,
 151                         'scalar ref read_file bin - ' . length $data ) ;
 152
 153         read_file( $file, buf_ref => \(my $buffer), 'binmode' => ':raw'  ) ;
 154         ok( $buffer eq $data, 'buf_ref read_file bin - ' . length $data ) ;
 155
 156         $err = write_file( $file, { append => 1, 'binmode' => ':raw' }, $data ) ;
 157         ok( $err, 'write_file append bin - ' . length $data ) ;
 158
 159         my $bin2 = read_file( $file, 'binmode' => ':raw' ) ;
 160         ok( $bin2 eq $data x 2, 'read_file append bin - ' . length $data ) ;
 161
 162         $err = append_file( $file, { 'binmode' => ':raw' }, $data ) ;
 163         ok( $err, 'append_file bin - ' . length $data ) ;
 164
 165         my $bin3 = read_file( $file, 'binmode' => ':raw' ) ;
 166         ok( $bin3 eq $data x 3, 'read_file bin - ' . length $data ) ;
 167
 168         return ;
 169 }