#!/usr/bin/perl

use strict;
use warnings;
use Perl::Version;
use Data::Dumper;

my @tests;

BEGIN {
    @tests = (

        # Tests that peform no modification - just check that the components
        # have the correct values
        {
            name        => 'Single component',
            new_arg     => '1',
            components  => 1,
            component_0 => 1,
            component_1 => undef,
            alpha       => 0,
            normal      => 'v1.0.0',
            numify      => '1.000',
        },
        {
            name        => 'Two components',
            new_arg     => '1.2',
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 0,
            normal      => 'v1.2.0',
            numify      => '1.002',
        },
        {
            name        => 'Three components',
            new_arg     => '1.2.3',
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 0,
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name                 => 'Three components, named components',
            new_arg              => '1.2.3',
            components           => 3,
            component_revision   => 1,
            component_version    => 2,
            component_subversion => 3,
            component_3          => undef,
            alpha                => 0,
            normal               => 'v1.2.3',
            numify               => '1.002003',
        },
        {
            name        => 'Four components',
            new_arg     => '1.2.3.4',
            components  => 4,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => 4,
            component_4 => undef,
            alpha       => 0,
            normal      => 'v1.2.3.4',
            numify      => '1.002003004',
        },
        {
            name        => 'Perl style, three components',
            new_arg     => '1.002030',
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 30,
            component_3 => undef,
            alpha       => 0,
            normal      => 'v1.2.30',
            numify      => '1.002030',
        },
        {
            name        => 'Single component, v prefix',
            new_arg     => 'v1',
            components  => 1,
            component_0 => 1,
            component_1 => undef,
            alpha       => 0,
            normal      => 'v1.0.0',
            numify      => '1.000',
        },
        {
            name        => 'Two components, v prefix',
            new_arg     => 'v1.2',
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 0,
            normal      => 'v1.2.0',
            numify      => '1.002',
        },
        {
            name        => 'Three components, v prefix',
            new_arg     => 'v1.2.3',
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 0,
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name        => 'Four components, v prefix',
            new_arg     => 'v1.2.3.4',
            components  => 4,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => 4,
            component_4 => undef,
            alpha       => 0,
            normal      => 'v1.2.3.4',
            numify      => '1.002003004',
        },
        {
            name        => 'Two components, alpha',
            new_arg     => '1.2_1',
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 1,
            normal      => 'v1.2.0_01',
            numify      => '1.002_01',
        },
        {
            name        => 'Three components, alpha',
            new_arg     => '1.2.3_1',
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 1,
            normal      => 'v1.2.3_01',
            numify      => '1.002003_01',
        },
        {
            name        => 'Four components, alpha',
            new_arg     => '1.2.3.4_1',
            components  => 4,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => 4,
            component_4 => undef,
            alpha       => 1,
            normal      => 'v1.2.3.4_01',
            numify      => '1.002003004_01',
        },
        {
            name        => 'Two components, v prefix, alpha',
            new_arg     => 'v1.2_1',
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 1,
            normal      => 'v1.2.0_01',
            numify      => '1.002_01',
        },
        {
            name        => 'Three components, v prefix, alpha',
            new_arg     => 'v1.2.3_1',
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 1,
            normal      => 'v1.2.3_01',
            numify      => '1.002003_01',
        },
        {
            name        => 'Four components, v prefix, alpha',
            new_arg     => 'v1.2.3.4_1',
            components  => 4,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => 4,
            component_4 => undef,
            alpha       => 1,
            normal      => 'v1.2.3.4_01',
            numify      => '1.002003004_01',
        },

        # Tests that modify various values
        {
            name    => 'Single component, modify it',
            new_arg => '1',
            action  => sub {
                $_->component( 0, 2 );
            },
            components  => 1,
            component_0 => 2,
            component_1 => undef,
            alpha       => 0,
            stringify   => '2',
            normal      => 'v2.0.0',
            numify      => '2.000',
        },
        {
            name    => 'Single component, add component',
            new_arg => '1',
            action  => sub {
                $_->component( 1, 2 );
            },
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 0,
            stringify   => '1.2',
            normal      => 'v1.2.0',
            numify      => '1.002',
        },
        {
            name    => 'Single component, add gap, component',
            new_arg => '1',
            action  => sub {
                $_->component( 2, 2 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 0,
            component_2 => 2,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.0.2',
            normal      => 'v1.0.2',
            numify      => '1.000002',
        },
        {
            name    => 'Single component, attempt to set components to 0',
            new_arg => '1',
            action  => sub {
                $_->components( 0 );
            },
            act_err     => { error => qr/set the number of components to 0/ },
            components  => 1,
            component_0 => 1,
            component_1 => undef,
            alpha       => 0,
            stringify   => '1',
            normal      => 'v1.0.0',
            numify      => '1.000',
        },
        {
            name    => 'Single component, attempt to set components to 1',
            new_arg => '1',
            action  => sub {
                $_->components( 1 );
            },
            components  => 1,
            component_0 => 1,
            component_1 => undef,
            alpha       => 0,
            stringify   => '1',
            normal      => 'v1.0.0',
            numify      => '1.000',
        },
        {
            name    => 'Two components, set components to 1',
            new_arg => '1.2',
            action  => sub {
                $_->components( 1 );
            },
            components  => 1,
            component_0 => 1,
            component_1 => undef,
            alpha       => 0,
            stringify   => '1',
            normal      => 'v1.0.0',
            numify      => '1.000',
        },
        {
            name    => 'Two components, set components to 3',
            new_arg => '1.2',
            action  => sub {
                $_->components( 3 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.0',
            normal      => 'v1.2.0',
            numify      => '1.002000',
        },
        {
            name    => 'Three components, set alpha',
            new_arg => '1.2.3',
            action  => sub {
                $_->alpha( 4 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 4,
            stringify   => '1.2.3_04',
            normal      => 'v1.2.3_04',
            numify      => '1.002003_04',
        },
        {
            name    => 'Three components, clear alpha',
            new_arg => '1.2.3_4',
            action  => sub {
                $_->alpha( 0 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.3',
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name    => 'Three components, inc revision',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 0 );
            },
            components  => 3,
            component_0 => 2,
            component_1 => 0,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '2.0.0',
            normal      => 'v2.0.0',
            numify      => '2.000000',
        },
        {
            name    => 'Three components, inc version',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 1 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 3,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.3.0',
            normal      => 'v1.3.0',
            numify      => '1.003000',
        },
        {
            name    => 'Three components, inc subversion',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 2 );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 4,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.4',
            normal      => 'v1.2.4',
            numify      => '1.002004',
        },
        {
            name    => 'Three components, no alpha, inc alpha',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'alpha' );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 1,
            stringify   => '1.2.3_01',
            normal      => 'v1.2.3_01',
            numify      => '1.002003_01',
        },
        {
            name    => 'Three components, no alpha, inc alpha (caps)',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'AlphA' );
            },
            components      => 3,
            component_0     => 1,
            component_1     => 2,
            component_2     => 3,
            component_3     => undef,
            component_alpha => 1,
            stringify       => '1.2.3_01',
            normal          => 'v1.2.3_01',
            numify          => '1.002003_01',
        },
        {
            name    => 'Three components, alpha, inc alpha',
            new_arg => '1.2.3_4',
            action  => sub {
                $_->increment( 'alpha' );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 5,
            stringify   => '1.2.3_5',
            normal      => 'v1.2.3_05',
            numify      => '1.002003_05',
        },
        {
            name    => 'Two components, inc revision',
            new_arg => '1.2',
            action  => sub {
                $_->increment( 0 );
            },
            components  => 2,
            component_0 => 2,
            component_1 => 0,
            component_2 => undef,
            alpha       => 0,
            stringify   => '2.0',
            normal      => 'v2.0.0',
            numify      => '2.000',
        },
        {
            name    => 'Two components, inc version',
            new_arg => '1.2',
            action  => sub {
                $_->increment( 1 );
            },
            components  => 2,
            component_0 => 1,
            component_1 => 3,
            component_2 => undef,
            alpha       => 0,
            stringify   => '1.3',
            normal      => 'v1.3.0',
            numify      => '1.003',
        },
        {
            name    => 'Two components, inc alpha',
            new_arg => '1.2',
            action  => sub {
                $_->increment( 'alpha' );
            },
            components  => 2,
            component_0 => 1,
            component_1 => 2,
            component_2 => undef,
            alpha       => 1,
            stringify   => '1.2_01',
            normal      => 'v1.2.0_01',
            numify      => '1.002_01',
        },
        {
            name    => 'Three components, inc revision by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'revision' );
            },
            components  => 3,
            component_0 => 2,
            component_1 => 0,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '2.0.0',
            normal      => 'v2.0.0',
            numify      => '2.000000',
        },
        {
            name    => 'Three components, inc revision by name (caps)',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'Revision' );
            },
            components  => 3,
            component_0 => 2,
            component_1 => 0,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '2.0.0',
            normal      => 'v2.0.0',
            numify      => '2.000000',
        },
        {
            name    => 'Three components, inc version by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'version' );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 3,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.3.0',
            normal      => 'v1.3.0',
            numify      => '1.003000',
        },
        {
            name    => 'Three components, inc subversion by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'subversion' );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 4,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.4',
            normal      => 'v1.2.4',
            numify      => '1.002004',
        },
        {
            name    => 'Three components, inc subversion by name (caps)',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'SuBversion' );
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 4,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.4',
            normal      => 'v1.2.4',
            numify      => '1.002004',
        },
        {
            name    => 'Three components, inc illegal name',
            new_arg => '1.2.3',
            action  => sub {
                $_->increment( 'major' );
            },
            act_err     => { error => qr/Unknown component name: major/ },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.3',
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name    => 'Three components, set illegal name',
            new_arg => '1.2.3',
            action  => sub {
                $_->component( 'major', 99 );
            },
            act_err     => { error => qr/Unknown component name: major/ },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.3',
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name        => 'Three components, named accessors',
            new_arg     => '1.2.3',
            components  => 3,
            revision    => 1,
            version     => 2,
            subversion  => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.3',
            normal      => 'v1.2.3',
            numify      => '1.002003',
        },
        {
            name    => 'Three components, set revision by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->revision( 2 );
            },
            components  => 3,
            revision    => 2,
            version     => 2,
            subversion  => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '2.2.3',
            normal      => 'v2.2.3',
            numify      => '2.002003',
        },
        {
            name    => 'Three components, set version by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->version( 3 );
            },
            components  => 3,
            revision    => 1,
            version     => 3,
            subversion  => 3,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.3.3',
            normal      => 'v1.3.3',
            numify      => '1.003003',
        },
        {
            name    => 'Three components, set subversion by name',
            new_arg => '1.2.3',
            action  => sub {
                $_->subversion( 4 );
            },
            components  => 3,
            revision    => 1,
            version     => 2,
            subversion  => 4,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.4',
            normal      => 'v1.2.4',
            numify      => '1.002004',
        },
        {
            name    => 'Three components, inc_revision',
            new_arg => '1.2.3',
            action  => sub {
                $_->inc_revision;
            },
            components  => 3,
            component_0 => 2,
            component_1 => 0,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '2.0.0',
            normal      => 'v2.0.0',
            numify      => '2.000000',
        },
        {
            name    => 'Three components, inc_version',
            new_arg => '1.2.3',
            action  => sub {
                $_->inc_version;
            },
            components  => 3,
            component_0 => 1,
            component_1 => 3,
            component_2 => 0,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.3.0',
            normal      => 'v1.3.0',
            numify      => '1.003000',
        },
        {
            name    => 'Three components, inc_subversion',
            new_arg => '1.2.3',
            action  => sub {
                $_->inc_subversion;
            },
            components  => 3,
            component_0 => 1,
            component_1 => 2,
            component_2 => 4,
            component_3 => undef,
            alpha       => 0,
            stringify   => '1.2.4',
            normal      => 'v1.2.4',
            numify      => '1.002004',
        },

        # Various tests that the format preservation works as expected
        {
            name    => 'Three components, two digits, long alpha',
            new_arg => 'v1.02.34_00056',
            action  => sub {
                $_->inc_revision;
            },
            stringify => 'v2.00.00',
            normal    => 'v2.0.0',
            numify    => '2.000000',
        },
        {
            name    => 'Three components, eight digits, long alpha',
            new_arg => 'v1.00000002.00000034_00056',
            action  => sub {
                $_->inc_revision;
            },
            stringify => 'v2.00000000.00000000',
            normal    => 'v2.0.0',
            numify    => '2.000000',
        },
        {
            name    => 'Four components, two digits',
            new_arg => 'v1.23.45.00',
            action  => sub {
                $_->inc_revision;
            },
            stringify => 'v2.00.00.00',
            normal    => 'v2.0.0.0',
            numify    => '2.000000000',
        },
        {
            name => 'Three components, last padded to three digits, long alpha',
            new_arg => 'v1.2.034',
            action  => sub {
                $_->inc_revision;
            },
            stringify => 'v2.0.000',
            normal    => 'v2.0.0',
            numify    => '2.000000',
        },
        
        # Setting value
        {
            name => 'Three components, last padded to three digits, long alpha, set',
            new_arg => 'v1.2.034',
            action  => sub {
                $_->set( '2.0.0' );
            },
            stringify => 'v2.0.000',
            normal    => 'v2.0.0',
            numify    => '2.000000',
        },
        {
            name => 'Three components, last padded to three digits, long alpha, set to another version',
            new_arg => 'v1.2.034',
            action  => sub {
                $_->set( Perl::Version->new('2.3.4') );
            },
            stringify => 'v2.3.004',
            normal    => 'v2.3.4',
            numify    => '2.003004',
        },

        # Misc formatting
        {
            name    => 'CVS revision',
            new_arg => 'Revision: 1.2.3',
            normal  => 'v1.2.3',
        },
        {
            name    => 'CVS revision, mixed case',
            new_arg => 'revisioN: 1.2.3',
            normal  => 'v1.2.3',
        },
        {
            name    => 'Leading spaces',
            new_arg => '   v1.2.3',
            numify  => '1.002003',
        },
        {
            name    => 'Trailing spaces',
            new_arg => 'v1.2.3   ',
            numify  => '1.002003',
        },
        {
            name    => 'Leading and trailing spaces',
            new_arg => '        v1.2.3   ',
            numify  => '1.002003',
        },
        {
            name    => 'CVS revision, increment',
            new_arg => 'Revision: 1.2.3',
            action  => sub {
                $_->inc_version;
            },
            stringify => 'Revision: 1.3.0',
        },
        {
            name    => 'Leading spaces, increment',
            new_arg => '   v1.2.3',
            action  => sub {
                $_->inc_version;
            },
            stringify => '   v1.3.0',
        },
        {
            name    => 'Trailing spaces, increment',
            new_arg => 'v1.2.3   ',
            action  => sub {
                $_->inc_version;
            },
            stringify => 'v1.3.0   ',
        },
        {
            name    => 'Leading and trailing spaces, increment',
            new_arg => '        v1.2.3   ',
            action  => sub {
                $_->inc_version;
            },
            stringify => '        v1.3.0   ',
        },

        # Some errors
        {
            name    => 'Trailing decimal',
            new_arg => '1.1.',
            new_err => { error => qr/Illegal version string/i },
        },

        # Versions used in documentation
        {
            name    => 'Round trip 1.3.0 OK',
            new_arg => '1.3.0'
        },
        {
            name    => 'Round trip v1.03.00 OK',
            new_arg => 'v1.03.00'
        },
        {
            name    => 'Round trip 1.10.03 OK',
            new_arg => '1.10.03'
        },
        {
            name    => 'Round trip 2.00.00 OK',
            new_arg => '2.00.00'
        },
        {
            name    => 'Round trip 1.2 OK',
            new_arg => '1.2'
        },
        {
            name    => 'Round trip v1.2.3.4.5.6 OK',
            new_arg => 'v1.2.3.4.5.6'
        },
        {
            name    => 'Round trip v1.2 OK',
            new_arg => 'v1.2'
        },
        {
            name    => 'Round trip Revision: 3.0 OK',
            new_arg => 'Revision: 3.0'
        },
        {
            name    => 'Round trip 1.001001 OK',
            new_arg => '1.001001'
        },
        {
            name    => 'Round trip 1.001_001 OK',
            new_arg => '1.001_001'
        },
        {
            name    => 'Round trip 3.0.4_001 OK',
            new_arg => '3.0.4_001'
        },

        # Tests added in response to specific bugs
        {
            name    => 'Looks like a number with alpha',
            new_arg => '1.001_001',
        },
        {
            name    => 'Zero alpha',
            new_arg => '9.8.7_000',
        },
    );
}

