#!perl
#   ---------------------------------------------------------------------- copyright and license ---
#
#   file: t/01-version-dotted.pm
#
#   Copyright © 2016 Van de Bugger.
#
#   This file is part of perl-Version-Dotted.
#
#   perl-Version-Dotted is free software: you can redistribute it and/or modify it under the terms
#   of the GNU General Public License as published by the Free Software Foundation, either version
#   3 of the License, or (at your option) any later version.
#
#   perl-Version-Dotted is distributed in the hope that it will be useful, but WITHOUT ANY
#   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
#   PURPOSE. See the GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License along with
#   perl-Version-Dotted. If not, see <http://www.gnu.org/licenses/>.
#
#   ---------------------------------------------------------------------- copyright and license ---

use strict;
use warnings;
use if $ENV{AUTOMATED_TESTING}, 'Test::DiagINC'; use version 0.77 qw{};

use Scalar::Util qw{ blessed };
use Test::Builder;
use Test::More;
use Test::Warn;
use Version::Dotted 'qv';

sub ver_ok($$) {
    my ( $act, $exp ) = @_;
    my $Test = Test::Builder->new();
    $Test->ok( "$act" eq "$exp" ) or diag( "$act ne $exp" );
    $Test->ok( $act == $exp )     or diag( "$act != $exp" );
};

my $negative = 'Negative version part index';
my $invalid  = 'Invalid version part index';
my $warnings = 0;

