Commit | Line | Data |
635c7876 |
1 | #!/usr/local/bin/perl -w |
2 | |
3 | use strict ; |
4 | |
5 | use Carp ; |
6 | use POSIX qw( :fcntl_h ) ; |
7 | use Test::More tests => 2 ; |
8 | |
9 | # in case SEEK_SET isn't defined in older perls. it seems to always be 0 |
10 | |
11 | BEGIN { |
12 | |
13 | *SEEK_SET = sub { 0 } unless eval { SEEK_SET() } ; |
14 | } |
15 | |
16 | BEGIN{ |
17 | use_ok( 'File::Slurp', ) ; |
18 | } |
19 | |
20 | SKIP: { |
21 | |
22 | eval { require B } ; |
23 | |
24 | skip <<TEXT, 1 if $@ ; |
25 | B.pm not found in this Perl. This will cause slurping of |
26 | the DATA handle to fail. |
27 | TEXT |
28 | |
29 | test_data_list_slurp() ; |
30 | } |
31 | |
32 | exit ; |
33 | |
34 | |
35 | sub test_data_list_slurp { |
36 | |
37 | my $data_seek = tell( \*DATA ); |
38 | |
39 | # first slurp in the lines |
40 | |
41 | my @slurp_lines = read_file( \*DATA ) ; |
42 | |
43 | # now seek back and read all the lines with the <> op and we make |
44 | # golden data sets |
45 | |
46 | seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; |
47 | my @data_lines = <DATA> ; |
48 | |
49 | # test the array slurp |
50 | |
51 | ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ; |
52 | } |
53 | |
54 | __DATA__ |
55 | line one |
56 | second line |
57 | more lines |
58 | still more |
59 | |
60 | enough lines |
61 | |
62 | we can't test long handle slurps from DATA since i would have to type |
63 | too much stuff |
64 | |
65 | so we will stop here |