Return to regress.pl CVS log

Up to [cvsweb.bsd.lv] / pta / regress / import

Annotation of pta/regress/import/regress.pl, Revision 1.1

1.1     ! schwarze    1: #!/usr/bin/perl
        !             2: #
        !             3: # Copyright (c) 2020 Freda Bundchen <freda@mandoc.bsd.lv>
        !             4: # Copyright (c) 2020 Ingo Schwarze <schwarze@openbsd.org>
        !             5: #
        !             6: # Permission to use, copy, modify, and distribute this software for any
        !             7: # purpose with or without fee is hereby granted, provided that the above
        !             8: # copyright notice and this permission notice appear in all copies.
        !             9: #
        !            10: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES
        !            11: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
        !            12: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR
        !            13: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
        !            14: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
        !            15: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
        !            16: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
        !            17:
        !            18: use warnings;
        !            19: use strict;
        !            20:
        !            21: use Test::Simple tests => 7 * 2;
        !            22:
        !            23: my @tests = qw(
        !            24:     bbva_usa
        !            25:     capital_one_360
        !            26:     capital_one_credit
        !            27:     chase_credit
        !            28:     etrade_ira
        !            29:     optum_hsa
        !            30:     wellsfargo
        !            31: );
        !            32:
        !            33: sub arrays_match ($$) {
        !            34:        my ($lines_ref, $expected_ref) = @_;
        !            35:        if ($#$lines_ref != $#$expected_ref) {
        !            36:                warn "expected " . (scalar @$expected_ref) . " lines" .
        !            37:                    " but received " . (scalar @$lines_ref) . " lines";
        !            38:                return;
        !            39:        }
        !            40:        for (my $i = 0; $i <= $#$lines_ref; $i++) {
        !            41:                next if $lines_ref->[$i] eq $expected_ref->[$i];
        !            42:                warn "expected line " . ($i + 1) . ":\n" .
        !            43:                    "\t$expected_ref->[$i]" .
        !            44:                    "but received:\n\t$lines_ref->[$i]";
        !            45:                return;
        !            46:        }
        !            47:        return 1;
        !            48: }
        !            49:
        !            50: foreach my $test (@tests) {
        !            51:        open my $ph, '-|', '../../pta_import.pl', '-I', $test,
        !            52:            "../../csv/$test.csv" or die "forking pta_import failed";
        !            53:        my @lines = <$ph>;
        !            54:        ok close($ph), "$test: $! rv " . ($? >> 8) . " sig " . ($? & 127);
        !            55:        my $fn = "expected/$test.out";
        !            56:        open my $in, '<', $fn or die "$fn: $!";
        !            57:        my @expected = <$in>;
        !            58:        close $in;
        !            59:        ok arrays_match(\@lines, \@expected), "$test output";
        !            60: }
        !            61: exit 0;