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