use Test::More tests => @tests * 7;

for my $test ( @tests ) {
    my $name    = delete $test->{name};
    my $version = delete $test->{new_arg};
    my $new_err = delete $test->{new_err};
    my $act_err = delete $test->{act_err};

    my $safe = sub {
        my ( $err, $arg, $code ) = @_;
        my $warned;

        # Promote warnings to errors
        local $SIG{__WARN__} = sub { $warned = $_[0] };

        my $result = eval { $code->( @$arg ) };

        for my $diag ( [ 'error', $@ ], [ 'warning', $warned ] ) {
            my ( $key, $val ) = @$diag;
            like $val || '', $err->{$key} || qr{^$}, "$name: warning OK";
        }

        return $result;
    };

    my $obj = $safe->(
        $new_err,
        [$version],
        sub {
            return Perl::Version->new( @_ );
        },
    );

    if ( $new_err->{error} ) {
        ok !$obj, "$name: object creation failed as expected";
        pass "$name: no object created" for 1 .. 4;
    }
    else {
        isa_ok $obj, 'Perl::Version';

        is $obj->stringify, $version, "$name: stringify round trips correctly";

        if ( my $action = delete $test->{action} ) {
            $safe->(
                $act_err,
                [$obj],
                sub {
                    local $_ = shift;
                    $action->();
                }
            );
        }
        else {
            pass "$name: no action defined" for 1 .. 2;
        }

        verify( $name, $obj, $test );
    }
}

sub verify {
    my ( $test, $obj, $ref ) = @_;
    my $got        = {};
    my @components = sort keys %$ref;
    for my $component ( @components ) {
        my ( $method, @args ) = split( /_/, $component );
        $got->{$component} = $obj->$method( @args );
    }
    my $test_name = "$test: " . join( ', ', @components ) . ' match';
    $test_name .= 'es' if @components = 1;

    unless ( is_deeply $got, $ref, $test_name ) {
        local $Data::Dumper::Sortkeys  = 1;
        local $Data::Dumper::Quotekeys = 0;
        warn Data::Dumper->Dump( [$got], ['$got'] );
        warn Data::Dumper->Dump( [$ref], ['$ref'] );
        warn Data::Dumper->Dump( [$obj], ['$obj'] );
    }
}
