t/op/glob.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(. ../lib);
   6 }
   7
   8 require 'test.pl';
   9 plan( tests => 15 );
  10
  11 @oops = @ops = <op/*>;
  12
  13 if ($^O eq 'MSWin32') {
  14   map { $files{lc($_)}++ } <op/*>;
  15   map { delete $files{"op/$_"} } split /[\s\n]/, `dir /b /l op & dir /b /l /ah op 2>nul`,
  16 }
  17 elsif ($^O eq 'VMS') {
  18   map { $files{lc($_)}++ } <[.op]*>;
  19   map { s/;.*$//; delete $files{lc($_)}; } split /[\n]/, `directory/noheading/notrailing/versions=1 [.op]`,
  20 }
  21 elsif ($^O eq 'MacOS') {
  22   @oops = @ops = <:op:*>;
  23   map { $files{$_}++ } <:op:*>;
  24   map { delete $files{$_} } split /[\s\n]/, `echo :op:\xc5`;
  25 }
  26 else {
  27   map { $files{$_}++ } <op/*>;
  28   map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
  29 }
  30 ok( !(keys(%files)),'leftover op/* files' ) or diag(join(' ',sort keys %files));
  31
  32 cmp_ok($/,'eq',"\n",'sane input record separator');
  33
  34 $not = '';
  35 if ($^O eq 'MacOS') {
  36     while (<jskdfjskdfj* :op:* jskdjfjkosvk*>) {
  37         $not = "not " unless $_ eq shift @ops;
  38         $not = "not at all " if $/ eq "\0";
  39     }
  40 } else {
  41     while (<jskdfjskdfj* op/* jskdjfjkosvk*>) {
  42         $not = "not " unless $_ eq shift @ops;
  43         $not = "not at all " if $/ eq "\0";
  44     }
  45 }
  46 ok(!$not,"glob amid garbage [$not]");
  47
  48 cmp_ok($/,'eq',"\n",'input record separator still sane');
  49
  50 $_ = $^O eq 'MacOS' ? ":op:*" : "op/*";
  51 @glops = glob $_;
  52 cmp_ok("@glops",'eq',"@oops",'glob operator 1');
  53
  54 @glops = glob;
  55 cmp_ok("@glops",'eq',"@oops",'glob operator 2');
  56
  57 # glob should still work even after the File::Glob stash has gone away
  58 # (this used to dump core)
  59 my $i = 0;
  60 for (1..2) {
  61     eval "<.>";
  62     ok(!length($@),"eval'ed a glob $_");
  63     undef %File::Glob::;
  64     ++$i;
  65 }
  66 cmp_ok($i,'==',2,'remore File::Glob stash');
  67
  68 # ... while ($var = glob(...)) should test definedness not truth
  69
  70 SKIP: {
  71     skip('no File::Glob to emulate Unix-ism', 1)
  72         unless $INC{'File/Glob.pm'};
  73     my $ok = 0;
  74     $ok = 1 while my $var = glob("0");
  75     ok($ok,'define versus truth');
  76 }
  77
  78 # The formerly-broken test for the situation above would accidentally
  79 # test definedness for an assignment with a LOGOP on the right:
  80 {
  81     my $f = 0;
  82     my $ok = 1;
  83     $ok = 0, undef $f while $x = $f||$f;
  84     ok($ok,'test definedness with LOGOP');
  85 }
  86
  87 cmp_ok(scalar(@oops),'>',0,'glob globbed something');
  88
  89 *aieee = 4;
  90 pass('Can assign integers to typeglobs');
  91 *aieee = 3.14;
  92 pass('Can assign floats to typeglobs');
  93 *aieee = 'pi';
  94 pass('Can assign strings to typeglobs');