root/t/01getopt.t

#!/usr/bin/perl

use strict;

BEGIN { chdir 't' if -d 't' }
use lib '../lib';

use Test::More tests => 25;

#use Lancelot::GetOpt qw/GetOptions/;
use Pod::Usage;

{ no warnings;
  package Pod::Usage;
  use subs 'pod2usage';
  package main;
  *Pod::Usage::pod2usage = sub {
      my (%args) = @_;
      # if ($args{'-message'} 
  };
}

use_ok('Lancelot::GetOpt');

my (@opts) = qw/opt1|A? opt2|B! opt3|C= opt4|D@ opt5|E:/;

my (@tests) = ([ qw/--opt1/, "opt1=1" ],
               [ qw/-A/, "opt1=1" ],
               [ qw/--opt2/, "opt2=1" ],
               [ qw/-B/, "opt2=1" ],
               [ qw/--noopt2/, "opt2=0" ],
               [ qw/--opt3=bla/, "opt3=bla" ],
               [ qw/-C bla/, "opt3=bla" ],
               [ qw/-C=bla/, "" ],
               [ qw/--opt4=bla/, "opt4=[bla]" ],
               [ qw/--opt4=bla --opt4=bli/, "opt4=[bla,bli]" ],
               [ qw/-D bla/, "opt4=[bla]" ],
               [ qw/-D bla -D bli/, "opt4=[bla,bli]" ],
               [ qw/--opt5/, "opt5=" ],
               [ qw/--opt5=bla/, "opt5=bla" ],
               [ qw/-E/, "opt5=" ],
               [ qw/-E bla/, "opt5= ARGV=bla" ],
#              [ qw/--help/, "help=1" ],
#              [ qw/-?/, "help=1" ],
               [ qw/-v/, "verbose=" ],
               [ qw/-v bla/, "verbose= ARGV=bla" ],
               [ qw/--verbose bla/, "verbose= ARGV=bla" ],
               [ qw/--verbose=bla/, "verbose=bla" ],

               [ qw/--opt1/, [[ qw/-defaults/], "debug=0 opt1=1 opt2=-1 opt4=[]"]],
               [ qw/-A bla/, [[ qw/-argvmin 1 too-few/ ], "opt1=1 ARGV=bla" ]],
               [ qw/-A bla blubb/,
                 [[ qw/-argvmin 1 too-few/ ], "opt1=1 ARGV=bla blubb" ]],
               [ qw/-A bla blubb/,
                 [[ qw/-argvmin 3 too-few/ ], "opt1=1 ARGV=bla blubb" ]],
               );

foreach my $t (@tests) {
    my (@tt) = @$t;
    my ($result) = pop @tt;
    my (%options);
    my ($control) = [];

    ($control, $result) = @$result if ref($result) eq 'ARRAY';

    @ARGV = @tt;
    Lancelot::GetOpt::GetOptions(\%options, @$control, @opts);

    foreach my $o (keys %options) {
        if (ref($options{$o}) eq "ARRAY") {
            $options{$o} = "[" . join(",", @{$options{$o}}) . "]";
        }
    }

    my $output = join " ", map { "$_=$options{$_}" } sort keys %options;
    $output .= " ARGV=@ARGV" if @ARGV;

    is($output, $result, "Test @tt");
}