chiark - git - mdw - dpkg/blob - scripts/t/Dpkg_Compression.t

   1 #!/usr/bin/perl
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 use strict;
  17 use warnings;
  18
  19 use Test::More tests => 13;
  20
  21 use_ok('Dpkg::Compression');
  22 use_ok('Dpkg::Compression::FileHandle');
  23
  24 my $tmpdir = 't.tmp/Dpkg_Compression';
  25 mkdir $tmpdir;
  26 my @lines = ("One\n", "Two\n", "Three\n");
  27 my $fh;
  28
  29 sub test_write {
  30     my ($filename, $check_result) = @_;
  31
  32     $fh = Dpkg::Compression::FileHandle->new();
  33     open $fh, '>', $filename or die 'open failed';
  34     print { $fh } $lines[0];
  35     syswrite($fh, $lines[1]);
  36     printf { $fh } '%s', $lines[2];
  37     close $fh or die 'close failed';
  38
  39     &$check_result($filename, 'std functions');
  40
  41     unlink $filename or die "cannot unlink $filename";
  42
  43     $fh = Dpkg::Compression::FileHandle->new();
  44     $fh->open($filename, 'w');
  45     $fh->print($lines[0]);
  46     $fh->write($lines[1], length($lines[1]));
  47     $fh->printf('%s', $lines[2]);
  48     $fh->close() or die 'close failed';
  49
  50     &$check_result($filename, 'IO::Handle methods');
  51 }
  52
  53 sub check_uncompressed {
  54     my ($filename, $method) = @_;
  55     open(my $read_fh, '<', $filename) or die "cannot read $filename";
  56     my @read = <$read_fh>;
  57     close $read_fh or die 'cannot close';
  58     is_deeply(\@lines, \@read, "$filename correctly written ($method)");
  59 }
  60
  61 sub check_compressed {
  62     my ($filename, $method) = @_;
  63     open my $read_fh, '-|', 'zcat', "$tmpdir/myfile.gz"
  64         or die 'cannot fork zcat';
  65     my @read = <$read_fh>;
  66     close $read_fh or die 'cannot close';
  67     is_deeply(\@lines, \@read, "$filename correctly written ($method)");
  68 }
  69
  70 sub test_read {
  71     my $filename = shift;
  72
  73     $fh = Dpkg::Compression::FileHandle->new();
  74     open($fh, '<', $filename) or die 'open failed';
  75     my @read = <$fh>;
  76     close $fh or die 'close failed';
  77
  78     is_deeply(\@lines, \@read, "$filename correctly read (std functions)");
  79
  80     @read = ();
  81     $fh = Dpkg::Compression::FileHandle->new();
  82     $fh->open($filename, 'r') or die 'open failed';
  83     @read = $fh->getlines();
  84     $fh->close() or die 'close failed';
  85
  86     is_deeply(\@lines, \@read, "$filename correctly read (IO::Handle methods)");
  87 }
  88
  89 # Test changing the default compression levels
  90 my $old_level = compression_get_default_level();
  91 compression_set_default_level(1);
  92 is(compression_get_default_level(), 1, 'change default compression level');
  93 compression_set_default_level(5);
  94 is(compression_get_default_level(), 5, 'change default compression level');
  95 compression_set_default_level(undef);
  96 is(compression_get_default_level(), $old_level, 'reset default compression level');
  97
  98 # Test write on uncompressed file
  99 test_write("$tmpdir/myfile", \&check_uncompressed);
 100
 101 # Test write on compressed file
 102 test_write("$tmpdir/myfile.gz", \&check_compressed);
 103
 104 # Test read on uncompressed file
 105 test_read("$tmpdir/myfile");
 106
 107 # Test read on compressed file
 108 test_read("$tmpdir/myfile.gz");