test/recipes/61-test_bio_prefix.t

   1 #! /usr/bin/env perl
   2 # Copyright 2017-2018 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the Apache License 2.0 (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 use strict;
  10 use warnings;
  11
  12 use OpenSSL::Test qw(:DEFAULT data_file);
  13 use File::Compare qw(compare_text);
  14
  15 setup('test_bio_prefix');
  16
  17 my %input_result = (
  18     'in1.txt'  => [ 'args1.pl', 'out1.txt' ],
  19     'in2.txt' => [ 'args2.pl', 'out2.txt' ],
  20 );
  21
  22 plan tests => 2 * scalar(keys %input_result);
  23
  24 foreach (sort keys %input_result) {
  25   SKIP: {
  26       my $input_path = data_file($_);
  27       my $args_path = data_file($input_result{$_}->[0]);
  28       my $expected_path = data_file($input_result{$_}->[1]);
  29       my $result_path = "test_bio_prefix-$_-stdout";
  30       my @args = do $args_path;
  31
  32       skip "Problem prefixing $_", 1
  33           unless ok(run(test([ 'bio_prefix_text', @args ],
  34                              stdin => $input_path, stdout => $result_path)),
  35                     "prefixing $_ with args " . join(' ', @args));
  36       is(compare_text($result_path, $expected_path, \&cmp_line), 0,
  37          "comparing the dump of $_ with $expected_path");
  38     }
  39 }
  40
  41 sub cmp_line {
  42     return 0 if scalar @_ == 0;
  43
  44     if (scalar @_ != 2) {
  45         diag "Lines to compare less than 2: ", scalar @_;
  46         return -1;
  47     }
  48
  49     $_[0] =~ s|\R$||;
  50     $_[1] =~ s|\R$||;
  51     my $r = $_[0] cmp $_[1];
  52
  53     diag "Lines differ:\n<: $_[0]\n>: $_[1]\n" unless $r == 0;
  54     return $r;
  55 }