Commit | Line | Data |
a0d0e21e |
1 | #!./perl |
2 | |
fb73857a |
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 |
6 | chdir 't' if -d 't'; |
20822f61 |
7 | @INC = '../lib'; |
a0d0e21e |
8 | $ENV{PERL5LIB} = "../lib"; |
9 | |
10 | $|=1; |
11 | |
12 | undef $/; |
13 | @prgs = split "\n########\n", <DATA>; |
14 | print "1..", scalar @prgs, "\n"; |
15 | |
16 | $tmpfile = "misctmp000"; |
17 | 1 while -f ++$tmpfile; |
ed6b3797 |
18 | END { while($tmpfile && unlink $tmpfile){} } |
a0d0e21e |
19 | |
2986a63f |
20 | $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat')); |
68dc0745 |
21 | |
a0d0e21e |
22 | for (@prgs){ |
23 | my $switch; |
fb73857a |
24 | if (s/^\s*(-\w.*)//){ |
25 | $switch = $1; |
a0d0e21e |
26 | } |
27 | my($prog,$expected) = split(/\nEXPECT\n/, $_); |
648cac19 |
28 | open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!"; |
ed6b3797 |
29 | $prog =~ s#/dev/null#NL:# if $^O eq 'VMS'; |
30 | $prog =~ s#if \(-e _ and -f _ and -r _\)#if (-e _ and -f _)# if $^O eq 'VMS'; # VMS file locking |
31 | |
648cac19 |
32 | print TEST $prog, "\n"; |
33 | close TEST or die "Cannot close $tmpfile: $!"; |
34 | |
68dc0745 |
35 | if ($^O eq 'MSWin32') { |
648cac19 |
36 | $results = `.\\perl -I../lib $switch $tmpfile 2>&1`; |
68dc0745 |
37 | } |
2986a63f |
38 | elsif ($^O eq 'NetWare') { |
39 | $results = `perl -I../lib $switch $tmpfile 2>&1`; |
40 | } |
68dc0745 |
41 | else { |
648cac19 |
42 | $results = `./perl $switch $tmpfile 2>&1`; |
68dc0745 |
43 | } |
a0d0e21e |
44 | $status = $?; |
a0d0e21e |
45 | $results =~ s/\n+$//; |
648cac19 |
46 | $results =~ s/at\s+misctmp\d+\s+line/at - line/g; |
47 | $results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g; |
f0ec1f9a |
48 | # bison says 'parse error' instead of 'syntax error', |
d91e2bdb |
49 | # various yaccs may or may not capitalize 'syntax'. |
2a8ee232 |
50 | $results =~ s/^(syntax|parse) error/syntax error/mig; |
a0d0e21e |
51 | $expected =~ s/\n+$//; |
8feb4e9f |
52 | if ( $results ne $expected ) { |
a0d0e21e |
53 | print STDERR "PROG: $switch\n$prog\n"; |
54 | print STDERR "EXPECTED:\n$expected\n"; |
55 | print STDERR "GOT:\n$results\n"; |
56 | print "not "; |
57 | } |
58 | print "ok ", ++$i, "\n"; |
59 | } |
60 | |
61 | __END__ |
2ace3117 |
62 | ()=() |
63 | ######## |
44a8e56a |
64 | $a = ":="; split /($a)/o, "a:=b:=c"; print "@_" |
65 | EXPECT |
66 | a := b := c |
67 | ######## |
36477c24 |
68 | $cusp = ~0 ^ (~0 >> 1); |
85e0ebd8 |
69 | use integer; |
36477c24 |
70 | $, = " "; |
85e0ebd8 |
71 | print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n"; |
36477c24 |
72 | EXPECT |
85e0ebd8 |
73 | 7 0 0 8 ! |
36477c24 |
74 | ######## |
a0d0e21e |
75 | $foo=undef; $foo->go; |
76 | EXPECT |
72b5445b |
77 | Can't call method "go" on an undefined value at - line 1. |
a0d0e21e |
78 | ######## |
79 | BEGIN |
80 | { |
81 | "foo"; |
82 | } |
83 | ######## |
a0d0e21e |
84 | $array[128]=1 |
85 | ######## |
86 | $x=0x0eabcd; print $x->ref; |
87 | EXPECT |
88 | Can't call method "ref" without a package or object reference at - line 1. |
89 | ######## |
648cac19 |
90 | chop ($str .= <DATA>); |
a0d0e21e |
91 | ######## |
92 | close ($banana); |
93 | ######## |
94 | $x=2;$y=3;$x<$y ? $x : $y += 23;print $x; |
95 | EXPECT |
96 | 25 |
97 | ######## |
98 | eval {sub bar {print "In bar";}} |
99 | ######## |
68dc0745 |
100 | system './perl -ne "print if eof" /dev/null' |
a0d0e21e |
101 | ######## |
648cac19 |
102 | chop($file = <DATA>); |
a0d0e21e |
103 | ######## |
104 | package N; |
105 | sub new {my ($obj,$n)=@_; bless \$n} |
106 | $aa=new N 1; |
107 | $aa=12345; |
108 | print $aa; |
109 | EXPECT |
110 | 12345 |
111 | ######## |
112 | %@x=0; |
113 | EXPECT |
f1612b5c |
114 | Can't modify hash dereference in repeat (x) at - line 1, near "0;" |
3fe9a6f1 |
115 | Execution of - aborted due to compilation errors. |
a0d0e21e |
116 | ######## |
117 | $_="foo"; |
118 | printf(STDOUT "%s\n", $_); |
119 | EXPECT |
120 | foo |
121 | ######## |
122 | push(@a, 1, 2, 3,) |
123 | ######## |
124 | quotemeta "" |
125 | ######## |
126 | for ("ABCDE") { |
127 | ⊂ |
128 | s/./&sub($&)/eg; |
129 | print;} |
130 | sub sub {local($_) = @_; |
131 | $_ x 4;} |
132 | EXPECT |
133 | Modification of a read-only value attempted at - line 3. |
134 | ######## |
135 | package FOO;sub new {bless {FOO => BAR}}; |
136 | package main; |
137 | use strict vars; |
138 | my $self = new FOO; |
139 | print $$self{FOO}; |
140 | EXPECT |
141 | BAR |
142 | ######## |
143 | $_="foo"; |
144 | s/.{1}//s; |
145 | print; |
146 | EXPECT |
147 | oo |
148 | ######## |
149 | print scalar ("foo","bar") |
150 | EXPECT |
151 | bar |
152 | ######## |
153 | sub by_number { $a <=> $b; };# inline function for sort below |
154 | $as_ary{0}="a0"; |
155 | @ordered_array=sort by_number keys(%as_ary); |
156 | ######## |
157 | sub NewShell |
158 | { |
159 | local($Host) = @_; |
160 | my($m2) = $#Shells++; |
161 | $Shells[$m2]{HOST} = $Host; |
162 | return $m2; |
163 | } |
164 | |
165 | sub ShowShell |
166 | { |
167 | local($i) = @_; |
168 | } |
169 | |
170 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
171 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
172 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
173 | ######## |
174 | { |
175 | package FAKEARRAY; |
176 | |
177 | sub TIEARRAY |
178 | { print "TIEARRAY @_\n"; |
179 | die "bomb out\n" unless $count ++ ; |
180 | bless ['foo'] |
181 | } |
182 | sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] } |
183 | sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } |
184 | sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; } |
185 | } |
186 | |
187 | eval 'tie @h, FAKEARRAY, fred' ; |
188 | tie @h, FAKEARRAY, fred ; |
189 | EXPECT |
190 | TIEARRAY FAKEARRAY fred |
191 | TIEARRAY FAKEARRAY fred |
192 | DESTROY |
193 | ######## |
194 | BEGIN { die "phooey\n" } |
195 | EXPECT |
196 | phooey |
197 | BEGIN failed--compilation aborted at - line 1. |
198 | ######## |
199 | BEGIN { 1/$zero } |
200 | EXPECT |
201 | Illegal division by zero at - line 1. |
202 | BEGIN failed--compilation aborted at - line 1. |
203 | ######## |
204 | BEGIN { undef = 0 } |
205 | EXPECT |
206 | Modification of a read-only value attempted at - line 1. |
207 | BEGIN failed--compilation aborted at - line 1. |
a7adf1f0 |
208 | ######## |
209 | { |
210 | package foo; |
211 | sub PRINT { |
212 | shift; |
213 | print join(' ', reverse @_)."\n"; |
214 | } |
46fc3d4c |
215 | sub PRINTF { |
216 | shift; |
217 | my $fmt = shift; |
218 | print sprintf($fmt, @_)."\n"; |
219 | } |
a7adf1f0 |
220 | sub TIEHANDLE { |
221 | bless {}, shift; |
222 | } |
58f51617 |
223 | sub READLINE { |
224 | "Out of inspiration"; |
225 | } |
a7adf1f0 |
226 | sub DESTROY { |
227 | print "and destroyed as well\n"; |
2ae324a7 |
228 | } |
229 | sub READ { |
230 | shift; |
231 | print STDOUT "foo->can(READ)(@_)\n"; |
232 | return 100; |
233 | } |
234 | sub GETC { |
235 | shift; |
236 | print STDOUT "Don't GETC, Get Perl\n"; |
237 | return "a"; |
238 | } |
a7adf1f0 |
239 | } |
240 | { |
241 | local(*FOO); |
242 | tie(*FOO,'foo'); |
243 | print FOO "sentence.", "reversed", "a", "is", "This"; |
58f51617 |
244 | print "-- ", <FOO>, " --\n"; |
2ae324a7 |
245 | my($buf,$len,$offset); |
246 | $buf = "string"; |
247 | $len = 10; $offset = 1; |
248 | read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed"; |
249 | getc(FOO) eq "a" or die "foo->GETC failed"; |
46fc3d4c |
250 | printf "%s is number %d\n", "Perl", 1; |
a7adf1f0 |
251 | } |
252 | EXPECT |
253 | This is a reversed sentence. |
58f51617 |
254 | -- Out of inspiration -- |
2ae324a7 |
255 | foo->can(READ)(string 10 1) |
256 | Don't GETC, Get Perl |
46fc3d4c |
257 | Perl is number 1 |
a7adf1f0 |
258 | and destroyed as well |
a6006777 |
259 | ######## |
260 | my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n" |
261 | EXPECT |
262 | 2 2 2 |
263 | ######## |
8ff950ac |
264 | # used to attach defelem magic to all immortal values, |
8b530633 |
265 | # which made restore of local $_ fail. |
266 | foo(2>1); |
267 | sub foo { bar() for @_; } |
268 | sub bar { local $_; } |
269 | print "ok\n"; |
270 | EXPECT |
271 | ok |
272 | ######## |
a6006777 |
273 | @a = ($a, $b, $c, $d) = (5, 6); |
274 | print "ok\n" |
275 | if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]); |
276 | EXPECT |
277 | ok |
278 | ######## |
279 | print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000); |
280 | EXPECT |
281 | ok |
282 | ######## |
8ebc5c01 |
283 | print "ok\n" if ("\0" lt "\xFF"); |
a6006777 |
284 | EXPECT |
285 | ok |
286 | ######## |
287 | open(H,'op/misc.t'); # must be in the 't' directory |
288 | stat(H); |
289 | print "ok\n" if (-e _ and -f _ and -r _); |
290 | EXPECT |
291 | ok |
292 | ######## |
293 | sub thing { 0 || return qw(now is the time) } |
294 | print thing(), "\n"; |
295 | EXPECT |
296 | nowisthetime |
297 | ######## |
298 | $ren = 'joy'; |
299 | $stimpy = 'happy'; |
300 | { local $main::{ren} = *stimpy; print $ren, ' ' } |
301 | print $ren, "\n"; |
302 | EXPECT |
303 | happy joy |
304 | ######## |
305 | $stimpy = 'happy'; |
306 | { local $main::{ren} = *stimpy; print ${'ren'}, ' ' } |
307 | print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n"; |
308 | EXPECT |
309 | happy joy |
310 | ######## |
311 | package p; |
312 | sub func { print 'really ' unless wantarray; 'p' } |
313 | sub groovy { 'groovy' } |
314 | package main; |
315 | print p::func()->groovy(), "\n" |
316 | EXPECT |
317 | really groovy |
318 | ######## |
d53f8f1c |
319 | @list = ([ 'one', 1 ], [ 'two', 2 ]); |
320 | sub func { $num = shift; (grep $_->[1] == $num, @list)[0] } |
321 | print scalar(map &func($_), 1 .. 3), " ", |
322 | scalar(map scalar &func($_), 1 .. 3), "\n"; |
323 | EXPECT |
324 | 2 3 |
325 | ######## |
44a8e56a |
326 | ($k, $s) = qw(x 0); |
327 | @{$h{$k}} = qw(1 2 4); |
328 | for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) } |
329 | print "bogus\n" unless $s == 7; |
330 | ######## |
331 | my $a = 'outer'; |
332 | eval q[ my $a = 'inner'; eval q[ print "$a " ] ]; |
333 | eval { my $x = 'peace'; eval q[ print "$x\n" ] } |
334 | EXPECT |
335 | inner peace |
774d564b |
336 | ######## |
337 | -w |
338 | $| = 1; |
339 | sub foo { |
340 | print "In foo1\n"; |
341 | eval 'sub foo { print "In foo2\n" }'; |
342 | print "Exiting foo1\n"; |
343 | } |
344 | foo; |
345 | foo; |
346 | EXPECT |
347 | In foo1 |
348 | Subroutine foo redefined at (eval 1) line 1. |
349 | Exiting foo1 |
350 | In foo2 |
351 | ######## |
352 | $s = 0; |
353 | map {#this newline here tickles the bug |
354 | $s += $_} (1,2,4); |
355 | print "eat flaming death\n" unless ($s == 7); |
1ca7b98a |
356 | ######## |
357 | sub foo { local $_ = shift; split; @_ } |
358 | @x = foo(' x y z '); |
359 | print "you die joe!\n" unless "@x" eq 'x y z'; |
c277df42 |
360 | ######## |
361 | /(?{"{"})/ # Check it outside of eval too |
362 | EXPECT |
2cd61cdb |
363 | Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern |
7253e4e3 |
364 | Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1. |
c277df42 |
365 | ######## |
366 | /(?{"{"}})/ # Check it outside of eval too |
367 | EXPECT |
d98d5fff |
368 | Unmatched right curly bracket at (re_eval 1) line 1, at end of line |
c277df42 |
369 | syntax error at (re_eval 1) line 1, near ""{"}" |
2cd61cdb |
370 | Compilation failed in regexp at - line 1. |
0da4822f |
371 | ######## |
ff689196 |
372 | BEGIN { @ARGV = qw(a b c d e) } |
0da4822f |
373 | BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" } |
374 | END { print "end <",shift,">\nargv <@ARGV>\n" } |
375 | INIT { print "init <",shift,">\n" } |
7d30b5c4 |
376 | CHECK { print "check <",shift,">\n" } |
0da4822f |
377 | EXPECT |
ff689196 |
378 | argv <a b c d e> |
0da4822f |
379 | begin <a> |
7d30b5c4 |
380 | check <b> |
ff689196 |
381 | init <c> |
382 | end <d> |
383 | argv <e> |
4599a1de |
384 | ######## |
3500f679 |
385 | -l |
386 | # fdopen from a system descriptor to a system descriptor used to close |
387 | # the former. |
388 | open STDERR, '>&=STDOUT' or die $!; |
75642110 |
389 | select STDOUT; $| = 1; print fileno STDOUT or die $!; |
390 | select STDERR; $| = 1; print fileno STDERR or die $!; |
3500f679 |
391 | EXPECT |
392 | 1 |
393 | 2 |
394 | ######## |
20408e3c |
395 | -w |
396 | sub testme { my $a = "test"; { local $a = "new test"; print $a }} |
397 | EXPECT |
398 | Can't localize lexical variable $a at - line 2. |
399 | ######## |
51ae5c03 |
400 | package X; |
401 | sub ascalar { my $r; bless \$r } |
402 | sub DESTROY { print "destroyed\n" }; |
403 | package main; |
404 | *s = ascalar X; |
405 | EXPECT |
406 | destroyed |
407 | ######## |
408 | package X; |
409 | sub anarray { bless [] } |
410 | sub DESTROY { print "destroyed\n" }; |
411 | package main; |
412 | *a = anarray X; |
413 | EXPECT |
414 | destroyed |
415 | ######## |
416 | package X; |
417 | sub ahash { bless {} } |
418 | sub DESTROY { print "destroyed\n" }; |
419 | package main; |
420 | *h = ahash X; |
421 | EXPECT |
422 | destroyed |
423 | ######## |
424 | package X; |
425 | sub aclosure { my $x; bless sub { ++$x } } |
426 | sub DESTROY { print "destroyed\n" }; |
427 | package main; |
428 | *c = aclosure X; |
429 | EXPECT |
430 | destroyed |
431 | ######## |
432 | package X; |
433 | sub any { bless {} } |
434 | my $f = "FH000"; # just to thwart any future optimisations |
ded8aa31 |
435 | sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r } |
51ae5c03 |
436 | sub DESTROY { print "destroyed\n" } |
437 | package main; |
438 | $x = any X; # to bump sv_objcount. IO objs aren't counted?? |
439 | *f = afh X; |
440 | EXPECT |
441 | destroyed |
442 | destroyed |
443 | ######## |
ebf99b04 |
444 | BEGIN { |
445 | $| = 1; |
446 | $SIG{__WARN__} = sub { |
447 | eval { print $_[0] }; |
448 | die "bar\n"; |
449 | }; |
450 | warn "foo\n"; |
451 | } |
452 | EXPECT |
453 | foo |
454 | bar |
455 | BEGIN failed--compilation aborted at - line 8. |
8feb4e9f |
456 | ######## |
457 | package X; |
458 | @ISA='Y'; |
459 | sub new { |
460 | my $class = shift; |
461 | my $self = { }; |
462 | bless $self, $class; |
463 | my $init = shift; |
464 | $self->foo($init); |
465 | print "new", $init; |
466 | return $self; |
467 | } |
468 | sub DESTROY { |
469 | my $self = shift; |
470 | print "DESTROY", $self->foo; |
471 | } |
472 | package Y; |
473 | sub attribute { |
474 | my $self = shift; |
475 | my $var = shift; |
476 | if (@_ == 0) { |
477 | return $self->{$var}; |
478 | } elsif (@_ == 1) { |
479 | $self->{$var} = shift; |
480 | } |
481 | } |
482 | sub AUTOLOAD { |
483 | $AUTOLOAD =~ /::([^:]+)$/; |
484 | my $method = $1; |
485 | splice @_, 1, 0, $method; |
486 | goto &attribute; |
487 | } |
488 | package main; |
489 | my $x = X->new(1); |
490 | for (2..3) { |
491 | my $y = X->new($_); |
492 | print $y->foo; |
493 | } |
494 | print $x->foo; |
495 | EXPECT |
496 | new1new22DESTROY2new33DESTROY31DESTROY1 |
dfad63ad |
497 | ######## |
498 | re(); |
499 | sub re { |
14455d6c |
500 | my $re = join '', eval 'qr/(??{ $obj->method })/'; |
dfad63ad |
501 | $re; |
502 | } |
503 | EXPECT |
1aff0e91 |
504 | ######## |
505 | use strict; |
506 | my $foo = "ZZZ\n"; |
507 | END { print $foo } |
508 | EXPECT |
509 | ZZZ |
510 | ######## |
511 | eval ' |
512 | use strict; |
513 | my $foo = "ZZZ\n"; |
514 | END { print $foo } |
515 | '; |
516 | EXPECT |
517 | ZZZ |
7399586d |
518 | ######## |
519 | -w |
520 | if (@ARGV) { print "" } |
521 | else { |
522 | if ($x == 0) { print "" } else { print $x } |
523 | } |
524 | EXPECT |
b89fed5f |
525 | Use of uninitialized value in numeric eq (==) at - line 4. |
1d76a5c3 |
526 | ######## |
527 | $x = sub {}; |
528 | foo(); |
529 | sub foo { eval { return }; } |
530 | print "ok\n"; |
531 | EXPECT |
532 | ok |
07447971 |
533 | ######## |
534 | my @l = qw(hello.* world); |
535 | my $x; |
536 | |
537 | foreach $x (@l) { |
538 | print "before - $x\n"; |
539 | $x = "\Q$x\E"; |
540 | print "quotemeta - $x\n"; |
541 | $x = "\u$x"; |
542 | print "ucfirst - $x\n"; |
543 | $x = "\l$x"; |
544 | print "lcfirst - $x\n"; |
545 | $x = "\U$x\E"; |
546 | print "uc - $x\n"; |
547 | $x = "\L$x\E"; |
548 | print "lc - $x\n"; |
549 | } |
550 | EXPECT |
551 | before - hello.* |
552 | quotemeta - hello\.\* |
553 | ucfirst - Hello\.\* |
554 | lcfirst - hello\.\* |
555 | uc - HELLO\.\* |
556 | lc - hello\.\* |
557 | before - world |
558 | quotemeta - world |
559 | ucfirst - World |
560 | lcfirst - world |
561 | uc - WORLD |
562 | lc - world |
92d29cee |
563 | ######## |
564 | sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next } |
565 | my $x = "foo"; |
566 | { f } continue { print $x, "\n" } |
567 | EXPECT |
568 | foo |
6a7129a1 |
569 | ######## |
570 | sub C () { 1 } |
571 | sub M { $_[0] = 2; } |
572 | eval "C"; |
573 | M(C); |
574 | EXPECT |
575 | Modification of a read-only value attempted at - line 2. |
00c29ff8 |
576 | ######## |
577 | print qw(ab a\b a\\b); |
578 | EXPECT |
579 | aba\ba\b |
dd8482fc |
580 | ######## |
c71fccf1 |
581 | # lexicals declared after the myeval() definition should not be visible |
582 | # within it |
583 | sub myeval { eval $_[0] } |
584 | my $foo = "ok 2\n"; |
585 | myeval('sub foo { local $foo = "ok 1\n"; print $foo; }'); |
586 | die $@ if $@; |
587 | foo(); |
588 | print $foo; |
589 | EXPECT |
590 | ok 1 |
591 | ok 2 |
592 | ######## |
2090ab20 |
593 | # lexicals outside an eval"" should be visible inside subroutine definitions |
594 | # within it |
595 | eval <<'EOT'; die $@ if $@; |
596 | { |
597 | my $X = "ok\n"; |
598 | eval 'sub Y { print $X }'; die $@ if $@; |
599 | Y(); |
600 | } |
601 | EOT |
602 | EXPECT |
603 | ok |
604 | ######## |
c975facc |
605 | # test that closures generated by eval"" hold on to the CV of the eval"" |
606 | # for their entire lifetime |
607 | $code = eval q[ |
608 | sub { eval '$x = "ok 1\n"'; } |
609 | ]; |
610 | &{$code}(); |
611 | print $x; |
612 | EXPECT |
613 | ok 1 |
614 | ######## |
dd8482fc |
615 | # This test is here instead of pragma/locale.t because |
616 | # the bug depends on in the internal state of the locale |
617 | # settings and pragma/locale messes up that state pretty badly. |
618 | # We need a "fresh run". |
c9f931b8 |
619 | BEGIN { |
620 | eval { require POSIX }; |
621 | if ($@) { |
622 | exit(0); # running minitest? |
623 | } |
624 | } |
dd8482fc |
625 | use Config; |
626 | my $have_setlocale = $Config{d_setlocale} eq 'define'; |
dd8482fc |
627 | $have_setlocale = 0 if $@; |
628 | # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1" |
629 | # and mingw32 uses said silly CRT |
2986a63f |
630 | $have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i); |
dd8482fc |
631 | exit(0) unless $have_setlocale; |
632 | my @locales; |
633 | if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a|")) { |
634 | while(<LOCALES>) { |
635 | chomp; |
636 | push(@locales, $_); |
637 | } |
638 | close(LOCALES); |
639 | } |
640 | exit(0) unless @locales; |
641 | for (@locales) { |
642 | use POSIX qw(locale_h); |
643 | use locale; |
88e7acd2 |
644 | setlocale(LC_NUMERIC, $_) or next; |
dd8482fc |
645 | my $s = sprintf "%g %g", 3.1, 3.1; |
646 | next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/; |
647 | print "$_ $s\n"; |
648 | } |
649 | EXPECT |
b927783e |
650 | ######## |
651 | die qr(x) |
652 | EXPECT |
653 | (?-xism:x) at - line 1. |
654 | ######## |
7ef822cd |
655 | # 20001210.003 mjd@plover.com |
656 | format REMITOUT_TOP = |
657 | FOO |
658 | . |
659 | |
660 | format REMITOUT = |
661 | BAR |
662 | . |
663 | |
664 | # This loop causes a segv in 5.6.0 |
665 | for $lineno (1..61) { |
666 | write REMITOUT; |
667 | } |
668 | |
669 | print "It's OK!"; |
670 | EXPECT |
671 | It's OK! |
cb55de95 |
672 | ######## |
673 | # Inaba Hiroto |
674 | reset; |
675 | if (0) { |
676 | if ("" =~ //) { |
677 | } |
678 | } |
679 | ######## |
680 | # Nicholas Clark |
681 | $ENV{TERM} = 0; |
682 | reset; |
683 | // if 0; |
684 | ######## |
685 | # Vadim Konovalov |
686 | use strict; |
687 | sub new_pmop($) { |
688 | my $pm = shift; |
689 | return eval "sub {shift=~/$pm/}"; |
690 | } |
691 | new_pmop "abcdef"; reset; |
692 | new_pmop "abcdef"; reset; |
693 | new_pmop "abcdef"; reset; |
694 | new_pmop "abcdef"; reset; |
880649cd |
695 | ######## |
696 | # David Dyck |
697 | # coredump in 5.7.1 |
698 | close STDERR; die; |
699 | EXPECT |
dba9804b |
700 | ######## |
99799961 |
701 | -w |
702 | "x" =~ /(\G?x)?/; # core dump in 20000716.007 |
703 | EXPECT |
704 | Quantifier unexpected on zero-length expression in regex; marked by <-- HERE in m/(\G?x)? <-- HERE / at - line 2. |
705 | ######## |
dba9804b |
706 | # Bug 20010515.004 |
707 | my @h = 1 .. 10; |
708 | bad(@h); |
709 | sub bad { |
710 | undef @h; |
711 | print "O"; |
712 | print for @_; |
713 | print "K"; |
714 | } |
715 | EXPECT |
716 | OK |
97b9a4cb |
717 | ######## |
718 | # Bug 20010506.041 |
719 | "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n"; |
720 | EXPECT |
721 | ok |
0b490c9c |
722 | ######## |
723 | # Bug 20010422.005 |
724 | {s//${}/; //} |
725 | EXPECT |
2172ddaf |
726 | syntax error at - line 2, near "${}" |
0b490c9c |
727 | Execution of - aborted due to compilation errors. |
585602fa |
728 | ######## |
729 | # Bug 20010528.007 |
730 | "\x{" |
731 | EXPECT |
732 | Missing right brace on \x{} at - line 2, within string |
733 | Execution of - aborted due to compilation errors. |
08b362fd |
734 | ######## |
735 | my $foo = Bar->new(); |
736 | my @dst; |
737 | END { |
738 | ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/; |
739 | print $_, "\n"; |
740 | } |
741 | package Bar; |
742 | sub new { |
743 | my Bar $self = bless [], Bar; |
744 | eval '$self'; |
745 | return $self; |
746 | } |
747 | sub DESTROY { |
748 | push @dst, "$_[0]"; |
749 | } |
750 | EXPECT |
751 | Bar=ARRAY(0x...) |
1f96ff2a |
752 | ######## |
753 | eval "a.b.c.d.e.f;sub" |
754 | EXPECT |