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