Commit | Line | Data |
---|---|---|
25f0751f PM |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { | |
3 | chdir 't' if -d 't'; | |
4 | @INC = ("../lib", "lib/compress"); | |
5 | } | |
6 | } | |
7 | ||
8 | use lib qw(t t/compress); | |
9 | use strict; | |
10 | use warnings; | |
11 | use bytes; | |
12 | ||
ad4795e7 | 13 | use File::Spec ; |
25f0751f | 14 | use Test::More ; |
25139ca2 | 15 | use CompTestUtils; |
25f0751f PM |
16 | |
17 | my $GZIP ; | |
18 | ||
25f0751f | 19 | |
25139ca2 PM |
20 | sub ExternalGzipWorks |
21 | { | |
22 | my $lex = new LexFile my $outfile; | |
23 | my $content = qq { | |
24 | Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id | |
25 | dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia | |
26 | est. Quintus cenum parat. | |
27 | }; | |
25f0751f | 28 | |
25139ca2 PM |
29 | writeWithGzip($outfile, $content) |
30 | or return 0; | |
25f0751f | 31 | |
25139ca2 PM |
32 | my $got ; |
33 | readWithGzip($outfile, $got) | |
34 | or return 0; | |
25f0751f | 35 | |
25139ca2 PM |
36 | if ($content ne $got) |
37 | { | |
38 | diag "Uncompressed content is wrong"; | |
39 | return 0 ; | |
40 | } | |
25f0751f | 41 | |
25139ca2 | 42 | return 1 ; |
25f0751f PM |
43 | } |
44 | ||
25f0751f PM |
45 | sub readWithGzip |
46 | { | |
47 | my $file = shift ; | |
48 | ||
cb7abd7f PM |
49 | my $lex = new LexFile my $outfile; |
50 | ||
149b3664 | 51 | my $comp = "$GZIP -d -c" ; |
25f0751f | 52 | |
25139ca2 PM |
53 | if ( system("$comp $file >$outfile") == 0 ) |
54 | { | |
55 | $_[0] = readFile($outfile); | |
56 | return 1 | |
57 | } | |
25f0751f | 58 | |
9f58603c | 59 | diag "'$comp' failed: \$?=$? \$!=$!"; |
25139ca2 | 60 | return 0 ; |
25f0751f PM |
61 | } |
62 | ||
63 | sub getGzipInfo | |
64 | { | |
65 | my $file = shift ; | |
66 | } | |
67 | ||
68 | sub writeWithGzip | |
69 | { | |
70 | my $file = shift ; | |
71 | my $content = shift ; | |
72 | my $options = shift || ''; | |
73 | ||
cb7abd7f PM |
74 | my $lex = new LexFile my $infile; |
75 | writeFile($infile, $content); | |
76 | ||
25f0751f | 77 | unlink $file ; |
25139ca2 | 78 | my $comp = "$GZIP -c $options $infile >$file" ; |
25f0751f | 79 | |
25139ca2 PM |
80 | return 1 |
81 | if system($comp) == 0 ; | |
82 | ||
9f58603c | 83 | diag "'$comp' failed: \$?=$? \$!=$!"; |
25139ca2 PM |
84 | return 0 ; |
85 | } | |
86 | ||
87 | BEGIN { | |
88 | ||
89 | # Check external gzip is available | |
4e7676c7 SP |
90 | my $name = $^O =~ /mswin/i ? 'gzip.exe' : 'gzip'; |
91 | my $split = $^O =~ /mswin/i ? ";" : ":"; | |
92 | ||
93 | for my $dir (reverse split $split, $ENV{PATH}) | |
25139ca2 | 94 | { |
ad4795e7 CBW |
95 | $GZIP = File::Spec->catfile($dir,$name) |
96 | if -x File::Spec->catfile($dir,$name) | |
25139ca2 PM |
97 | } |
98 | ||
ad4795e7 | 99 | # Handle spaces in path to gzip |
aad9a0d9 | 100 | $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; |
ad4795e7 | 101 | |
25139ca2 PM |
102 | plan(skip_all => "Cannot find $name") |
103 | if ! $GZIP ; | |
104 | ||
105 | plan(skip_all => "$name doesn't work as expected") | |
106 | if ! ExternalGzipWorks(); | |
107 | ||
108 | ||
109 | # use Test::NoWarnings, if available | |
110 | my $extra = 0 ; | |
111 | $extra = 1 | |
112 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; | |
113 | ||
114 | plan tests => 7 + $extra ; | |
115 | ||
116 | use_ok('IO::Compress::Gzip', ':all') ; | |
117 | use_ok('IO::Uncompress::Gunzip', ':all') ; | |
25f0751f | 118 | |
25f0751f PM |
119 | } |
120 | ||
121 | ||
122 | { | |
123 | title "Test interop with $GZIP" ; | |
124 | ||
125 | my $file; | |
126 | my $file1; | |
127 | my $lex = new LexFile $file, $file1; | |
44033ed4 SP |
128 | my $content = qq { |
129 | Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id | |
130 | dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia | |
131 | est. Quintus cenum parat. | |
132 | }; | |
25f0751f PM |
133 | my $got; |
134 | ||
25139ca2 | 135 | ok writeWithGzip($file, $content), "writeWithGzip ok"; |
25f0751f PM |
136 | |
137 | gunzip $file => \$got ; | |
cb7abd7f | 138 | is $got, $content, "got content"; |
25f0751f PM |
139 | |
140 | ||
141 | gzip \$content => $file1; | |
142 | $got = ''; | |
25139ca2 | 143 | ok readWithGzip($file1, $got), "readWithGzip ok"; |
25f0751f PM |
144 | is $got, $content, "got content"; |
145 | } | |
146 | ||
147 |