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