Commit | Line | Data |
---|---|---|
55d729e4 GS |
1 | #!./perl -w |
2 | ||
3 | # | |
4 | # test auto defined() test insertion | |
5 | # | |
6 | ||
7 | BEGIN { | |
8 | chdir 't' if -d 't'; | |
7e35a6a8 | 9 | @INC = qw(. ../lib); |
55d729e4 | 10 | $SIG{__WARN__} = sub { $warns++; warn $_[0] }; |
55d729e4 | 11 | } |
7e35a6a8 DL |
12 | require 'test.pl'; |
13 | plan( tests => 19 ); | |
b2b3adea | 14 | |
6d74d930 JM |
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 = $unix_mode ? '0' : '0.'; | |
7b903762 | 37 | $saved_filename = './0'; |
7e35a6a8 DL |
38 | |
39 | cmp_ok($warns,'==',0,'no warns at start'); | |
55d729e4 | 40 | |
95e8664e | 41 | open(FILE,">$saved_filename"); |
7e35a6a8 | 42 | ok(defined(FILE),'created work file'); |
55d729e4 GS |
43 | print FILE "1\n"; |
44 | print FILE "0"; | |
45 | close(FILE); | |
46 | ||
95e8664e | 47 | open(FILE,"<$saved_filename"); |
7e35a6a8 | 48 | ok(defined(FILE),'opened work file'); |
55d729e4 GS |
49 | my $seen = 0; |
50 | my $dummy; | |
51 | while (my $name = <FILE>) | |
52 | { | |
53 | $seen++ if $name eq '0'; | |
7e35a6a8 DL |
54 | } |
55 | cmp_ok($seen,'==',1,'seen in while()'); | |
55d729e4 GS |
56 | |
57 | seek(FILE,0,0); | |
58 | $seen = 0; | |
59 | my $line = ''; | |
7e35a6a8 | 60 | do |
55d729e4 GS |
61 | { |
62 | $seen++ if $line eq '0'; | |
63 | } while ($line = <FILE>); | |
7e35a6a8 | 64 | cmp_ok($seen,'==',1,'seen in do/while'); |
55d729e4 GS |
65 | |
66 | seek(FILE,0,0); | |
7e35a6a8 DL |
67 | $seen = 0; |
68 | while (($seen ? $dummy : $name) = <FILE> ) | |
55d729e4 GS |
69 | { |
70 | $seen++ if $name eq '0'; | |
71 | } | |
7e35a6a8 | 72 | cmp_ok($seen,'==',1,'seen in while() ternary'); |
55d729e4 GS |
73 | |
74 | seek(FILE,0,0); | |
7e35a6a8 DL |
75 | $seen = 0; |
76 | my %where; | |
55d729e4 GS |
77 | while ($where{$seen} = <FILE>) |
78 | { | |
79 | $seen++ if $where{$seen} eq '0'; | |
80 | } | |
7e35a6a8 | 81 | cmp_ok($seen,'==',1,'seen in hash while()'); |
7120fed6 | 82 | close FILE; |
55d729e4 | 83 | |
7b903762 | 84 | opendir(DIR,'.'); |
7e35a6a8 | 85 | ok(defined(DIR),'opened current directory'); |
55d729e4 GS |
86 | $seen = 0; |
87 | while (my $name = readdir(DIR)) | |
88 | { | |
b2b3adea | 89 | $seen++ if $name eq $wanted_filename; |
7e35a6a8 DL |
90 | } |
91 | cmp_ok($seen,'==',1,'saw work file once'); | |
55d729e4 GS |
92 | |
93 | rewinddir(DIR); | |
7e35a6a8 | 94 | $seen = 0; |
55d729e4 GS |
95 | $dummy = ''; |
96 | while (($seen ? $dummy : $name) = readdir(DIR)) | |
97 | { | |
b2b3adea | 98 | $seen++ if $name eq $wanted_filename; |
55d729e4 | 99 | } |
7e35a6a8 | 100 | cmp_ok($seen,'>',0,'saw file in while() ternary'); |
55d729e4 GS |
101 | |
102 | rewinddir(DIR); | |
7e35a6a8 | 103 | $seen = 0; |
55d729e4 GS |
104 | while ($where{$seen} = readdir(DIR)) |
105 | { | |
b2b3adea | 106 | $seen++ if $where{$seen} eq $wanted_filename; |
55d729e4 | 107 | } |
7e35a6a8 | 108 | cmp_ok($seen,'==',1,'saw file in hash while()'); |
55d729e4 GS |
109 | |
110 | $seen = 0; | |
111 | while (my $name = glob('*')) | |
112 | { | |
b2b3adea | 113 | $seen++ if $name eq $wanted_filename; |
7e35a6a8 DL |
114 | } |
115 | cmp_ok($seen,'==',1,'saw file in glob while()'); | |
55d729e4 | 116 | |
7e35a6a8 | 117 | $seen = 0; |
55d729e4 GS |
118 | $dummy = ''; |
119 | while (($seen ? $dummy : $name) = glob('*')) | |
120 | { | |
b2b3adea | 121 | $seen++ if $name eq $wanted_filename; |
55d729e4 | 122 | } |
7e35a6a8 | 123 | cmp_ok($seen,'>',0,'saw file in glob hash while() ternary'); |
55d729e4 | 124 | |
7e35a6a8 | 125 | $seen = 0; |
55d729e4 GS |
126 | while ($where{$seen} = glob('*')) |
127 | { | |
b2b3adea | 128 | $seen++ if $where{$seen} eq $wanted_filename; |
55d729e4 | 129 | } |
7e35a6a8 | 130 | cmp_ok($seen,'==',1,'seen in glob hash while()'); |
55d729e4 | 131 | |
95e8664e | 132 | unlink($saved_filename); |
7e35a6a8 | 133 | ok(!(-f $saved_filename),'work file unlinked'); |
55d729e4 GS |
134 | |
135 | my %hash = (0 => 1, 1 => 2); | |
136 | ||
137 | $seen = 0; | |
138 | while (my $name = each %hash) | |
139 | { | |
140 | $seen++ if $name eq '0'; | |
7e35a6a8 DL |
141 | } |
142 | cmp_ok($seen,'==',1,'seen in each'); | |
55d729e4 | 143 | |
7e35a6a8 | 144 | $seen = 0; |
55d729e4 GS |
145 | $dummy = ''; |
146 | while (($seen ? $dummy : $name) = each %hash) | |
147 | { | |
148 | $seen++ if $name eq '0'; | |
149 | } | |
7e35a6a8 | 150 | cmp_ok($seen,'==',1,'seen in each ternary'); |
55d729e4 | 151 | |
7e35a6a8 | 152 | $seen = 0; |
55d729e4 GS |
153 | while ($where{$seen} = each %hash) |
154 | { | |
155 | $seen++ if $where{$seen} eq '0'; | |
156 | } | |
7e35a6a8 | 157 | cmp_ok($seen,'==',1,'seen in each hash'); |
55d729e4 | 158 | |
7e35a6a8 | 159 | cmp_ok($warns,'==',0,'no warns at finish'); |