t/pmc/file.t

   1 #! perl
   2 # Copyright (C) 2001-2006, Parrot 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 => 9;
  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_dir
  79 pir_error_output_like( <<"CODE", <<"OUT", "Test is_dir error" );
  80 .sub main :main
  81         \$P1 = new ['File']
  82
  83         #make a filename that's long enough to cause lstat to fail
  84         \$I0 = 1000
  85 loop:
  86         \$S0 = concat \$S0, "1234567890"
  87         \$I0 = \$I0 - 1
  88         if \$I0 goto loop
  89
  90         \$I1 = \$P1."is_dir"(\$S0)
  91
  92         end
  93 .end
  94 CODE
  95 /^[\\w \t\r\n]+current instr\.:/
  96 OUT
  97
  98 # test is_file
  99 pir_output_is( <<"CODE", <<"OUT", "Test is_file" );
 100 .sub main :main
 101         \$P1 = new ['File']
 102
 103         \$S1 = '$xpto'
 104         \$I1 = \$P1."is_file"(\$S1)
 105         \$I1 = !\$I1
 106
 107         if \$I1 goto ok1
 108         print "not "
 109
 110 ok1:
 111         print "ok 1\\n"
 112
 113         \$S1 = '$otpx'
 114         \$I1 = \$P1."is_file"(\$S1)
 115
 116         if \$I1 goto ok2
 117         print "not "
 118
 119 ok2:
 120         print "ok 2\\n"
 121
 122         end
 123 .end
 124 CODE
 125 ok 1
 126 ok 2
 127 OUT
 128
 129 # test is_file
 130 pir_error_output_like( <<"CODE", <<"OUT", "Test is_file error" );
 131 .sub main :main
 132         \$P1 = new ['File']
 133
 134         #make a filename that's long enough to cause lstat to fail
 135         \$I0 = 1000
 136 loop:
 137         \$S0 = concat \$S0, "1234567890"
 138         \$I0 = \$I0 - 1
 139         if \$I0 goto loop
 140
 141         \$I1 = \$P1."is_file"(\$S0)
 142
 143         end
 144 .end
 145 CODE
 146 /^[\\w \t\r\n]+current instr\.:/
 147 OUT
 148
 149 SKIP: {
 150     skip "Links not available under Windows", 1 if $MSWin32;
 151
 152     my $lotpx = catfile( $xpto, 'lotpx' );
 153     symlink $otpx, $lotpx;
 154
 155     # test is_link
 156     pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to files" );
 157 .sub main :main
 158         \$P1 = new ['File']
 159
 160         \$S1 = '$lotpx'
 161         \$I1 = \$P1."is_link"(\$S1)
 162
 163         if \$I1 goto ok1
 164         print "not "
 165 ok1:
 166         print "ok 1\\n"
 167
 168         \$S1 = '$otpx'
 169         \$I1 = \$P1."is_link"(\$S1)
 170         \$I1 = !\$I1
 171         if \$I1 goto ok2
 172         print "not "
 173 ok2:
 174         print "ok 2\\n"
 175         end
 176 .end
 177 CODE
 178 ok 1
 179 ok 2
 180 OUT
 181
 182 }
 183
 184 SKIP: {
 185     skip "Links not available under Windows", 1 if $MSWin32;
 186
 187     my $xptol = catdir( $xpto, 'xptol' );
 188     symlink $xpto, $xptol;
 189
 190     # test is_link
 191     pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to directories" );
 192 .sub main :main
 193         \$P1 = new ['File']
 194
 195         \$S1 = '$xptol'
 196         \$I1 = \$P1."is_link"(\$S1)
 197
 198         if \$I1 goto ok1
 199         print "not "
 200 ok1:
 201         print "ok 1\\n"
 202
 203         \$S1 = '$xpto'
 204         \$I1 = \$P1."is_link"(\$S1)
 205         \$I1 = !\$I1
 206         if \$I1 goto ok2
 207         print "not "
 208 ok2:
 209         print "ok 2\\n"
 210         end
 211 .end
 212 CODE
 213 ok 1
 214 ok 2
 215 OUT
 216 }
 217
 218 my $otpxcopy = catdir( $xpto, 'otpxcopy' );
 219
 220 # test copy
 221 pir_output_is( <<"CODE", <<"OUT", "Test copy for files" );
 222 .sub main :main
 223        \$S1 = '$otpx'
 224        \$S2 = '$otpxcopy'
 225
 226        \$P1 = new ['File']
 227        \$P2 = new ['OS']
 228
 229        \$P1."copy"(\$S1,\$S2)
 230        print "ok\\n"
 231
 232        \$P3 = \$P2."stat"(\$S1)
 233        \$P4 = \$P2."stat"(\$S2)
 234
 235        \$I1 = \$P3[7]
 236        \$I2 = \$P4[7]
 237
 238        if \$I1 == \$I2 goto ok
 239        print "not "
 240 ok:
 241        print "ok\\n"
 242
 243        end
 244 .end
 245 CODE
 246 ok
 247 ok
 248 OUT
 249
 250 # test rename
 251 SKIP: {
 252     skip 'file exists', 1 if $MSWin32;
 253
 254     pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
 255 .sub main :main
 256        \$S1 = '$otpx'
 257        \$S2 = '$otpxcopy'
 258
 259        \$P1 = new ['File']
 260        \$P2 = new ['OS']
 261
 262        \$P3 = \$P2."stat"(\$S1)
 263        \$I1 = \$P3[7]
 264
 265        \$P1."rename"(\$S1,\$S2)
 266        print "ok\\n"
 267
 268        \$P4 = \$P2."stat"(\$S2)
 269        \$I2 = \$P4[7]
 270
 271        if \$I1 == \$I2 goto ok
 272        print "not "
 273 ok:
 274        print "ok\\n"
 275
 276        end
 277 .end
 278 CODE
 279 ok
 280 ok
 281 OUT
 282 }
 283
 284 my $bad_file = catfile( $xpto, 'not a file' );
 285
 286 # test exists
 287 pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
 288 .sub main :main
 289        \$P1 = new ['File']
 290        \$I1 = \$P1.'exists'( '$otpxcopy' )
 291
 292        if \$I1 goto file_exists
 293        print "not "
 294
 295   file_exists:
 296        print "ok 1 - file exists\\n"
 297
 298        \$I1 = \$P1.'exists'( '$xpto' )
 299
 300        if \$I1 goto dir_exists
 301        print "not "
 302
 303   dir_exists:
 304        print "ok 2 - directory exists\\n"
 305
 306        \$I1 = \$P1.'exists'( '$bad_file' )
 307
 308        if \$I1 == 0 goto file_does_not_exist
 309        print "not "
 310
 311   file_does_not_exist:
 312        print "ok 3 - file does not exist\\n"
 313
 314        end
 315 .end
 316 CODE
 317 ok 1 - file exists
 318 ok 2 - directory exists
 319 ok 3 - file does not exist
 320 OUT
 321
 322 # Local Variables:
 323 #   mode: cperl
 324 #   cperl-indent-level: 4
 325 #   fill-column: 100
 326 # End:
 327 # vim: expandtab shiftwidth=4: