From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!/usr/bin/perl
use strict;
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'] ) );
}
}
}
}
}