Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

THALJEF / Pinto-0.14 / t / 02-bowels / 04-distribution.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

              
#!perl
use strict;
use warnings;
use Test::More;
use Path::Class;
use lib 't/lib';
use Pinto::Tester::Util qw(make_dist_obj);
#-----------------------------------------------------------------------------
subtest 'author/archive' => sub {
    my $dist = make_dist_obj(
        author  => 'FOO',
        archive => 'Bar-1.2.tar.gz'
    );
    is( $dist->author,   'FOO',                     'dist author' );
    is( $dist->archive,  'Bar-1.2.tar.gz',          'dist archive' );
    is( $dist->source,   'LOCAL',                   'Source defaults to q{LOCAL}' );
    is( $dist->name,     'Bar',                     'dist name' );
    is( $dist->vname,    'Bar-1.2',                 'dist name' );
    is( $dist->version,  '1.2',                     'dist version' );
    is( $dist->is_local, 1,                         'is_local is true when origin eq q{LOCAL}' );
    is( $dist->is_devel, q{},                       'this is not a devel dist' );
    is( $dist->path,     'F/FO/FOO/Bar-1.2.tar.gz', 'Logical archive path' );
    is( $dist->native_path('here'), file(qw(here F FO FOO Bar-1.2.tar.gz)), 'Physical archive path, with base' );
    is( "$dist", 'FOO/Bar-1.2.tar.gz', 'Stringifies to author/archive' );
};
#-----------------------------------------------------------------------------
subtest 'author/archive/source' => sub {
    my $dist = make_dist_obj(
        author  => 'FOO',
        archive => 'Bar-4.3_34.tgz',
        source  => 'http://remote/Bar-4.3_34.tgz'
    );
    is( $dist->source(),   'http://remote/Bar-4.3_34.tgz', 'Non-local source' );
    is( $dist->name(),     'Bar',                          'dist name' );
    is( $dist->vname(),    'Bar-4.3_34',                   'dist vname' );
    is( $dist->version(),  '4.3_34',                       'dist version' );
    is( $dist->is_local(), q{},                            'is_local is false when dist is remote' );
    is( $dist->is_devel(), 1,                              'this is a devel dist' );
};
#------------------------------------------------------------------------------
subtest 'author/archive/formats' => sub {
    my $dist = make_dist_obj(
        author  => 'AUTHOR',
        archive => 'Foo-2.0.tar.gz'
    );
    my %formats = (
        'm' => 'r',
        'h' => 'A/AU/AUTHOR/Foo-2.0.tar.gz',
        's' => 'l',
        'S' => 'LOCAL',
        'a' => 'AUTHOR',
        'd' => 'Foo',
        'D' => 'Foo-2.0',
        'V' => '2.0',
        'u' => 'UNKNOWN',
    );
    while ( my ( $placeholder, $expected ) = each %formats ) {
        my $got = $dist->to_string("%$placeholder");
        is( $got, $expected, "Placeholder: %$placeholder" );
    }
};
#------------------------------------------------------------------------------
done_testing;