{

local $SIG{ __WARN__ } = sub {
    ++ $warnings;
    STDERR->print( @_ );
};

my $v;

$v = qv( 1 );                           is( blessed( $v ), 'Version::Dotted' );
$v = Version::Dotted->declare( 1 );     is( blessed( $v ), 'Version::Dotted' );

# One-part versions:
$v = qv( 1    );          ver_ok( $v, 'v1' );
$v = qv( '1'  );          ver_ok( $v, 'v1' );
$v = qv( v1   );          ver_ok( $v, 'v1' );
$v = qv( 'v1' );          ver_ok( $v, 'v1' );

# Two-part versions:
$v = qv( 1.2 );           ver_ok( $v, 'v1.2' );
$v = qv( '1.2' );         ver_ok( $v, 'v1.2' );
$v = qv( v1.2 );          ver_ok( $v, 'v1.2' );
$v = qv( 'v1.2' );        ver_ok( $v, 'v1.2' );

# Three-part versions:
$v = qv( 1.2.3 );         ver_ok( $v, 'v1.2.3' );
$v = qv( '1.2.3' );       ver_ok( $v, 'v1.2.3' );
$v = qv( v1.2.3 );        ver_ok( $v, 'v1.2.3' );
$v = qv( 'v1.2.3' );      ver_ok( $v, 'v1.2.3' );

# Four-part versions:
$v = qv( 1.2.3.4 );       ver_ok( $v, 'v1.2.3.4' );
$v = qv( '1.2.3.4' );     ver_ok( $v, 'v1.2.3.4' );
$v = qv( v1.2.3.4 );      ver_ok( $v, 'v1.2.3.4' );
$v = qv( 'v1.2.3.4' );    ver_ok( $v, 'v1.2.3.4' );

# Copy constructors:
$v = qv( version->declare( v1.2.0 ) );  ver_ok( $v, 'v1.2' );
$v = qv( version->parse( 1.2 ) );       ver_ok( $v, 'v1.200' );
$v = qv( qv( v1.2 ) );                  ver_ok( $v, 'v1.2' );

# Leading zeroes do not matter:
$v = qv( 1.002 );             ver_ok( $v, 'v1.2' );
$v = qv( v01.02.03 );         ver_ok( $v, 'v1.2.3' );
$v = qv( '1.02.003.0004' );   ver_ok( $v, 'v1.2.3.4' );
# Oops:
$v = qv( 010 );               ver_ok( $v, 'v8' );
$v = qv( 010.011 );           ver_ok( $v, 'v89' );
$v = qv( 010.011.012 );       ver_ok( $v, 'v8910' );
# But:
$v = qv( v010 );              ver_ok( $v, 'v10' );
$v = qv( v010.011 );          ver_ok( $v, 'v10.11' );
$v = qv( '010.011.012' );     ver_ok( $v, 'v10.11.12' );

# Trailing zero parts are truncated:
$v = qv( 'v1.0.0.0.0.0' );    ver_ok( $v, 'v1' );
$v = qv( 'v1.2.3.4.0.0' );    ver_ok( $v, 'v1.2.3.4' );

# Too large part:
warning_like( sub { qv( 'v1.1000.3.4' ) }, qr{too large part} );
# But the first part may be large:
$v = qv( 'v1000.999.999.999' );   ver_ok( $v, 'v1000.999.999.999' );

# Parts:
$v = qv( 'v1.2.3' );
ok( $v->part( 0 ) == 1 );
ok( $v->part( 1 ) == 2 );
ok( $v->part( 2 ) == 3 );
ok( ! defined $v->part( 5 ) );
# Negative part index causes warning:
warning_like( sub { $v->part( -1 ) }, qr{$negative '-1'} );
{
    no warnings 'Version::Dotted';  # Warning can be disabled.
    # In such a case negative index counts parts from the end:
    ok( $v->part( -1 ) == 3 );      # The last part.
    ok( $v->part( -2 ) == 2 );      # The second last part.
    ok( $v->part( -3 ) == 1 );      # The third last part.
    ok( ! defined $v->part( -4 ) ); # Oops.
}

# Bumping:
$v = qv( 'v1.2.3' );
ver_ok( $v->bump( 3 ), 'v1.2.3.1'     );      ver_ok( $v, 'v1.2.3.1'     );
ver_ok( $v->bump( 5 ), 'v1.2.3.1.0.1' );      ver_ok( $v, 'v1.2.3.1.0.1' );
ver_ok( $v->bump( 5 ), 'v1.2.3.1.0.2' );      ver_ok( $v, 'v1.2.3.1.0.2' );
ver_ok( $v->bump( 4 ), 'v1.2.3.1.1'   );      ver_ok( $v, 'v1.2.3.1.1'   );
ver_ok( $v->bump( 3 ), 'v1.2.3.2'     );      ver_ok( $v, 'v1.2.3.2'     );
ver_ok( $v->bump( 2 ), 'v1.2.4'       );      ver_ok( $v, 'v1.2.4'       );
ver_ok( $v->bump( 1 ), 'v1.3'         );      ver_ok( $v, 'v1.3'         );
ver_ok( $v->bump( 0 ), 'v2'           );      ver_ok( $v, 'v2'           );


# Bumping with negative index:
$v = qv( 'v1.2.3.4' );
warning_like( sub { ver_ok( $v->bump( -1 ), 'v1.2.3.5' ); }, qr{$negative '-1'} ); ver_ok( $v, 'v1.2.3.5' );
warning_like( sub { ver_ok( $v->bump( -2 ), 'v1.2.4' ); }, qr{$negative '-2'} ); ver_ok( $v, 'v1.2.4' );
warning_like( sub { ver_ok( $v->bump( -3 ), 'v2' ); }, qr{$negative '-3'} ); ver_ok( $v, 'v2' );
warning_like( sub { ok( ! defined $v->bump( -2 ) ); }, qr{$invalid '-2'}  ); ver_ok( $v, 'v2' );

# Compare:
ok( qv( 1.002 ) == 1.2 );

# Not supported methods:
$v = qv( 'v1.2.3' );
warning_like( sub { $v->is_alpha }, qr{'is_alpha' is not supported} );
warning_like( sub { $v->numify   }, qr{'numify' is not supported}   );
warning_like( sub { Version::Dotted->parse( 'v1.2.3' ) }, qr{'parse' is not supported} );
{
    no warnings 'Version::Dotted';
    ok( ! defined $v->is_alpha );
    ok( ! defined $v->numify   );
    ok( ! defined Version::Dotted->parse( 'v1.2.3' ) );
}

# Export:
{
    package Dummy1;
    use Version::Dotted;
    use Test::More;
    eval "qv( v1.2.3 )";
    like( $@, qr{Undefined subroutine &Dummy1::qv}, "no export by default" );
}
{
    package Dummy2;
    use Test::More;
    use Test::Warn;
    warning_like( sub { eval "use Version::Dotted 'qw';"; }, qr{Bad Version::Dotted import: 'qw'} );
    is( $@, '' );
}

}

is( $warnings, 0, "no warnings are expected" );

done_testing;

exit( 0 );

# end of file #
