Small optimisations, by Brandon Black
[p5sagit/p5-mst-13.2.git] / t / op / filetest.t
1 #!./perl
2
3 # There are few filetest operators that are portable enough to test.
4 # See pod/perlport.pod for details.
5
6 BEGIN {
7     chdir 't' if -d 't';
8     @INC = '../lib';
9     require './test.pl';
10 }
11
12 use Config;
13 plan(tests => 24);
14
15 ok( -d 'op' );
16 ok( -f 'TEST' );
17 ok( !-f 'op' );
18 ok( !-d 'TEST' );
19 ok( -r 'TEST' );
20
21 # make sure TEST is r-x
22 eval { chmod 0555, 'TEST' or die "chmod 0555, 'TEST' failed: $!" };
23 chomp ($bad_chmod = $@);
24
25 $oldeuid = $>;          # root can read and write anything
26 eval '$> = 1';          # so switch uid (may not be implemented)
27
28 print "# oldeuid = $oldeuid, euid = $>\n";
29
30 SKIP: {
31     if (!$Config{d_seteuid}) {
32         skip('no seteuid');
33     } 
34     elsif ($Config{config_args} =~/Dmksymlinks/) {
35         skip('we cannot chmod symlinks');
36     }
37     elsif ($bad_chmod) {
38         skip( $bad_chmod );
39     }
40     else {
41         ok( !-w 'TEST' );
42     }
43 }
44
45 # Scripts are not -x everywhere so cannot test that.
46
47 eval '$> = $oldeuid';   # switch uid back (may not be implemented)
48
49 # this would fail for the euid 1
50 # (unless we have unpacked the source code as uid 1...)
51 ok( -r 'op' );
52
53 # this would fail for the euid 1
54 # (unless we have unpacked the source code as uid 1...)
55 SKIP: {
56     if ($Config{d_seteuid}) {
57         ok( -w 'op' );
58     } else {
59         skip('no seteuid');
60     }
61 }
62
63 ok( -x 'op' ); # Hohum.  Are directories -x everywhere?
64
65 is( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" );
66
67 # Test stackability of filetest operators
68
69 ok( defined( -f -d 'TEST' ) && ! -f -d _ );
70 ok( !defined( -e 'zoo' ) );
71 ok( !defined( -e -d 'zoo' ) );
72 ok( !defined( -f -e 'zoo' ) );
73 ok( -f -e 'TEST' );
74 ok( -e -f 'TEST' );
75 ok( defined(-d -e 'TEST') );
76 ok( defined(-e -d 'TEST') );
77 ok( ! -f -d 'op' );
78 ok( -x -d -x 'op' );
79 ok( (-s -f 'TEST' > 1), "-s returns real size" );
80 ok( -f -s 'TEST' == 1 );
81
82 # test that _ is a bareword after filetest operators
83
84 -f 'TEST';
85 ok( -f _ );
86 sub _ { "this is not a file name" }
87 ok( -f _ );