t/pmc/file.t

   1 #! perl
   2 # Copyright (C) 2001-2006, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test tests => 7;
  11
  12 use Parrot::Config;
  13
  14 use Cwd;
  15 use File::Temp;
  16 use File::Spec::Functions;
  17
  18 my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
  19
  20 our ( $MSWin32, $cygwin );
  21 $MSWin32 = 1 if $^O =~ m!MSWin32!;
  22 $cygwin  = 1 if $^O =~ m!cygwin!;
  23
  24 =head1 NAME
  25
  26 t/pmc/file.t - Files functions
  27
  28 =head1 SYNOPSIS
  29
  30     % prove t/pmc/file.t
  31
  32 =head1 DESCRIPTION
  33
  34 Tests the C<File> PMC.
  35
  36 =cut
  37
  38 my $xpto = catdir( $tempdir, 'xpto' );
  39 mkdir $xpto unless -d $xpto;
  40
  41 my $otpx = catfile( $xpto, 'otpx' );
  42
  43 open my $fh, '>', $otpx or die $!;
  44 print $fh 'xpto';
  45 close $fh;
  46
  47 # test is_dir
  48 pir_output_is( <<"CODE", <<"OUT", "Test is_dir" );
  49 .sub main :main
  50         \$P1 = new 'File'
  51
  52         \$S1 = '$xpto'
  53         \$I1 = \$P1."is_dir"(\$S1)
  54
  55         if \$I1 goto ok1
  56         print "not "
  57
  58 ok1:
  59         print "ok 1\\n"
  60
  61         \$S1 = '$otpx'
  62         \$I1 = \$P1."is_dir"(\$S1)
  63         \$I1 = !\$I1
  64
  65         if \$I1 goto ok2
  66         print "not "
  67
  68 ok2:
  69         print "ok 2\\n"
  70
  71         end
  72 .end
  73 CODE
  74 ok 1
  75 ok 2
  76 OUT
  77
  78 # test is_file
  79 pir_output_is( <<"CODE", <<"OUT", "Test is_file" );
  80 .sub main :main
  81         \$P1 = new 'File'
  82
  83         \$S1 = '$xpto'
  84         \$I1 = \$P1."is_file"(\$S1)
  85         \$I1 = !\$I1
  86
  87         if \$I1 goto ok1
  88         print "not "
  89
  90 ok1:
  91         print "ok 1\\n"
  92
  93         \$S1 = '$otpx'
  94         \$I1 = \$P1."is_file"(\$S1)
  95
  96         if \$I1 goto ok2
  97         print "not "
  98
  99 ok2:
 100         print "ok 2\\n"
 101
 102         end
 103 .end
 104 CODE
 105 ok 1
 106 ok 2
 107 OUT
 108
 109 SKIP: {
 110     skip "Links not available under Windows", 1 if $MSWin32;
 111
 112     my $lotpx = catfile( $xpto, 'lotpx' );
 113     symlink $otpx, $lotpx;
 114
 115     # test is_link
 116     pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to files" );
 117 .sub main :main
 118         \$P1 = new 'File'
 119
 120         \$S1 = '$lotpx'
 121         \$I1 = \$P1."is_link"(\$S1)
 122
 123         if \$I1 goto ok1
 124         print "not "
 125 ok1:
 126         print "ok 1\\n"
 127
 128         \$S1 = '$otpx'
 129         \$I1 = \$P1."is_link"(\$S1)
 130         \$I1 = !\$I1
 131         if \$I1 goto ok2
 132         print "not "
 133 ok2:
 134         print "ok 2\\n"
 135         end
 136 .end
 137 CODE
 138 ok 1
 139 ok 2
 140 OUT
 141
 142 }
 143
 144 SKIP: {
 145     skip "Links not available under Windows", 1 if $MSWin32;
 146
 147     my $xptol = catdir( $xpto, 'xptol' );
 148     symlink $xpto, $xptol;
 149
 150     # test is_link
 151     pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to directories" );
 152 .sub main :main
 153         \$P1 = new 'File'
 154
 155         \$S1 = '$xptol'
 156         \$I1 = \$P1."is_link"(\$S1)
 157
 158         if \$I1 goto ok1
 159         print "not "
 160 ok1:
 161         print "ok 1\\n"
 162
 163         \$S1 = '$xpto'
 164         \$I1 = \$P1."is_link"(\$S1)
 165         \$I1 = !\$I1
 166         if \$I1 goto ok2
 167         print "not "
 168 ok2:
 169         print "ok 2\\n"
 170         end
 171 .end
 172 CODE
 173 ok 1
 174 ok 2
 175 OUT
 176 }
 177
 178 my $otpxcopy = catdir( $xpto, 'otpxcopy' );
 179
 180 # test copy
 181 pir_output_is( <<"CODE", <<"OUT", "Test copy for files" );
 182 .sub main :main
 183        \$S1 = '$otpx'
 184        \$S2 = '$otpxcopy'
 185
 186        \$P1 = new 'File'
 187        \$P2 = new 'OS'
 188
 189        \$P1."copy"(\$S1,\$S2)
 190        print "ok\\n"
 191
 192        \$P3 = \$P2."stat"(\$S1)
 193        \$P4 = \$P2."stat"(\$S2)
 194
 195        \$I1 = \$P3[7]
 196        \$I2 = \$P4[7]
 197
 198        if \$I1 == \$I2 goto ok
 199        print "not "
 200 ok:
 201        print "ok\\n"
 202
 203        end
 204 .end
 205 CODE
 206 ok
 207 ok
 208 OUT
 209
 210 # test rename
 211 SKIP: {
 212     skip 'file exists', 1 if $MSWin32;
 213
 214     pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
 215 .sub main :main
 216        \$S1 = '$otpx'
 217        \$S2 = '$otpxcopy'
 218
 219        \$P1 = new 'File'
 220        \$P2 = new 'OS'
 221
 222        \$P3 = \$P2."stat"(\$S1)
 223        \$I1 = \$P3[7]
 224
 225        \$P1."rename"(\$S1,\$S2)
 226        print "ok\\n"
 227
 228        \$P4 = \$P2."stat"(\$S2)
 229        \$I2 = \$P4[7]
 230
 231        if \$I1 == \$I2 goto ok
 232        print "not "
 233 ok:
 234        print "ok\\n"
 235
 236        end
 237 .end
 238 CODE
 239 ok
 240 ok
 241 OUT
 242 }
 243
 244 my $bad_file = catfile( $xpto, 'not a file' );
 245
 246 # test exists
 247 pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
 248 .sub main :main
 249        \$P1 = new 'File'
 250        \$I1 = \$P1.'exists'( '$otpxcopy' )
 251
 252        if \$I1 goto file_exists
 253        print "not "
 254
 255   file_exists:
 256        print "ok 1 - file exists\\n"
 257
 258        \$I1 = \$P1.'exists'( '$xpto' )
 259
 260        if \$I1 goto dir_exists
 261        print "not "
 262
 263   dir_exists:
 264        print "ok 2 - directory exists\\n"
 265
 266        \$I1 = \$P1.'exists'( '$bad_file' )
 267
 268        if \$I1 == 0 goto file_does_not_exist
 269        print "not "
 270
 271   file_does_not_exist:
 272        print "ok 3 - file does not exist\\n"
 273
 274        end
 275 .end
 276 CODE
 277 ok 1 - file exists
 278 ok 2 - directory exists
 279 ok 3 - file does not exist
 280 OUT
 281
 282 # Local Variables:
 283 #   mode: cperl
 284 #   cperl-indent-level: 4
 285 #   fill-column: 100
 286 # End:
 287 # vim: expandtab shiftwidth=4: