The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- cperl -*-

use ExtUtils::testlib;
use Test::More ;
use Test::Differences;
use Config::Model::Dpkg::Dependency ;
use Log::Log4perl qw(:easy) ;
use 5.10.0;

use warnings;

use strict;

my $arg = shift || '';
my ($log,$show,$one) = (0) x 3 ;

use Log::Log4perl qw(:easy) ;
my $home = $ENV{HOME} || "";
my $log4perl_user_conf_file = "$home/.log4config-model";

if ($log and -e $log4perl_user_conf_file ) {
    Log::Log4perl::init($log4perl_user_conf_file);
}
else {
    Log::Log4perl->easy_init($ERROR);
}

{
    no warnings qw/once/;
    $::RD_HINT  = 1 if $arg =~ /rdt?h/;
    $::RD_TRACE = 1 if $arg =~ /rdh?t/;
}

my $parser = Config::Model::Dpkg::Dependency::dep_parser ;

exit main( @ARGV );

sub main {
    my ($do, $pattern)  = @_;

    test_good($pattern) if not $do or $do eq 'g';
    test_errors($pattern) if not $do or $do eq 'e';

    done_testing;
    return 0;
}


sub test_good {
    # dep, data struct
    my $pat = shift;
    my @tests = (
        [ 'foo' ,  ['foo']  ],
        [ 'foo | bar ' , ['foo' ], ['bar'] ],
        [ 'foo | bar | baz ' , ['foo' ], ['bar'], ['baz'] ],

        [ 'foo ( >= 1.24 )| bar ' , ['foo','>=','1.24' ], ['bar'] ],
        [ 'foo ( >= 1.24 )| bar ( << 1.3a3)' , ['foo','>=','1.24' ], [qw/bar << 1.3a3/] ],
        [ 'foo(>=1.24)|bar(<<1.3a3)  ' , ['foo','>=','1.24' ], [qw/bar << 1.3a3/] ],

        [ 'foo ( >= 1.24 )| bar [ linux-any]' , ['foo','>=','1.24' ], ['bar', undef, undef, 'linux-any'] ],
        [ 'xserver-xorg-input-evdev [alpha amd64 hurd-arm linux-armeb]' ,
            [ 'xserver-xorg-input-evdev', undef, undef, qw[alpha amd64 hurd-arm linux-armeb] ],
         ],
        [ 'xserver-xorg-input-evdev [!alpha !amd64 !arm !armeb]' , [ 'xserver-xorg-input-evdev', undef, undef,
                                                                   qw[!alpha !amd64 !arm !armeb]
                                                                ],
         ],
        [ 'hal (>= 0.5.12~git20090406) [kfreebsd-any]', [ 'hal', '>=','0.5.12~git20090406', 'kfreebsd-any']],

        [ ('${foo}') x 2 ],
        [ ('${foo}.1-2~') x 2 ],
    ) ;

    foreach my $td ( @tests ) {
        my ($dep,@exp) = @$td ;
        next if $pat and $dep !~ /$pat/;
        unshift @exp, 1; # match what's returned when there's no errors
        my $ret = $parser->dependency($dep) ;
        eq_or_diff ($ret, \@exp,"parsed $dep");
    }
}

sub test_errors {
    my $pat = shift;
    my @tests = (
        [ 'foo@' , q!bad package name: '%%'! ],
        [ 'foo ( >= 3.24' , q!Cannot parse: '%%'! ],
        [ 'foo ( >= 3.!4 )' , q(bad dependency version: '3.!4') ],
        [ 'bar( >= 1.1) | foo ( >= 3.!4 )' , q(bad dependency version: '3.!4') ],
        [ 'bar( >= 1.!1) | foo ( >= 3.14 )' , q{bad dependency version: '1.!1)'} ],
        [ 'foo ( <> 3.24 )' , q!bad dependency version operator: '<>'! ],

        [ 'foo ( >= 1.24 )| bar [ binux-any]' , q!bad os in architecture specification: 'binux'!, 
                                                q!bad arch in architecture specification: 'binux'! ],
        [ 'foo ( >= 1.24 )| bar [ linux-nany]' , q!bad arch in architecture specification: 'nany'! ],

        [ 'xserver-xorg-input-evdev [alpha !amd64 !arm armeb]' ,
            q(some names are prepended with '!' while others aren't.: 'alpha !amd64 !arm armeb') ],

    ) ;

    foreach my $td ( @tests ) {
        my ($dep,@errs) = @$td ;
        next if $pat and $dep !~ /$pat/;
        my $ret = $parser->dependency($dep) ;
        map { s/%%/$dep/;} @errs ;
        unshift @errs, 0; # match what's returned when there's an error
        is_deeply($ret,\@errs,"test error message for $dep") ;
    }
}