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 => 16 * @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 foreach my $data ( @bin_data ) {
  56
  57         test_bin_slurp( $data ) ;
  58 }
  59
  60 unlink $file ;
  61
  62 exit ;
  63
  64 sub test_text_slurp {
  65
  66         my( $data_ref ) = @_ ;
  67
  68         my @data_lines = @{$data_ref} ;
  69         my $data_text = join( '', @data_lines ) ;
  70
  71
  72         my $err = write_file( $file, $data_text ) ;
  73         ok( $err, 'write_file - ' . length $data_text ) ;
  74         my $text = read_file( $file ) ;
  75         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  76
  77         $err = write_file( $file, \$data_text ) ;
  78         ok( $err, 'write_file ref arg - ' . length $data_text ) ;
  79         $text = read_file( $file ) ;
  80         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  81
  82         $err = write_file( $file, { buf_ref => \$data_text } ) ;
  83         ok( $err, 'write_file buf ref opt - ' . length $data_text ) ;
  84         $text = read_file( $file ) ;
  85         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
  86
  87         my $text_ref = read_file( $file, scalar_ref => 1 ) ;
  88         ok( ${$text_ref} eq $data_text,
  89                 'scalar ref read_file - ' . length $data_text ) ;
  90
  91         read_file( $file, buf_ref => \my $buffer ) ;
  92         ok( $buffer eq $data_text,
  93                 'buf_ref read_file - ' . length $data_text ) ;
  94
  95 #       my @data_lines = split( m|(?<=$/)|, $data_text ) ;
  96
  97         $err = write_file( $file, \@data_lines ) ;
  98         ok( $err, 'write_file list ref arg - ' . length $data_text ) ;
  99         $text = read_file( $file ) ;
 100         ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ;
 101
 102 #print map "[$_]\n", @data_lines ;
 103 #print "DATA <@data_lines>\n" ;
 104
 105         my @array = read_file( $file ) ;
 106
 107 #print map "{$_}\n", @array ;
 108 #print "ARRAY <@array>\n" ;
 109
 110         ok( eq_array( \@array, \@data_lines ),
 111                         'array read_file - ' . length $data_text ) ;
 112
 113         print "READ:\n", map( "[$_]\n", @array ),
 114                  "EXP:\n", map( "[$_]\n", @data_lines )
 115                         unless eq_array( \@array, \@data_lines ) ;
 116
 117         my $array_ref = read_file( $file, array_ref => 1 ) ;
 118         ok( eq_array( $array_ref, \@data_lines ),
 119                         'array ref read_file - ' . length $data_text ) ;
 120
 121         $err = write_file( $file, { append => 1 }, $data_text ) ;
 122         ok( $err, 'write_file append - ' . length $data_text ) ;
 123
 124         my $text2 = read_file( $file ) ;
 125         ok( $text2 eq $data_text x 2, 'read_file append - ' . length $data_text ) ;
 126
 127         $err = append_file( $file, $data_text ) ;
 128         ok( $err, 'append_file - ' . length $data_text ) ;
 129
 130         my $bin3 = read_file( $file ) ;
 131         ok( $bin3 eq $data_text x 3, 'read_file append_file - ' . length $data_text ) ;
 132
 133         return ;
 134 }
 135
 136 sub test_bin_slurp {
 137
 138         my( $data ) = @_ ;
 139
 140         my $err = write_file( $file, {'binmode' => ':raw'}, $data ) ;
 141         ok( $err, 'write_file bin - ' . length $data ) ;
 142
 143         my $bin = read_file( $file, 'binmode' => ':raw' ) ;
 144         ok( $bin eq $data, 'scalar read_file bin - ' . length $data ) ;
 145
 146         my $bin_ref = read_file( $file, scalar_ref => 1, 'binmode' => ':raw' ) ;
 147         ok( ${$bin_ref} eq $data,
 148                         'scalar ref read_file bin - ' . length $data ) ;
 149
 150         read_file( $file, buf_ref => \(my $buffer), 'binmode' => ':raw'  ) ;
 151         ok( $buffer eq $data, 'buf_ref read_file bin - ' . length $data ) ;
 152
 153         $err = write_file( $file, { append => 1, 'binmode' => ':raw' }, $data ) ;
 154         ok( $err, 'write_file append bin - ' . length $data ) ;
 155
 156         my $bin2 = read_file( $file, 'binmode' => ':raw' ) ;
 157         ok( $bin2 eq $data x 2, 'read_file append bin - ' . length $data ) ;
 158
 159         $err = append_file( $file, { 'binmode' => ':raw' }, $data ) ;
 160         ok( $err, 'append_file bin - ' . length $data ) ;
 161
 162         my $bin3 = read_file( $file, 'binmode' => ':raw' ) ;
 163         ok( $bin3 eq $data x 3, 'read_file bin - ' . length $data ) ;
 164
 165         return ;
 166 }