The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Perl::Version;
use Test::More tests => 409;

my ( $SORTED, $EQUAL );

BEGIN {
  $SORTED = [
    '0',                   '0.000',
    '0.000001',            '0.0.4',
    '0.000004',            'v0.0.4',
    '0.0.8',               '0.000008',
    'v0.0.8',              '0.01',
    '0.1',                 '0.58',
    '0.700',               '1',
    '1',                   '1.0',
    '1.0.0',               '1.0.0.0',
    '1.000',               '1.000000',
    '1.000000000',         'v1',
    'v1.0.0',              '1.0004',
    '1.1',                 '1.001_002',
    '1.001002',            '1.1.999',
    '1.02',                '1.2',
    '1.2',                 '1.2.0',
    'v1.2',                'v1.2.0',
    '1.2_1',               'v1.2_1',
    '1.2_3',               '1.002001',
    '1.002003',            '1.2.3',
    '1.2.3',               '1.2.3.0',
    '1.2.3_0',             'v1.2.3',
    'v1.2.3',              '1.2.3_01',
    '1.2.3_1',             '1.2.3_1',
    'v1.2.3_1',            '1.2.3_002',
    '1.2.3_4',             '1.2.3_4',
    'v1.2.3_4',            'v1.2.3_4',
    '1.2.3.1',             '1.2.3.4',
    '1.2.3.4',             'v1.2.3.4',
    '1.2.3.4_1',           'v1.2.3.4_1',
    '1.2.3.4.5.6.7.8.0.1', '1.2.3.4.5.6.7.8.9',
    '1.2.04',              '1.2.4',
    '1.2.005',             '1.002030',
    'v1.2.034',            'v1.00000002.00000034_00056',
    'v1.02.34_00056',      '1.003',
    'v001.3',              '1.7',
    '1.23',                'v1.23',
    'v1.23.0',             '1.23_01',
    '1.23_0100',           'v1.23.45.00',
    '1.24',                '1.230',
    '1.700',               '2',
    '2',                   '3',
    '3',                   '4',
    '4',                   '5',
    '5.005',               '5.005_02',
    'v5.005_02',           '5.005_03',
    '5.005_030',           '5.005030',
    '5.5.30',              '5.006_002',
    '5.006.001',           '5.006001',
    'v5.6.1',              'v5.6.1',
    '5.6.2',               '5.008',
    '5.8.0',               '5.008_001',
    '5.8.1',               '06',
    '6',                   '7',
    '8',                   '23',
    '44',                  '99',
    '99',                  '99.0',
    '99.000',              'v99.0.0',
    'v99.0.0',             '100',
    '2002.009030001',      '2002.09.30.1',
    '2002.9.30.1',         '19017',
    '19517',               '885915'
  ];

  $EQUAL = [
    [ '0', '0.000' ],
    [ '0.0.4', '0.000004', 'v0.0.4' ],
    [ '0.0.8', '0.000008', 'v0.0.8' ],
    [ '0.01',  '0.1' ],
    [
      '1',       '1',     '1.0',      '1.0.0',
      '1.0.0.0', '1.000', '1.000000', '1.000000000',
      'v1',      'v1.0.0'
    ],
    [ '1.02',  '1.2', '1.2', '1.2.0', 'v1.2', 'v1.2.0' ],
    [ '1.2_1', 'v1.2_1' ],
    [
      '1.002003', '1.2.3',  '1.2.3', '1.2.3.0',
      '1.2.3_0',  'v1.2.3', 'v1.2.3'
    ],
    [ '1.2.3_01',  '1.2.3_1', '1.2.3_1',  'v1.2.3_1' ],
    [ '1.2.3_4',   '1.2.3_4', 'v1.2.3_4', 'v1.2.3_4' ],
    [ '1.2.3.4',   '1.2.3.4', 'v1.2.3.4' ],
    [ '1.2.3.4_1', 'v1.2.3.4_1' ],
    [ '1.2.04',    '1.2.4' ],
    [ 'v1.00000002.00000034_00056', 'v1.02.34_00056' ],
    [ '1.003',                      'v001.3' ],
    [ '1.23',     'v1.23', 'v1.23.0' ],
    [ '2',        '2' ],
    [ '3',        '3' ],
    [ '4',        '4' ],
    [ '5.005_02', 'v5.005_02' ],
    [ '5.005030', '5.5.30' ],
    [ '5.006.001', '5.006001', 'v5.6.1', 'v5.6.1' ],
    [ '5.008',     '5.8.0' ],
    [ '06',        '6' ],
    [ '99', '99', '99.0', '99.000', 'v99.0.0', 'v99.0.0' ],
    [ '2002.009030001', '2002.09.30.1', '2002.9.30.1' ]
  ];
}

{

  # Ordering
  local $SIG{__WARN__} = sub { };
  my @obj
   = map { { ver => $_, obj => Perl::Version->new( $_ ) } } @$SORTED;

  for my $i ( 0 .. $#obj - 1 ) {
    my ( $v1, $v2 ) = @obj[ $i .. $i + 1 ];
    my $test = $v1->{ver} . ' <= ' . $v2->{ver};
    unless ( ok $v1->{obj} <= $v2->{obj}, $test ) {
      diag( $v1->{ver} );
      diag( Data::Dumper->Dump( [ $v1->{obj} ], ['$v1'] ) );
      diag( $v2->{ver} );
      diag( Data::Dumper->Dump( [ $v2->{obj} ], ['$v2'] ) );
    }
  }
}

{

  # Equality
  local $SIG{__WARN__} = sub { };

  for my $equals ( @$EQUAL ) {
    my @obj
     = map { { ver => $_, obj => Perl::Version->new( $_ ) } } @$equals;
    for my $i ( 0 .. $#obj - 1 ) {
      for my $j ( 0 .. $#obj ) {
        my ( $v1, $v2 ) = ( $obj[$i], $obj[$j] );
        my $test = $v1->{ver} . ' == ' . $v2->{ver};
        unless ( ok $v1->{obj} == $v2->{obj}, $test ) {
          diag( $v1->{ver} );
          diag( Data::Dumper->Dump( [ $v1->{obj} ], ['$v1'] ) );
          diag( $v2->{ver} );
          diag( Data::Dumper->Dump( [ $v2->{obj} ], ['$v2'] ) );
        }
      }
    }
  }
}