Commit | Line | Data |
635c7876 |
1 | #!/usr/local/bin/perl -w |
2 | |
3 | use strict ; |
4 | |
5 | use Test::More ; |
6 | use Carp ; |
99709852 |
7 | use File::Slurp ; |
635c7876 |
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 | |
12444d55 |
44 | plan( tests => 17 * @text_data + 8 * @bin_data ) ; |
635c7876 |
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 | |
12444d55 |
55 | SKIP: { |
56 | skip "binmode not available in this version of Perl", 8 * @bin_data |
57 | if $] < 5.006 ; |
635c7876 |
58 | |
12444d55 |
59 | foreach my $data ( @bin_data ) { |
60 | |
61 | test_bin_slurp( $data ) ; |
62 | } |
635c7876 |
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 | |
12444d55 |
122 | my $array_ref = read_file( $file, array_ref => 1 ) ; |
635c7876 |
123 | ok( eq_array( $array_ref, \@data_lines ), |
124 | 'array ref read_file - ' . length $data_text ) ; |
125 | |
12444d55 |
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 | |
635c7876 |
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 | } |