This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix CPANPLUS test to work with 5.10.0
[perl5.git] / lib / CPANPLUS / t / 00_CPANPLUS-Internals-Utils.t
1 ### make sure we can find our conf.pl file
2 BEGIN { 
3     use FindBin; 
4     require "$FindBin::Bin/inc/conf.pl";
5 }
6
7 use strict;
8
9 ### make sure to keep the plan -- this is the only test
10 ### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details
11 use Test::More tests => 36;
12
13 use Cwd;
14 use Data::Dumper;
15 use File::Spec;
16 use File::Basename;
17
18 use CPANPLUS::Error;
19 use CPANPLUS::Internals::Utils;
20
21 my $Cwd     = File::Spec->rel2abs(cwd());
22 my $Class   = 'CPANPLUS::Internals::Utils';
23 my $Dir     = 'foo';
24 my $Move    = 'bar';
25 my $File    = 'zot';
26
27 rmdir $Move if -d $Move;
28 rmdir $Dir  if -d $Dir;
29
30 ### test _mdkir ###
31 {   ok( $Class->_mkdir( dir => $Dir),   "Created dir '$Dir'" );
32     ok( -d $Dir,                        "   '$Dir' is a dir" );
33 }
34
35 ### test _chdir ###
36 {   ok( $Class->_chdir( dir => $Dir),   "Chdir to '$Dir'" );    
37     is( File::Spec->rel2abs(cwd()), File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)),
38                                         "   Cwd() is '$Dir'");  
39     ok( $Class->_chdir( dir => $Cwd),   "Chdir back to '$Cwd'" );
40     is( File::Spec->rel2abs(cwd()),$Cwd,"   Cwd() is '$Cwd'" );
41 }
42
43 ### test _move ###
44 {   ok( $Class->_move( file => $Dir, to => $Move ),
45                                         "Move from '$Dir' to '$Move'" );
46     ok(  -d $Move,                      "   Dir '$Move' exists" );
47     ok( !-d $Dir,                       "   Dir '$Dir' no longer exists" );
48     
49     
50     {   local $CPANPLUS::Error::ERROR_FH = output_handle();
51     
52         ### now try to move it somewhere it can't ###
53         ok( !$Class->_move( file => $Move, to => 'inc' ),
54                                         "   Impossible move detected" );
55         like( CPANPLUS::Error->stack_as_string, qr/Failed to move/,
56                                         "   Expected error found" );
57     }
58 }                                                                                   
59             
60 ### test _rmdir ###
61 {   ok( -d $Move,                       "Dir '$Move' exists" );
62     ok( $Class->_rmdir( dir => $Move ), "   Deleted dir '$Move'" );
63     ok(!-d $Move,                       "   Dir '$Move' no longer exists" );
64 }
65
66 ### _get_file_contents tests ###
67 {   my $contents = $Class->_get_file_contents( file => basename($0) );
68     ok( $contents,                      "Got file contents" );
69     like( $contents, qr/BEGIN/,         "   Proper contents found" );
70     like( $contents, qr/CPANPLUS/,      "   Proper contents found" );
71 }
72     
73 ### _perl_version tests ###
74 {   my $version = $Class->_perl_version( perl => $^X );
75     ok( $version,                       "Perl version found" );
76     like( $version, qr/\d.\d+.\d+/,     "   Looks like a proper version" );
77 }    
78         
79 ### _version_to_number tests ###
80 {   my $map = {
81         '1'     => '1',
82         '1.2'   => '1.2',
83         '.2'    => '.2',
84         'foo'   => '0.0',
85         'a.1'   => '0.0',
86     };        
87
88     while( my($try,$expect) = each %$map ) {
89         my $ver = $Class->_version_to_number( version => $try );
90         ok( $ver,                       "Version returned" );
91         is( $ver, $expect,              "   Value as expected" );
92     }         
93 }
94
95 ### _whoami tests ###
96 {   sub foo { 
97         my $me = $Class->_whoami; 
98         ok( $me,                        "_whoami returned a result" );
99         is( $me, 'foo',                 "   Value as expected" ); 
100     } 
101
102     foo();
103 }
104         
105 ### _mode_plus_w tests ###
106 {   open my $fh, ">$File" or die "Could not open $File for writing: $!";
107     close $fh;
108     
109     ### remove perms
110     ok( -e $File,               "File '$File' created" );
111     ok( chmod( 000, $File ),    "   File permissions set to 000" );
112     
113     ok( $Class->_mode_plus_w( file => $File ),
114                                 "   File permissions set to +w" );
115     ok( -w $File,               "   File is writable" );
116
117     1 while unlink $File;
118     
119     ok( !-e $File,              "   File removed" );
120 }
121     
122
123
124         
125         
126 # Local variables:
127 # c-indentation-style: bsd
128 # c-basic-offset: 4
129 # indent-tabs-mode: nil
130 # End:
131 # vim: expandtab shiftwidth=4:
132