This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate win32 branch into mainline
[perl5.git] / t / op / misc.t
CommitLineData
a0d0e21e
LW
1#!./perl
2
fb73857a
PP
3# NOTE: Please don't add tests to this file unless they *need* to be run in
4# separate executable and can't simply use eval.
5
a0d0e21e
LW
6chdir 't' if -d 't';
7@INC = "../lib";
8$ENV{PERL5LIB} = "../lib";
9
10$|=1;
11
12undef $/;
13@prgs = split "\n########\n", <DATA>;
14print "1..", scalar @prgs, "\n";
15
16$tmpfile = "misctmp000";
171 while -f ++$tmpfile;
18END { unlink $tmpfile if $tmpfile; }
19
68dc0745
PP
20$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
21
a0d0e21e
LW
22for (@prgs){
23 my $switch;
fb73857a
PP
24 if (s/^\s*(-\w.*)//){
25 $switch = $1;
a0d0e21e
LW
26 }
27 my($prog,$expected) = split(/\nEXPECT\n/, $_);
68dc0745
PP
28 if ($^O eq 'MSWin32') {
29 open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1";
30 }
31 else {
32 open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
33 }
a0d0e21e
LW
34 print TEST $prog, "\n";
35 close TEST;
36 $status = $?;
68dc0745 37 $results = `$CAT $tmpfile`;
a0d0e21e
LW
38 $results =~ s/\n+$//;
39 $expected =~ s/\n+$//;
40 if ( $results ne $expected){
41 print STDERR "PROG: $switch\n$prog\n";
42 print STDERR "EXPECTED:\n$expected\n";
43 print STDERR "GOT:\n$results\n";
44 print "not ";
45 }
46 print "ok ", ++$i, "\n";
47}
48
49__END__
2ace3117
CS
50()=()
51########
44a8e56a
PP
52$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
53EXPECT
54a := b := c
55########
36477c24
PP
56$cusp = ~0 ^ (~0 >> 1);
57$, = " ";
58print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
59EXPECT
607 0 0 1 !
61########
a0d0e21e
LW
62$foo=undef; $foo->go;
63EXPECT
64Can't call method "go" without a package or object reference at - line 1.
65########
66BEGIN
67 {
68 "foo";
69 }
70########
a0d0e21e
LW
71$array[128]=1
72########
73$x=0x0eabcd; print $x->ref;
74EXPECT
75Can't call method "ref" without a package or object reference at - line 1.
76########
77chop ($str .= <STDIN>);
78########
79close ($banana);
80########
81$x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
82EXPECT
8325
84########
85eval {sub bar {print "In bar";}}
86########
68dc0745 87system './perl -ne "print if eof" /dev/null'
a0d0e21e
LW
88########
89chop($file = <>);
90########
91package N;
92sub new {my ($obj,$n)=@_; bless \$n}
93$aa=new N 1;
94$aa=12345;
95print $aa;
96EXPECT
9712345
98########
99%@x=0;
100EXPECT
3fe9a6f1
PP
101Can't modify hash deref in repeat at - line 1, near "0;"
102Execution of - aborted due to compilation errors.
a0d0e21e
LW
103########
104$_="foo";
105printf(STDOUT "%s\n", $_);
106EXPECT
107foo
108########
109push(@a, 1, 2, 3,)
110########
111quotemeta ""
112########
113for ("ABCDE") {
114 &sub;
115s/./&sub($&)/eg;
116print;}
117sub sub {local($_) = @_;
118$_ x 4;}
119EXPECT
120Modification of a read-only value attempted at - line 3.
121########
122package FOO;sub new {bless {FOO => BAR}};
123package main;
124use strict vars;
125my $self = new FOO;
126print $$self{FOO};
127EXPECT
128BAR
129########
130$_="foo";
131s/.{1}//s;
132print;
133EXPECT
134oo
135########
136print scalar ("foo","bar")
137EXPECT
138bar
139########
140sub by_number { $a <=> $b; };# inline function for sort below
141$as_ary{0}="a0";
142@ordered_array=sort by_number keys(%as_ary);
143########
144sub NewShell
145{
146 local($Host) = @_;
147 my($m2) = $#Shells++;
148 $Shells[$m2]{HOST} = $Host;
149 return $m2;
150}
151
152sub ShowShell
153{
154 local($i) = @_;
155}
156
157&ShowShell(&NewShell(beach,Work,"+0+0"));
158&ShowShell(&NewShell(beach,Work,"+0+0"));
159&ShowShell(&NewShell(beach,Work,"+0+0"));
160########
161 {
162 package FAKEARRAY;
163
164 sub TIEARRAY
165 { print "TIEARRAY @_\n";
166 die "bomb out\n" unless $count ++ ;
167 bless ['foo']
168 }
169 sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
170 sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
171 sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
172 }
173
174eval 'tie @h, FAKEARRAY, fred' ;
175tie @h, FAKEARRAY, fred ;
176EXPECT
177TIEARRAY FAKEARRAY fred
178TIEARRAY FAKEARRAY fred
179DESTROY
180########
181BEGIN { die "phooey\n" }
182EXPECT
183phooey
184BEGIN failed--compilation aborted at - line 1.
185########
186BEGIN { 1/$zero }
187EXPECT
188Illegal division by zero at - line 1.
189BEGIN failed--compilation aborted at - line 1.
190########
191BEGIN { undef = 0 }
192EXPECT
193Modification of a read-only value attempted at - line 1.
194BEGIN failed--compilation aborted at - line 1.
a7adf1f0
PP
195########
196{
197 package foo;
198 sub PRINT {
199 shift;
200 print join(' ', reverse @_)."\n";
201 }
46fc3d4c
PP
202 sub PRINTF {
203 shift;
204 my $fmt = shift;
205 print sprintf($fmt, @_)."\n";
206 }
a7adf1f0
PP
207 sub TIEHANDLE {
208 bless {}, shift;
209 }
58f51617
SV
210 sub READLINE {
211 "Out of inspiration";
212 }
a7adf1f0
PP
213 sub DESTROY {
214 print "and destroyed as well\n";
2ae324a7
PP
215 }
216 sub READ {
217 shift;
218 print STDOUT "foo->can(READ)(@_)\n";
219 return 100;
220 }
221 sub GETC {
222 shift;
223 print STDOUT "Don't GETC, Get Perl\n";
224 return "a";
225 }
a7adf1f0
PP
226}
227{
228 local(*FOO);
229 tie(*FOO,'foo');
230 print FOO "sentence.", "reversed", "a", "is", "This";
58f51617 231 print "-- ", <FOO>, " --\n";
2ae324a7
PP
232 my($buf,$len,$offset);
233 $buf = "string";
234 $len = 10; $offset = 1;
235 read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed";
236 getc(FOO) eq "a" or die "foo->GETC failed";
46fc3d4c 237 printf "%s is number %d\n", "Perl", 1;
a7adf1f0
PP
238}
239EXPECT
240This is a reversed sentence.
58f51617 241-- Out of inspiration --
2ae324a7
PP
242foo->can(READ)(string 10 1)
243Don't GETC, Get Perl
46fc3d4c 244Perl is number 1
a7adf1f0 245and destroyed as well
a6006777
PP
246########
247my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
248EXPECT
2492 2 2
250########
251@a = ($a, $b, $c, $d) = (5, 6);
252print "ok\n"
253 if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]);
254EXPECT
255ok
256########
257print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000);
258EXPECT
259ok
260########
8ebc5c01 261print "ok\n" if ("\0" lt "\xFF");
a6006777
PP
262EXPECT
263ok
264########
265open(H,'op/misc.t'); # must be in the 't' directory
266stat(H);
267print "ok\n" if (-e _ and -f _ and -r _);
268EXPECT
269ok
270########
271sub thing { 0 || return qw(now is the time) }
272print thing(), "\n";
273EXPECT
274nowisthetime
275########
276$ren = 'joy';
277$stimpy = 'happy';
278{ local $main::{ren} = *stimpy; print $ren, ' ' }
279print $ren, "\n";
280EXPECT
281happy joy
282########
283$stimpy = 'happy';
284{ local $main::{ren} = *stimpy; print ${'ren'}, ' ' }
285print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n";
286EXPECT
287happy joy
288########
289package p;
290sub func { print 'really ' unless wantarray; 'p' }
291sub groovy { 'groovy' }
292package main;
293print p::func()->groovy(), "\n"
294EXPECT
295really groovy
296########
d53f8f1c
HS
297@list = ([ 'one', 1 ], [ 'two', 2 ]);
298sub func { $num = shift; (grep $_->[1] == $num, @list)[0] }
299print scalar(map &func($_), 1 .. 3), " ",
300 scalar(map scalar &func($_), 1 .. 3), "\n";
301EXPECT
3022 3
303########
44a8e56a
PP
304($k, $s) = qw(x 0);
305@{$h{$k}} = qw(1 2 4);
306for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
307print "bogus\n" unless $s == 7;
308########
309my $a = 'outer';
310eval q[ my $a = 'inner'; eval q[ print "$a " ] ];
311eval { my $x = 'peace'; eval q[ print "$x\n" ] }
312EXPECT
313inner peace
774d564b
PP
314########
315-w
316$| = 1;
317sub foo {
318 print "In foo1\n";
319 eval 'sub foo { print "In foo2\n" }';
320 print "Exiting foo1\n";
321}
322foo;
323foo;
324EXPECT
325In foo1
326Subroutine foo redefined at (eval 1) line 1.
327Exiting foo1
328In foo2
329########
330$s = 0;
331map {#this newline here tickles the bug
332$s += $_} (1,2,4);
333print "eat flaming death\n" unless ($s == 7);
1ca7b98a
CS
334########
335sub foo { local $_ = shift; split; @_ }
336@x = foo(' x y z ');
337print "you die joe!\n" unless "@x" eq 'x y z';
c277df42
IZ
338########
339/(?{"{"})/ # Check it outside of eval too
340EXPECT
cc6b7395 341Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
c277df42
IZ
342/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
343########
344/(?{"{"}})/ # Check it outside of eval too
345EXPECT
346Unmatched right bracket at (re_eval 1) line 1, at end of line
347syntax error at (re_eval 1) line 1, near ""{"}"
348Compilation failed in regexp at - line 1.
0da4822f
GS
349########
350BEGIN { @ARGV = qw(a b c) }
351BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
352END { print "end <",shift,">\nargv <@ARGV>\n" }
353INIT { print "init <",shift,">\n" }
354EXPECT
355argv <a b c>
356begin <a>
357init <b>
358end <c>
359argv <>
4599a1de 360########
3500f679
RS
361-l
362# fdopen from a system descriptor to a system descriptor used to close
363# the former.
364open STDERR, '>&=STDOUT' or die $!;
365select STDOUT; $| = 1; print fileno STDOUT;
366select STDERR; $| = 1; print fileno STDERR;
367EXPECT
3681
3692
370########