File: 02_main.t

package info (click to toggle)
libfile-userconfig-perl 0.06-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd, stretch, wheezy
  • size: 192 kB
  • ctags: 107
  • sloc: perl: 1,280; makefile: 15
file content (102 lines) | stat: -rw-r--r-- 2,890 bytes parent folder | download | duplicates (2)
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#!/usr/bin/perl

# Compile-testing for File::UserConfig

use strict;
BEGIN {
	$|  = 1;
	$^W = 1;
}

use Test::More tests => 27;
use File::Spec::Functions ':ALL';
use File::UserConfig ();
use File::Remove 'clear', 'remove';

my $testfrom = catdir( 't', 'testfrom' );
my $testto   = catdir( 't', 'testto'   );

ok( -d $testfrom, 'testfrom exists' );
clear( $testto );
ok( ! -e $testto, "testto doesn't exist" );

# Get a config via another package to avoid freaking out
# _caller.
is( MyFoo::call1(), 'MyFoo', '_caller works' );
is( MyFoo::call2(), 'MyFoo', '_caller isnt confused by subclasses' );

my $config = MyFoo::foo();
isa_ok( $config, 'File::UserConfig' );
is( $config->dist     => 'File-UserConfig', '->dist matches expected' );
is( $config->dirname  => 'testto',          '->dirname matches expected' );
is( $config->sharedir => $testfrom,
	'->sharedir matches expected' );
ok( -d $config->sharedir, '->sharedir exists' );
ok( -d File::ShareDir::dist_dir( $config->dist ), 'Found the default one' );
is( $config->homedir  => 't', '->homedir returns expected' );
ok( -d $config->homedir, '->homedir exists' );
ok( -d File::HomeDir->my_data, 'Could get the REAL data dir' );
is( $config->configdir, catdir( curdir(), $testto ),
	'->configdir matches expected' );
ok( -d $config->configdir, '->configdir exists' );
ok( -f catfile( $config->configdir, 'afile.conf' ),
	'Found expected config file' );
ok( -d catfile( $config->configdir, 'subdir' ),
	'Found expected directory' );
ok( -f catfile( $config->configdir, 'subdir', 'bfile.txt' ),
	'Found expected config file in subdirectory' );
if ( -e $testto ) { remove( \1, $testto ) }

# Repeat using the more defaults
my $config2 = MyFoo::bar();
END {
	if ( $config2 and -e $config2->configdir ) {
		remove( \1, $config2->configdir );
	}
}
isa_ok( $config2, 'File::UserConfig' );
is( $config2->dist     => 'File-UserConfig', '->dist matches expected' );
ok( -d $config2->sharedir, '->sharedir exists' );
is( $config2->homedir  => 't', '->homedir returns expected' );
ok( -d $config2->homedir, '->homedir exists' );
ok( $config2->configdir, '->configdir returned' );
ok( -d $config2->configdir, '->configdir exists' );
ok( -f catfile( $config2->configdir, 'afile.conf' ),
	'Found expected config file' );
ok( ! -d catfile( $config2->configdir, 'subdir' ),
	'Found expected directory' );
if ( $config2 and -d $config2->configdir ) {
	remove( \1, $config2->configdir );
}

exit(0);

package MyFoo;

sub foo {
	return File::UserConfig->new(
		dist     => 'File-UserConfig',
		dirname  => 'testto',
		sharedir => $testfrom,
		homedir  => 't',
		);
}

sub bar {
	return File::UserConfig->new(
		dist     => 'File-UserConfig',
		module   => 'File::UserConfig',
		homedir  => 't',
		);
}

sub call1 { File::UserConfig->_caller() }
sub call2 { MyConfig->_caller()         }

package MyConfig;

use base 'File::UserConfig';

sub dummy { 1 }

1;