This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
partly fix perldiag regressions identified by Tom Christiansen
[perl5.git] / t / pragma / warn / pp_sys
1   pp_sys.c      AOK
2
3   untie attempted while %d inner references still exist [pp_untie]
4     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
5
6   Filehandle %s opened only for input           [pp_leavewrite]
7     format STDIN =
8     .
9     write STDIN;
10
11   write() on closed filehandle %s               [pp_leavewrite]
12     format STDIN =
13     .
14     close STDIN;
15     write STDIN ;
16
17   page overflow                                 [pp_leavewrite]
18
19   Filehandle %s never opened                    [pp_prtf]
20     $a = "abc"; printf $a "fred"
21
22   Filehandle %s opened only for input           [pp_prtf]
23     $a = "abc"; 
24     printf $a "fred"
25
26   printf() on closed filehandle %s              [pp_prtf]
27     close STDIN ;
28     printf STDIN "fred"
29
30   syswrite() on closed filehandle               [pp_send]
31     close STDIN; 
32     syswrite STDIN, "fred", 1;
33
34   send() on closed socket                       [pp_send]
35     close STDIN; 
36     send STDIN, "fred", 1
37
38   bind() on closed socket                       [pp_bind]
39     close STDIN; 
40     bind STDIN, "fred" ;
41
42
43   connect() on closed socket                    [pp_connect]
44     close STDIN; 
45     connect STDIN, "fred" ;
46
47   listen() on closed socket                     [pp_listen]
48     close STDIN; 
49     listen STDIN, 2;
50
51   accept() on closed socket                     [pp_accept]
52     close STDIN; 
53     accept STDIN, "fred" ;
54
55   shutdown() on closed socket                   [pp_shutdown]
56     close STDIN; 
57     shutdown STDIN, 0;
58
59   setsockopt() on closed socket                 [pp_ssockopt]
60   getsockopt() on closed socket                 [pp_ssockopt]
61     close STDIN; 
62     setsockopt STDIN, 1,2,3;
63     getsockopt STDIN, 1,2;
64
65   getsockname() on closed socket                [pp_getpeername]
66   getpeername() on closed socket                [pp_getpeername]
67     close STDIN; 
68     getsockname STDIN;
69     getpeername STDIN;
70
71   warn(warn_nl, "stat");                        [pp_stat]
72
73   Test on unopened file <%s>
74         close STDIN ; -T STDIN ;
75
76   warn(warn_nl, "open");                        [pp_fttext]
77     -T "abc\ndef" ;
78
79   Filehandle %s opened only for output          [pp_sysread]
80         my $file = "./xcv" ;
81         open(F, ">$file") ; 
82         my $a = sysread(F, $a,10) ;
83   
84   
85
86 __END__
87 # pp_sys.c [pp_untie]
88 use warnings 'untie' ;
89 sub TIESCALAR { bless [] } ; 
90 $b = tie $a, 'main'; 
91 untie $a ;
92 no warnings 'untie' ;
93 $c = tie $d, 'main'; 
94 untie $d ;
95 EXPECT
96 untie attempted while 1 inner references still exist at - line 5.
97 ########
98 # pp_sys.c [pp_leavewrite]
99 use warnings 'io' ;
100 format STDIN =
101 .
102 write STDIN;
103 no warnings 'io' ;
104 write STDIN;
105 EXPECT
106 Filehandle main::STDIN opened only for input at - line 5.
107 ########
108 # pp_sys.c [pp_leavewrite]
109 use warnings 'closed' ;
110 format STDIN =
111 .
112 close STDIN;
113 write STDIN;
114 no warnings 'closed' ;
115 write STDIN;
116 EXPECT
117 write() on closed filehandle main::STDIN at - line 6.
118 ########
119 # pp_sys.c [pp_leavewrite]
120 use warnings 'io' ;
121 format STDOUT_TOP =
122 abc
123 .
124 format STDOUT =
125 def
126 ghi
127 .
128 $= = 1 ;
129 $- =1 ;
130 open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
131 write ;
132 no warnings 'io' ;
133 write ;
134 EXPECT
135 page overflow at - line 13.
136 ########
137 # pp_sys.c [pp_prtf]
138 use warnings 'unopened' ;
139 $a = "abc"; 
140 printf $a "fred";
141 no warnings 'unopened' ;
142 printf $a "fred";
143 EXPECT
144 Filehandle main::abc never opened at - line 4.
145 ########
146 # pp_sys.c [pp_prtf]
147 use warnings 'closed' ;
148 close STDIN ;
149 printf STDIN "fred";
150 no warnings 'closed' ;
151 printf STDIN "fred";
152 EXPECT
153 printf() on closed filehandle main::STDIN at - line 4.
154 ########
155 # pp_sys.c [pp_prtf]
156 use warnings 'io' ;
157 printf STDIN "fred";
158 no warnings 'io' ;
159 printf STDIN "fred";
160 EXPECT
161 Filehandle main::STDIN opened only for input at - line 3.
162 ########
163 # pp_sys.c [pp_send]
164 use warnings 'closed' ;
165 close STDIN; 
166 syswrite STDIN, "fred", 1;
167 no warnings 'closed' ;
168 syswrite STDIN, "fred", 1;
169 EXPECT
170 syswrite() on closed filehandle at - line 4.
171 ########
172 # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
173 use warnings 'io' ;
174 use Config; 
175 BEGIN { 
176   if ( $^O ne 'VMS' and ! $Config{d_socket}) {
177     print <<EOM ;
178 SKIPPED
179 # send not present
180 # bind not present
181 # connect not present
182 # accept not present
183 # shutdown not present
184 # setsockopt not present
185 # getsockopt not present
186 # getsockname not present
187 # getpeername not present
188 EOM
189     exit ;
190   } 
191 }
192 close STDIN; 
193 send STDIN, "fred", 1;
194 bind STDIN, "fred" ;
195 connect STDIN, "fred" ;
196 listen STDIN, 2;
197 accept STDIN, "fred" ;
198 shutdown STDIN, 0;
199 setsockopt STDIN, 1,2,3;
200 getsockopt STDIN, 1,2;
201 getsockname STDIN;
202 getpeername STDIN;
203 no warnings 'io' ;
204 send STDIN, "fred", 1;
205 bind STDIN, "fred" ;
206 connect STDIN, "fred" ;
207 listen STDIN, 2;
208 accept STDIN, "fred" ;
209 shutdown STDIN, 0;
210 setsockopt STDIN, 1,2,3;
211 getsockopt STDIN, 1,2;
212 getsockname STDIN;
213 getpeername STDIN;
214 EXPECT
215 send() on closed socket at - line 22.
216 bind() on closed socket at - line 23.
217 connect() on closed socket at - line 24.
218 listen() on closed socket at - line 25.
219 accept() on closed socket at - line 26.
220 shutdown() on closed socket at - line 27.
221 setsockopt() on closed socket at - line 28.
222 getsockopt() on closed socket at - line 29.
223 getsockname() on closed socket at - line 30.
224 getpeername() on closed socket at - line 31.
225 ########
226 # pp_sys.c [pp_stat]
227 use warnings 'newline' ;
228 stat "abc\ndef";
229 no warnings 'newline' ;
230 stat "abc\ndef";
231 EXPECT
232 Unsuccessful stat on filename containing newline at - line 3.
233 ########
234 # pp_sys.c [pp_fttext]
235 use warnings 'unopened' ;
236 close STDIN ; 
237 -T STDIN ;
238 no warnings 'unopened' ;
239 -T STDIN ;
240 EXPECT
241 Test on unopened file <STDIN> at - line 4.
242 ########
243 # pp_sys.c [pp_fttext]
244 use warnings 'newline' ;
245 -T "abc\ndef" ;
246 no warnings 'newline' ;
247 -T "abc\ndef" ;
248 EXPECT
249 Unsuccessful open on filename containing newline at - line 3.
250 ########
251 # pp_sys.c [pp_sysread]
252 use warnings 'io' ;
253 my $file = "./xcv" ;
254 open(F, ">$file") ; 
255 my $a = sysread(F, $a,10) ;
256 no warnings 'io' ;
257 my $a = sysread(F, $a,10) ;
258 close F ;
259 unlink $file ;
260 EXPECT
261 Filehandle main::F opened only for output at - line 5.