xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/t/op/chdir.t (revision 0:68f95e015346)
1*0Sstevel@tonic-gate#!./perl -w
2*0Sstevel@tonic-gate
3*0Sstevel@tonic-gateBEGIN {
4*0Sstevel@tonic-gate    # We're not going to chdir() into 't' because we don't know if
5*0Sstevel@tonic-gate    # chdir() works!  Instead, we'll hedge our bets and put both
6*0Sstevel@tonic-gate    # possibilities into @INC.
7*0Sstevel@tonic-gate    @INC = qw(t . lib ../lib);
8*0Sstevel@tonic-gate}
9*0Sstevel@tonic-gate
10*0Sstevel@tonic-gateuse Config;
11*0Sstevel@tonic-gaterequire "test.pl";
12*0Sstevel@tonic-gateplan(tests => 31);
13*0Sstevel@tonic-gate
14*0Sstevel@tonic-gatemy $IsVMS   = $^O eq 'VMS';
15*0Sstevel@tonic-gatemy $IsMacOS = $^O eq 'MacOS';
16*0Sstevel@tonic-gate
17*0Sstevel@tonic-gate# Might be a little early in the testing process to start using these,
18*0Sstevel@tonic-gate# but I can't think of a way to write this test without them.
19*0Sstevel@tonic-gateuse File::Spec::Functions qw(:DEFAULT splitdir rel2abs splitpath);
20*0Sstevel@tonic-gate
21*0Sstevel@tonic-gate# Can't use Cwd::abs_path() because it has different ideas about
22*0Sstevel@tonic-gate# path separators than File::Spec.
23*0Sstevel@tonic-gatesub abs_path {
24*0Sstevel@tonic-gate    my $d = rel2abs(curdir);
25*0Sstevel@tonic-gate
26*0Sstevel@tonic-gate    $d = uc($d) if $IsVMS;
27*0Sstevel@tonic-gate    $d = lc($d) if $^O =~ /^uwin/;
28*0Sstevel@tonic-gate    $d;
29*0Sstevel@tonic-gate}
30*0Sstevel@tonic-gate
31*0Sstevel@tonic-gatemy $Cwd = abs_path;
32*0Sstevel@tonic-gate
33*0Sstevel@tonic-gate# Let's get to a known position
34*0Sstevel@tonic-gateSKIP: {
35*0Sstevel@tonic-gate    my ($vol,$dir) = splitpath(abs_path,1);
36*0Sstevel@tonic-gate    my $test_dir = $IsVMS ? 'T' : 't';
37*0Sstevel@tonic-gate    skip("Already in t/", 2) if (splitdir($dir))[-1] eq $test_dir;
38*0Sstevel@tonic-gate
39*0Sstevel@tonic-gate    ok( chdir($test_dir),     'chdir($test_dir)');
40*0Sstevel@tonic-gate    is( abs_path, catdir($Cwd, $test_dir),    '  abs_path() agrees' );
41*0Sstevel@tonic-gate}
42*0Sstevel@tonic-gate
43*0Sstevel@tonic-gate$Cwd = abs_path;
44*0Sstevel@tonic-gate
45*0Sstevel@tonic-gate# The environment variables chdir() pays attention to.
46*0Sstevel@tonic-gatemy @magic_envs = qw(HOME LOGDIR SYS$LOGIN);
47*0Sstevel@tonic-gate
48*0Sstevel@tonic-gatesub check_env {
49*0Sstevel@tonic-gate    my($key) = @_;
50*0Sstevel@tonic-gate
51*0Sstevel@tonic-gate    # Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
52*0Sstevel@tonic-gate    if( $key eq 'SYS$LOGIN' && !$IsVMS && !$IsMacOS ) {
53*0Sstevel@tonic-gate        ok( !chdir(),         "chdir() on $^O ignores only \$ENV{$key} set" );
54*0Sstevel@tonic-gate        is( abs_path, $Cwd,   '  abs_path() did not change' );
55*0Sstevel@tonic-gate        pass( "  no need to test SYS\$LOGIN on $^O" ) for 1..7;
56*0Sstevel@tonic-gate    }
57*0Sstevel@tonic-gate    else {
58*0Sstevel@tonic-gate        ok( chdir(),              "chdir() w/ only \$ENV{$key} set" );
59*0Sstevel@tonic-gate        is( abs_path, $ENV{$key}, '  abs_path() agrees' );
60*0Sstevel@tonic-gate        chdir($Cwd);
61*0Sstevel@tonic-gate        is( abs_path, $Cwd,       '  and back again' );
62*0Sstevel@tonic-gate
63*0Sstevel@tonic-gate        my $warning = '';
64*0Sstevel@tonic-gate        local $SIG{__WARN__} = sub { $warning .= join '', @_ };
65*0Sstevel@tonic-gate
66*0Sstevel@tonic-gate
67*0Sstevel@tonic-gate        # Check the deprecated chdir(undef) feature.
68*0Sstevel@tonic-gate#line 64
69*0Sstevel@tonic-gate        ok( chdir(undef),           "chdir(undef) w/ only \$ENV{$key} set" );
70*0Sstevel@tonic-gate        is( abs_path, $ENV{$key},   '  abs_path() agrees' );
71*0Sstevel@tonic-gate        is( $warning,  <<WARNING,   '  got uninit & deprecation warning' );
72*0Sstevel@tonic-gateUse of uninitialized value in chdir at $0 line 64.
73*0Sstevel@tonic-gateUse of chdir('') or chdir(undef) as chdir() is deprecated at $0 line 64.
74*0Sstevel@tonic-gateWARNING
75*0Sstevel@tonic-gate
76*0Sstevel@tonic-gate        chdir($Cwd);
77*0Sstevel@tonic-gate
78*0Sstevel@tonic-gate        # Ditto chdir('').
79*0Sstevel@tonic-gate        $warning = '';
80*0Sstevel@tonic-gate#line 76
81*0Sstevel@tonic-gate        ok( chdir(''),              "chdir('') w/ only \$ENV{$key} set" );
82*0Sstevel@tonic-gate        is( abs_path, $ENV{$key},   '  abs_path() agrees' );
83*0Sstevel@tonic-gate        is( $warning,  <<WARNING,   '  got deprecation warning' );
84*0Sstevel@tonic-gateUse of chdir('') or chdir(undef) as chdir() is deprecated at $0 line 76.
85*0Sstevel@tonic-gateWARNING
86*0Sstevel@tonic-gate
87*0Sstevel@tonic-gate        chdir($Cwd);
88*0Sstevel@tonic-gate    }
89*0Sstevel@tonic-gate}
90*0Sstevel@tonic-gate
91*0Sstevel@tonic-gatemy %Saved_Env = ();
92*0Sstevel@tonic-gatesub clean_env {
93*0Sstevel@tonic-gate    foreach my $env (@magic_envs) {
94*0Sstevel@tonic-gate        $Saved_Env{$env} = $ENV{$env};
95*0Sstevel@tonic-gate
96*0Sstevel@tonic-gate        # Can't actually delete SYS$ stuff on VMS.
97*0Sstevel@tonic-gate        next if $IsVMS && $env eq 'SYS$LOGIN';
98*0Sstevel@tonic-gate        next if $IsVMS && $env eq 'HOME' && !$Config{'d_setenv'};
99*0Sstevel@tonic-gate
100*0Sstevel@tonic-gate        unless ($IsMacOS) { # ENV on MacOS is "special" :-)
101*0Sstevel@tonic-gate            # On VMS, %ENV is many layered.
102*0Sstevel@tonic-gate            delete $ENV{$env} while exists $ENV{$env};
103*0Sstevel@tonic-gate        }
104*0Sstevel@tonic-gate    }
105*0Sstevel@tonic-gate
106*0Sstevel@tonic-gate    # The following means we won't really be testing for non-existence,
107*0Sstevel@tonic-gate    # but in Perl we can only delete from the process table, not the job
108*0Sstevel@tonic-gate    # table.
109*0Sstevel@tonic-gate    $ENV{'SYS$LOGIN'} = '' if $IsVMS;
110*0Sstevel@tonic-gate}
111*0Sstevel@tonic-gate
112*0Sstevel@tonic-gateEND {
113*0Sstevel@tonic-gate    no warnings 'uninitialized';
114*0Sstevel@tonic-gate
115*0Sstevel@tonic-gate    # Restore the environment for VMS (and doesn't hurt for anyone else)
116*0Sstevel@tonic-gate    @ENV{@magic_envs} = @Saved_Env{@magic_envs};
117*0Sstevel@tonic-gate}
118*0Sstevel@tonic-gate
119*0Sstevel@tonic-gate
120*0Sstevel@tonic-gateforeach my $key (@magic_envs) {
121*0Sstevel@tonic-gate    # We're going to be using undefs a lot here.
122*0Sstevel@tonic-gate    no warnings 'uninitialized';
123*0Sstevel@tonic-gate
124*0Sstevel@tonic-gate    clean_env;
125*0Sstevel@tonic-gate    $ENV{$key} = catdir $Cwd, ($IsVMS ? 'OP' : 'op');
126*0Sstevel@tonic-gate
127*0Sstevel@tonic-gate    check_env($key);
128*0Sstevel@tonic-gate}
129*0Sstevel@tonic-gate
130*0Sstevel@tonic-gate{
131*0Sstevel@tonic-gate    clean_env;
132*0Sstevel@tonic-gate    if (($IsVMS || $IsMacOS) && !$Config{'d_setenv'}) {
133*0Sstevel@tonic-gate        pass("Can't reset HOME, so chdir() test meaningless");
134*0Sstevel@tonic-gate    } else {
135*0Sstevel@tonic-gate        ok( !chdir(),                   'chdir() w/o any ENV set' );
136*0Sstevel@tonic-gate    }
137*0Sstevel@tonic-gate    is( abs_path, $Cwd,             '  abs_path() agrees' );
138*0Sstevel@tonic-gate}
139