t/op/defins.t

   1 #!./perl -w
   2
   3 #
   4 # test auto defined() test insertion
   5 #
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = qw(. ../lib);
  10     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
  11 }
  12 require './test.pl';
  13 plan( tests => 27 );
  14
  15 my $unix_mode = 1;
  16
  17 if ($^O eq 'VMS') {
  18     # We have to know if VMS is in UNIX mode.  In UNIX mode, trailing dots
  19     # should not be present.  There are actually two settings that control this.
  20
  21     $unix_mode = 0;
  22     my $unix_rpt = 0;
  23     my $drop_dot = 0;
  24     if (eval 'require VMS::Feature') {
  25         $unix_rpt = VMS::Feature::current('filename_unix_report');
  26         $drop_dot = VMS::Feature::current('readdir_dropdotnotype');
  27     } else {
  28         my $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
  29         $unix_rpt = $unix_report =~ /^[ET1]/i;
  30         my $drop_dot_notype = $ENV{'DECC$READDIR_DROPDOTNOTYPE'} || '';
  31         $drop_dot = $drop_dot_notype =~ /^[ET1]/i;
  32     }
  33     $unix_mode = 1 if $drop_dot && unix_rpt;
  34 }
  35
  36 # $wanted_filename should be 0 for readdir() and glob() tests.
  37 # This is because it is the only valid filename that is false in a boolean test.
  38
  39 # $filename = '0';
  40 # print "hi\n" if $filename; # doesn't print
  41
  42 # In the case of VMS, '0' isn't always the filename that you get.
  43 # Which makes those particular tests pointless.
  44
  45 $wanted_filename = $unix_mode ? '0' : '0.';
  46 $saved_filename = './0';
  47
  48 cmp_ok($warns,'==',0,'no warns at start');
  49
  50 ok(open(FILE,">$saved_filename"),'created work file');
  51 print FILE "0\n";
  52 print FILE "1\n";
  53 close(FILE);
  54
  55 open(FILE,"<$saved_filename");
  56 ok(defined(FILE),'opened work file');
  57 my $seen = 0;
  58 my $dummy;
  59 while (my $name = <FILE>)
  60  {
  61   chomp($name);
  62   $seen++ if $name eq '0';
  63  }
  64 cmp_ok($seen,'==',1,'seen in while()');
  65
  66 seek(FILE,0,0);
  67 $seen = 0;
  68 my $line = '';
  69 do
  70  {
  71   chomp($line);
  72   $seen++ if $line eq '0';
  73  } while ($line = <FILE>);
  74 cmp_ok($seen,'==',1,'seen in do/while');
  75
  76 seek(FILE,0,0);
  77 $seen = 0;
  78 while (($seen ? $dummy : $name) = <FILE> )
  79  {
  80   chomp($name);
  81   $seen++ if $name eq '0';
  82  }
  83 cmp_ok($seen,'==',2,'seen in while() ternary');
  84
  85 seek(FILE,0,0);
  86 $seen = 0;
  87 my %where;
  88 while ($where{$seen} = <FILE>)
  89  {
  90   chomp($where{$seen});
  91   $seen++ if $where{$seen} eq '0';
  92  }
  93 cmp_ok($seen,'==',1,'seen in hash while()');
  94 close FILE;
  95
  96 opendir(DIR,'.');
  97 ok(defined(DIR),'opened current directory');
  98 $seen = 0;
  99 while (my $name = readdir(DIR))
 100  {
 101   $seen++ if $name eq $wanted_filename;
 102  }
 103 cmp_ok($seen,'==',1,'saw work file once');
 104
 105 rewinddir(DIR);
 106 $seen = 0;
 107 $dummy = '';
 108 while (($seen ? $dummy : $name) = readdir(DIR))
 109  {
 110   $seen++ if $name eq $wanted_filename;
 111  }
 112 cmp_ok($seen,'>',0,'saw file in while() ternary');
 113
 114 rewinddir(DIR);
 115 $seen = 0;
 116 while ($where{$seen} = readdir(DIR))
 117  {
 118   $seen++ if $where{$seen} eq $wanted_filename;
 119  }
 120 cmp_ok($seen,'==',1,'saw file in hash while()');
 121
 122 rewinddir(DIR);
 123 $seen = 0;
 124 $_ = 'not 0';
 125 while (readdir(DIR))
 126  {
 127   $seen++ if $_ eq $wanted_filename;
 128  }
 129 cmp_ok($seen,'==',1,'saw file in bare while(readdir){...}');
 130
 131 rewinddir(DIR);
 132 $seen = 0;
 133 $_ = 'not 0';
 134
 135 $_ eq $wanted_filename && $seen++ while readdir(DIR);
 136 cmp_ok($seen,'==',1,'saw file in bare "... while readdir"');
 137
 138 rewinddir(DIR);
 139 $seen = 0;
 140 $_ = "";  # suppress uninit warning
 141 do
 142  {
 143   $seen++ if $_ eq $wanted_filename;
 144  } while (readdir(DIR));
 145 cmp_ok($seen,'==',1,'saw file in bare do{...}while(readdir)');
 146
 147 $seen = 0;
 148 while (my $name = glob('*'))
 149  {
 150   $seen++ if $name eq $wanted_filename;
 151  }
 152 cmp_ok($seen,'==',1,'saw file in glob while()');
 153
 154 $seen = 0;
 155 $dummy = '';
 156 while (($seen ? $dummy : $name) = glob('*'))
 157  {
 158   $seen++ if $name eq $wanted_filename;
 159  }
 160 cmp_ok($seen,'>',0,'saw file in glob hash while() ternary');
 161
 162 $seen = 0;
 163 while ($where{$seen} = glob('*'))
 164  {
 165   $seen++ if $where{$seen} eq $wanted_filename;
 166  }
 167 cmp_ok($seen,'==',1,'seen in glob hash while()');
 168
 169 unlink($saved_filename);
 170 ok(!(-f $saved_filename),'work file unlinked');
 171
 172 my %hash = (0 => 1, 1 => 2);
 173 my @array = 1;
 174 my $neg_sum= 0;
 175
 176 $seen = 0;
 177
 178 while (my $name = each %hash)
 179  {
 180   $neg_sum = $name - $neg_sum;
 181   $seen++ if $name eq '0';
 182  }
 183 cmp_ok(abs($neg_sum),'==',1,'abs(neg_sum) should equal 1');
 184 cmp_ok($seen,'==',1,'seen in each');
 185
 186 $seen = 0;
 187 $dummy = '';
 188 while (($seen ? $dummy : $name) = each %hash)
 189  {
 190   $seen++ if $name eq '0';
 191  }
 192 cmp_ok($seen,'==',$neg_sum < 0 ? 1 : 2,'seen in each ternary');
 193
 194 $seen = 0;
 195 while ($where{$seen} = each %hash)
 196  {
 197   $seen++ if $where{$seen} eq '0';
 198  }
 199 cmp_ok($seen,'==',1,'seen in each hash');
 200
 201 $seen = 0;
 202 undef $_;
 203 while (each %hash)
 204  {
 205   $seen++ if $_ eq '0';
 206  }
 207 cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash)');
 208
 209 $seen = 0;
 210 undef $_;
 211 while (each @array)
 212  {
 213   $seen++ if $_ eq '0';
 214  }
 215 cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array)');
 216
 217 $seen = 0;
 218 undef $_;
 219 $_ eq '0' and $seen++ while each %hash;
 220 cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash) as stm mod');
 221
 222 $seen = 0;
 223 undef $_;
 224 $_ eq '0' and $seen++ while each @array;
 225 cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array) as stm mod');
 226
 227 cmp_ok($warns,'==',0,'no warns at finish');