t/large.t

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